github/shiny
1
1
Fork 0
mirror of https://github.com/rstudio/shiny.git synced 2026-01-08 22:48:21 -05:00
Code Issues Packages Projects Releases Wiki Activity

fix(otel): Duplicate otel code attribute keys using both deprecated and preferred names (#4325)

Browse Source
This commit is contained in:
Barret Schloerke
2025-12-03 16:37:20 -05:00
committed by GitHub
parent 5a946caf35
commit 63a00f775f
9 changed files with 306 additions and 140 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
NEWS.md
View File

@@ -1,5 +1,6 @@
# shiny (development version)
* OpenTelemetry code attributes now include both preferred (`code.file.path`, `code.line.number`, `code.column.number`) and deprecated (`code.filepath`, `code.lineno`, `code.column`) attribute names to follow OpenTelemetry semantic conventions while maintaining backward compatibility. The deprecated names will be removed in a future release after Logfire supports the preferred names. (#4325)
* Timer tests are now skipped on CRAN. (#4327)
# shiny 1.12.0

2
R/bind-cache.R
View File

@@ -520,7 +520,7 @@ bindCache.reactiveExpr <- function(x, ..., cache = "app") {
local({
impl <- attr(res, "observable", exact = TRUE)
impl$.otelAttrs <- append_otel_srcref_attrs(x_otel_attrs, call_srcref)
impl$.otelAttrs <- append_otel_srcref_attrs(x_otel_attrs, call_srcref, fn_name = "bindCache")
})
if (has_otel_collect("reactivity")) {

4
R/bind-event.R
View File

@@ -240,7 +240,7 @@ bindEvent.reactiveExpr <- function(x, ..., ignoreNULL = TRUE, ignoreInit = FALSE
local({
impl <- attr(res, "observable", exact = TRUE)
impl$.otelAttrs <- append_otel_srcref_attrs(x_otel_attrs, call_srcref)
impl$.otelAttrs <- append_otel_srcref_attrs(x_otel_attrs, call_srcref, fn_name = "bindEvent")
})
@@ -341,7 +341,7 @@ bindEvent.Observer <- function(x, ..., ignoreNULL = TRUE, ignoreInit = FALSE,
class(x) <- c("Observer.event", class(x))
call_srcref <- get_call_srcref(-1)
x$.otelAttrs <- append_otel_srcref_attrs(x$.otelAttrs, call_srcref)
x$.otelAttrs <- append_otel_srcref_attrs(x$.otelAttrs, call_srcref, fn_name = "bindEvent")
if (has_otel_collect("reactivity")) {
x <- enable_otel_observe(x)

2
R/extended-task.R
View File

@@ -140,7 +140,7 @@ ExtendedTask <- R6Class("ExtendedTask", portable = TRUE, cloneable = FALSE,
private$otel_log_label_add_to_queue <- otel_log_label_extended_task_add_to_queue(label, domain = domain)
private$otel_attrs <- c(
otel_srcref_attributes(call_srcref),
otel_srcref_attributes(call_srcref, "ExtendedTask"),
otel_session_id_attrs(domain)
) %||% list()
},

16
R/otel-attr-srcref.R
View File

@@ -2,7 +2,7 @@
# Very similar to srcrefFromShinyCall(),
# however, this works when the function does not have a srcref attr set
otel_srcref_attributes <- function(srcref) {
otel_srcref_attributes <- function(srcref, fn_name = NULL) {
if (is.function(srcref)) {
srcref <- getSrcRefs(srcref)[[1]][[1]]
}
@@ -16,8 +16,16 @@ otel_srcref_attributes <- function(srcref) {
# Semantic conventions for code: https://opentelemetry.io/docs/specs/semconv/registry/attributes/code/
#
# Inspiration from https://github.com/r-lib/testthat/pull/2087/files#diff-92de3306849d93d6f7e76c5aaa1b0c037e2d716f72848f8a1c70536e0c8a1564R123-R124
filename <- attr(srcref, "srcfile")$filename
dropNulls(list(
"code.filepath" = attr(srcref, "srcfile")$filename,
"code.function.name" = fn_name,
# Location attrs
"code.file.path" = filename,
"code.line.number" = srcref[1],
"code.column.number" = srcref[2],
# Remove these deprecated location names once Logfire supports the preferred names
# https://github.com/pydantic/logfire/issues/1559
"code.filepath" = filename,
"code.lineno" = srcref[1],
"code.column" = srcref[2]
))
@@ -41,12 +49,12 @@ get_call_srcref <- function(which_offset = 0) {
}
append_otel_srcref_attrs <- function(attrs, call_srcref) {
append_otel_srcref_attrs <- function(attrs, call_srcref, fn_name) {
if (is.null(call_srcref)) {
return(attrs)
}
srcref_attrs <- otel_srcref_attributes(call_srcref)
srcref_attrs <- otel_srcref_attributes(call_srcref, fn_name)
if (is.null(srcref_attrs)) {
return(attrs)
}

18
R/reactives.R
View File

@@ -231,7 +231,7 @@ reactiveVal <- function(value = NULL, label = NULL) {
rv <- ReactiveVal$new(value, label)
if (!is.null(call_srcref)) {
rv$.otelAttrs <- otel_srcref_attributes(call_srcref)
rv$.otelAttrs <- otel_srcref_attributes(call_srcref, fn_name = "reactiveVal")
}
ret <- structure(
@@ -646,7 +646,7 @@ reactiveValues <- function(...) {
defaultLabel = impl$.label
)
impl$.otelAttrs <- otel_srcref_attributes(call_srcref)
impl$.otelAttrs <- otel_srcref_attributes(call_srcref, fn_name = "reactiveValues")
}
impl$mset(args)
@@ -1130,7 +1130,7 @@ reactive <- function(
call_srcref <- get_call_srcref()
if (!is.null(call_srcref)) {
o$.otelAttrs <- otel_srcref_attributes(call_srcref)
o$.otelAttrs <- otel_srcref_attributes(call_srcref, fn_name = "reactive")
}
ret <- structure(
@@ -1587,7 +1587,7 @@ observe <- function(
..stacktraceon = ..stacktraceon
)
if (!is.null(call_srcref)) {
o$.otelAttrs <- otel_srcref_attributes(call_srcref)
o$.otelAttrs <- otel_srcref_attributes(call_srcref, fn_name = "observe")
}
if (has_otel_collect("reactivity")) {
@@ -2055,7 +2055,7 @@ reactive_poll_impl <- function(
otel_label_reactive_poll(label, domain = impl$.domain)
else if (fnName == "reactiveFileReader")
otel_label_reactive_file_reader(label, domain = impl$.domain)
impl$.otelAttrs <- append_otel_srcref_attrs(impl$.otelAttrs, call_srcref)
impl$.otelAttrs <- append_otel_srcref_attrs(impl$.otelAttrs, call_srcref, fn_name = fnName)
})
return(re)
@@ -2522,7 +2522,7 @@ observeEvent <- function(eventExpr, handlerExpr,
})
if (!is.null(call_srcref)) {
o$.otelAttrs <- otel_srcref_attributes(call_srcref)
o$.otelAttrs <- otel_srcref_attributes(call_srcref, fn_name = "observeEvent")
}
if (has_otel_collect("reactivity")) {
o <- enable_otel_observe(o)
@@ -2571,7 +2571,7 @@ eventReactive <- function(eventExpr, valueExpr,
if (!is.null(call_srcref)) {
impl <- attr(r, "observable", exact = TRUE)
impl$.otelAttrs <- otel_srcref_attributes(call_srcref)
impl$.otelAttrs <- otel_srcref_attributes(call_srcref, fn_name = "eventReactive")
}
if (has_otel_collect("reactivity")) {
r <- enable_otel_reactive_expr(r)
@@ -2778,7 +2778,7 @@ debounce <- function(r, millis, priority = 100, domain = getDefaultReactiveDomai
local({
er_impl <- attr(er, "observable", exact = TRUE)
er_impl$.otelLabel <- otel_label_debounce(label, domain = domain)
er_impl$.otelAttrs <- append_otel_srcref_attrs(er_impl$.otelAttrs, call_srcref)
er_impl$.otelAttrs <- append_otel_srcref_attrs(er_impl$.otelAttrs, call_srcref, fn_name = "debounce")
})
with_no_otel_collect({
@@ -2877,7 +2877,7 @@ throttle <- function(r, millis, priority = 100, domain = getDefaultReactiveDomai
local({
er_impl <- attr(er, "observable", exact = TRUE)
er_impl$.otelLabel <- otel_label_throttle(label, domain = domain)
er_impl$.otelAttrs <- append_otel_srcref_attrs(er_impl$.otelAttrs, call_srcref)
er_impl$.otelAttrs <- append_otel_srcref_attrs(er_impl$.otelAttrs, call_srcref, fn_name = "throttle")
})
er

4
R/shinywrappers.R
View File

@@ -136,7 +136,9 @@ markRenderFunction <- function(
otelAttrs <-
otel_srcref_attributes(
attr(renderFunc, "wrappedFunc", exact = TRUE)
attr(renderFunc, "wrappedFunc", exact = TRUE),
# Can't retrieve the render function used at this point, so just use NULL
fn_name = NULL
)
ret <- structure(

306
tests/testthat/test-otel-attr-srcref.R
View File

@@ -101,9 +101,30 @@ test_that("otel_srcref_attributes extracts attributes from srcref object", {
attrs <- otel_srcref_attributes(srcref)
# Preferred attribute names
expect_equal(attrs[["code.file.path"]], "/path/to/myfile.R")
expect_equal(attrs[["code.line.number"]], 15)
expect_equal(attrs[["code.column.number"]], 8)
expect_false("code.function.name" %in% names(attrs))
# Deprecated attribute names (for backward compatibility)
expect_equal(attrs[["code.filepath"]], "/path/to/myfile.R")
expect_equal(attrs[["code.lineno"]], 15)
expect_equal(attrs[["code.column"]], 8)
# Test with function name
attrs_with_fn <- otel_srcref_attributes(srcref, fn_name = "myFunction")
# Preferred names
expect_equal(attrs_with_fn[["code.file.path"]], "/path/to/myfile.R")
expect_equal(attrs_with_fn[["code.line.number"]], 15)
expect_equal(attrs_with_fn[["code.column.number"]], 8)
expect_equal(attrs_with_fn[["code.function.name"]], "myFunction")
# Deprecated names
expect_equal(attrs_with_fn[["code.filepath"]], "/path/to/myfile.R")
expect_equal(attrs_with_fn[["code.lineno"]], 15)
expect_equal(attrs_with_fn[["code.column"]], 8)
})
test_that("otel_srcref_attributes handles NULL srcref", {
@@ -127,9 +148,21 @@ test_that("otel_srcref_attributes extracts from function with srcref", {
{
attrs <- otel_srcref_attributes(mock_func)
expect_equal(attrs[["code.filepath"]], "function_file.R")
expect_equal(attrs[["code.lineno"]], 42)
expect_equal(attrs[["code.column"]], 12)
expect_equal(attrs[["code.file.path"]], "function_file.R")
expect_equal(attrs[["code.line.number"]], 42)
expect_equal(attrs[["code.column.number"]], 12)
expect_false("code.function.name" %in% names(attrs))
# Test with function name
attrs_with_fn <- otel_srcref_attributes(
mock_func,
fn_name = "testFunction"
)
expect_equal(attrs_with_fn[["code.file.path"]], "function_file.R")
expect_equal(attrs_with_fn[["code.line.number"]], 42)
expect_equal(attrs_with_fn[["code.column.number"]], 12)
expect_equal(attrs_with_fn[["code.function.name"]], "testFunction")
}
)
})
@@ -186,11 +219,27 @@ test_that("otel_srcref_attributes drops NULL values", {
attrs <- otel_srcref_attributes(srcref)
# Should only contain lineno and column, not filepath
expect_equal(length(attrs), 2)
# Should only contain lineno and column (both preferred and deprecated)
expect_equal(length(attrs), 4) # 2 preferred + 2 deprecated
# Preferred names
expect_equal(attrs[["code.line.number"]], 10)
expect_equal(attrs[["code.column.number"]], 5)
expect_false("code.file.path" %in% names(attrs))
expect_false("code.function.name" %in% names(attrs))
# Deprecated names
expect_equal(attrs[["code.lineno"]], 10)
expect_equal(attrs[["code.column"]], 5)
expect_false("code.filepath" %in% names(attrs))
# Test with function name - NULL fn_name should still be dropped
attrs_with_null_fn <- otel_srcref_attributes(srcref, fn_name = NULL)
expect_equal(length(attrs_with_null_fn), 4)
expect_false("code.function.name" %in% names(attrs_with_null_fn))
# Test with function name provided
attrs_with_fn <- otel_srcref_attributes(srcref, fn_name = "testFunc")
expect_equal(length(attrs_with_fn), 5) # 4 location + 1 function name
expect_equal(attrs_with_fn[["code.function.name"]], "testFunc")
})
test_that("otel_srcref_attributes handles missing srcfile", {
@@ -202,8 +251,13 @@ test_that("otel_srcref_attributes handles missing srcfile", {
attrs <- otel_srcref_attributes(srcref)
# Should only contain lineno and column
expect_equal(length(attrs), 2)
# Should only contain lineno and column (both preferred and deprecated)
expect_equal(length(attrs), 4) # 2 preferred + 2 deprecated
# Preferred names
expect_equal(attrs[["code.line.number"]], 10)
expect_equal(attrs[["code.column.number"]], 5)
expect_false("code.file.path" %in% names(attrs))
# Deprecated names
expect_equal(attrs[["code.lineno"]], 10)
expect_equal(attrs[["code.column"]], 5)
expect_false("code.filepath" %in% names(attrs))
@@ -217,9 +271,10 @@ test_that("reactive() captures otel attributes from source reference", {
x <- get_reactive_objects()$reactive
attrs <- attr(x, "observable")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.lineno"]], 4)
expect_equal(attrs[["code.column"]], 3)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.line.number"]], 4)
expect_equal(attrs[["code.column.number"]], 3)
expect_equal(attrs[["code.function.name"]], "reactive")
})
test_that("reactiveVal() captures otel attributes from source reference", {
@@ -228,9 +283,10 @@ test_that("reactiveVal() captures otel attributes from source reference", {
# Test the attribute extraction that would be used in reactiveVal
attrs <- attr(x, ".impl")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.lineno"]], 5)
expect_equal(attrs[["code.column"]], 3)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.line.number"]], 5)
expect_equal(attrs[["code.column.number"]], 3)
expect_equal(attrs[["code.function.name"]], "reactiveVal")
})
test_that("reactiveValues() captures otel attributes from source reference", {
@@ -238,36 +294,41 @@ test_that("reactiveValues() captures otel attributes from source reference", {
attrs <- .subset2(x, "impl")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.lineno"]], 6)
expect_equal(attrs[["code.column"]], 3)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.line.number"]], 6)
expect_equal(attrs[["code.column.number"]], 3)
expect_equal(attrs[["code.function.name"]], "reactiveValues")
})
test_that("observe() captures otel attributes from source reference", {
x <- get_reactive_objects()$observe
attrs <- x$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.lineno"]], 7)
expect_equal(attrs[["code.column"]], 3)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.line.number"]], 7)
expect_equal(attrs[["code.column.number"]], 3)
expect_equal(attrs[["code.function.name"]], "observe")
})
test_that("otel attributes integration with render functions", {
x <- get_reactive_objects()$renderText
attrs <- attr(x, "otelAttrs")
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.lineno"]], 8)
expect_equal(attrs[["code.column"]], 20)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.line.number"]], 8)
expect_equal(attrs[["code.column.number"]], 20)
# Render functions should NOT have code.function.name
expect_false("code.function.name" %in% names(attrs))
})
test_that("observeEvent() captures otel attributes from source reference", {
x <- get_reactive_objects()$observeEvent
attrs <- x$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.lineno"]], 9)
expect_equal(attrs[["code.column"]], 3)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.line.number"]], 9)
expect_equal(attrs[["code.column.number"]], 3)
expect_equal(attrs[["code.function.name"]], "observeEvent")
})
test_that("otel attributes follow OpenTelemetry semantic conventions", {
@@ -282,15 +343,33 @@ test_that("otel attributes follow OpenTelemetry semantic conventions", {
attrs <- otel_srcref_attributes(srcref)
# Check that attribute names follow the convention
# Check that preferred attribute names follow the convention
expect_true("code.file.path" %in% names(attrs))
expect_true("code.line.number" %in% names(attrs))
expect_true("code.column.number" %in% names(attrs))
expect_false("code.function.name" %in% names(attrs))
# Check that deprecated names are also present
expect_true("code.filepath" %in% names(attrs))
expect_true("code.lineno" %in% names(attrs))
expect_true("code.column" %in% names(attrs))
# Check that values are of correct types
expect_true(is.character(attrs[["code.filepath"]]))
expect_true(is.numeric(attrs[["code.lineno"]]))
expect_true(is.numeric(attrs[["code.column"]]))
# Check that values are of correct types (preferred names)
expect_true(is.character(attrs[["code.file.path"]]))
expect_true(is.numeric(attrs[["code.line.number"]]))
expect_true(is.numeric(attrs[["code.column.number"]]))
# Check that deprecated names have same values
expect_equal(attrs[["code.file.path"]], attrs[["code.filepath"]])
expect_equal(attrs[["code.line.number"]], attrs[["code.lineno"]])
expect_equal(attrs[["code.column.number"]], attrs[["code.column"]])
# Test with function name
attrs_with_fn <- otel_srcref_attributes(srcref, fn_name = "myFunc")
expect_true("code.function.name" %in% names(attrs_with_fn))
expect_true(is.character(attrs_with_fn[["code.function.name"]]))
expect_equal(attrs_with_fn[["code.function.name"]], "myFunc")
})
test_that("dropNulls helper works correctly in otel_srcref_attributes", {
@@ -302,7 +381,7 @@ test_that("dropNulls helper works correctly in otel_srcref_attributes", {
)
attrs <- otel_srcref_attributes(srcref)
expect_equal(length(attrs), 3)
expect_equal(length(attrs), 6) # 3 preferred + 3 deprecated
# Test with missing filename (NULL)
srcref_no_file <- structure(
@@ -312,16 +391,17 @@ test_that("dropNulls helper works correctly in otel_srcref_attributes", {
attr(srcref_no_file, "srcfile") <- list(filename = NULL)
attrs_no_file <- otel_srcref_attributes(srcref_no_file)
expect_equal(length(attrs_no_file), 2)
expect_equal(length(attrs_no_file), 4) # 2 preferred + 2 deprecated
expect_false("code.file.path" %in% names(attrs_no_file))
expect_false("code.filepath" %in% names(attrs_no_file))
})
test_that("otel attributes are used in reactive context execution", {
# Test that otel attributes are properly passed through to spans
mock_attrs <- list(
"code.filepath" = "context_test.R",
"code.lineno" = 42L,
"code.column" = 8L
"code.file.path" = "context_test.R",
"code.line.number" = 42L,
"code.column.number" = 8L
)
# Test the context info structure used in react.R
@@ -342,9 +422,9 @@ test_that("otel attributes are combined with session attributes", {
# as happens in the reactive system
srcref_attrs <- list(
"code.filepath" = "session_test.R",
"code.lineno" = 15L,
"code.column" = 5L
"code.file.path" = "session_test.R",
"code.line.number" = 15L,
"code.column.number" = 5L
)
session_attrs <- list(
@@ -355,8 +435,8 @@ test_that("otel attributes are combined with session attributes", {
combined_attrs <- c(srcref_attrs, session_attrs)
expect_equal(length(combined_attrs), 4)
expect_equal(combined_attrs[["code.filepath"]], "session_test.R")
expect_equal(combined_attrs[["code.lineno"]], 15L)
expect_equal(combined_attrs[["code.file.path"]], "session_test.R")
expect_equal(combined_attrs[["code.line.number"]], 15L)
expect_equal(combined_attrs[["session.id"]], "test-session-123")
})
@@ -364,25 +444,28 @@ test_that("eventReactive() captures otel attributes from source reference", {
x <- get_reactive_objects()$eventReactive
attrs <- attr(x, "observable")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.lineno"]], 10)
expect_equal(attrs[["code.column"]], 3)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.line.number"]], 10)
expect_equal(attrs[["code.column.number"]], 3)
expect_equal(attrs[["code.function.name"]], "eventReactive")
})
test_that("renderText() with bindCache() captures otel attributes", {
x <- get_reactive_objects()$renderCacheA
attrs <- attr(x, "otelAttrs")
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_false("code.function.name" %in% names(attrs))
})
test_that("renderText() with bindEvent() captures otel attributes", {
x <- get_reactive_objects()$renderEventA
attrs <- attr(x, "otelAttrs")
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_false("code.function.name" %in% names(attrs))
})
test_that(
@@ -391,8 +474,9 @@ test_that(
x <- get_reactive_objects()$renderCacheEventA
attrs <- attr(x, "otelAttrs")
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_false("code.function.name" %in% names(attrs))
}
)
@@ -400,16 +484,18 @@ test_that("bindCache() wrapping renderText() captures otel attributes", {
x <- get_reactive_objects()$renderCacheB
attrs <- attr(x, "otelAttrs")
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_false("code.function.name" %in% names(attrs))
})
test_that("bindEvent() wrapping renderText() captures otel attributes", {
x <- get_reactive_objects()$renderEventB
attrs <- attr(x, "otelAttrs")
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_false("code.function.name" %in% names(attrs))
})
test_that(
@@ -418,8 +504,9 @@ test_that(
x <- get_reactive_objects()$renderCacheEventB
attrs <- attr(x, "otelAttrs")
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_false("code.function.name" %in% names(attrs))
}
)
@@ -427,32 +514,36 @@ test_that("observe() with bindEvent() captures otel attributes", {
x <- get_reactive_objects()$observeEventA
attrs <- x$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_equal(attrs[["code.function.name"]], "bindEvent")
})
test_that("bindEvent() wrapping observe() captures otel attributes", {
x <- get_reactive_objects()$observeEventB
attrs <- x$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_equal(attrs[["code.function.name"]], "bindEvent")
})
test_that("reactive() with bindCache() captures otel attributes", {
x <- get_reactive_objects()$reactiveCacheA
attrs <- attr(x, "observable")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_equal(attrs[["code.function.name"]], "bindCache")
})
test_that("reactive() with bindEvent() captures otel attributes", {
x <- get_reactive_objects()$reactiveEventA
attrs <- attr(x, "observable")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_equal(attrs[["code.function.name"]], "bindEvent")
})
test_that(
@@ -461,8 +552,9 @@ test_that(
x <- get_reactive_objects()$reactiveCacheEventA
attrs <- attr(x, "observable")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_equal(attrs[["code.function.name"]], "bindEvent")
}
)
@@ -470,16 +562,18 @@ test_that("bindCache() wrapping reactive() captures otel attributes", {
x <- get_reactive_objects()$reactiveCacheB
attrs <- attr(x, "observable")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_equal(attrs[["code.function.name"]], "bindCache")
})
test_that("bindEvent() wrapping reactive() captures otel attributes", {
x <- get_reactive_objects()$reactiveEventB
attrs <- attr(x, "observable")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_equal(attrs[["code.function.name"]], "bindEvent")
})
test_that(
@@ -488,8 +582,9 @@ test_that(
x <- get_reactive_objects()$reactiveCacheEventB
attrs <- attr(x, "observable")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_equal(attrs[["code.function.name"]], "bindEvent")
}
)
@@ -498,16 +593,18 @@ test_that("debounce() creates new reactive with otel attributes", {
x <- get_reactive_objects()$debounce
attrs <- attr(x, "observable")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_equal(attrs[["code.function.name"]], "debounce")
})
test_that("throttle() creates new reactive with otel attributes", {
x <- get_reactive_objects()$throttle
attrs <- attr(x, "observable")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_equal(attrs[["code.function.name"]], "throttle")
})
# Tests for ExtendedTask
@@ -518,8 +615,9 @@ test_that("ExtendedTask is created and is an R6 object", {
attrs <- .subset2(x, ".__enclos_env__")$private$otel_attrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_equal(attrs[["code.function.name"]], "ExtendedTask")
})
# Tests for reactivePoll
@@ -531,8 +629,9 @@ test_that("reactivePoll() captures otel attributes from source reference", {
expect_equal(as.character(otelLabel), "reactivePoll r_poll")
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_equal(attrs[["code.function.name"]], "reactivePoll")
})
# Tests for reactiveFileReader
@@ -544,8 +643,9 @@ test_that("reactiveFileReader() captures otel attributes from source reference",
expect_equal(as.character(otelLabel), "reactiveFileReader r_file")
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.lineno"]], 12)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_gt(attrs[["code.line.number"]], 12)
expect_equal(attrs[["code.function.name"]], "reactiveFileReader")
})
# Tests for explicit labels
@@ -553,9 +653,10 @@ test_that("reactive() with explicit label still captures otel attributes", {
x <- get_reactive_objects()$reactiveLabeled
attrs <- attr(x, "observable")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.lineno"]], 38)
expect_equal(attrs[["code.column"]], 3)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.line.number"]], 38)
expect_equal(attrs[["code.column.number"]], 3)
expect_equal(attrs[["code.function.name"]], "reactive")
# Verify label is preserved
label <- attr(x, "observable")$.label
@@ -566,9 +667,10 @@ test_that("observe() with explicit label still captures otel attributes", {
x <- get_reactive_objects()$observeLabeled
attrs <- x$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.lineno"]], 39)
expect_equal(attrs[["code.column"]], 3)
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.line.number"]], 39)
expect_equal(attrs[["code.column.number"]], 3)
expect_equal(attrs[["code.function.name"]], "observe")
# Verify label is preserved
expect_equal(x$.label, "my_observer")
@@ -583,10 +685,10 @@ test_that("reactive created inside function captures function srcref", {
r <- create_reactive()
attrs <- attr(r, "observable")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
# Line number should point to where reactive() is called inside the function
expect_true(is.numeric(attrs[["code.lineno"]]))
expect_true(is.numeric(attrs[["code.column"]]))
expect_true(is.numeric(attrs[["code.line.number"]]))
expect_true(is.numeric(attrs[["code.column.number"]]))
})
test_that("observe created inside function captures function srcref", {
@@ -597,9 +699,9 @@ test_that("observe created inside function captures function srcref", {
o <- create_observer()
attrs <- o$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_true(is.numeric(attrs[["code.lineno"]]))
expect_true(is.numeric(attrs[["code.column"]]))
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_true(is.numeric(attrs[["code.line.number"]]))
expect_true(is.numeric(attrs[["code.column.number"]]))
})
test_that("reactive returned from function preserves srcref", {
@@ -610,8 +712,8 @@ test_that("reactive returned from function preserves srcref", {
counter <- make_counter(42)
attrs <- attr(counter, "observable")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_true(is.numeric(attrs[["code.lineno"]]))
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_true(is.numeric(attrs[["code.line.number"]]))
})
test_that("reactiveVal created in function captures srcref", {
@@ -622,8 +724,8 @@ test_that("reactiveVal created in function captures srcref", {
rv <- create_val()
attrs <- attr(rv, ".impl")$.otelAttrs
expect_equal(attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_true(is.numeric(attrs[["code.lineno"]]))
expect_equal(attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_true(is.numeric(attrs[["code.line.number"]]))
})
test_that("nested reactive expressions preserve individual srcrefs", {
@@ -633,17 +735,17 @@ test_that("nested reactive expressions preserve individual srcrefs", {
})
outer_attrs <- attr(outer_reactive, "observable")$.otelAttrs
expect_equal(outer_attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_true(is.numeric(outer_attrs[["code.lineno"]]))
expect_equal(outer_attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_true(is.numeric(outer_attrs[["code.line.number"]]))
# Get the inner reactive by executing outer
withReactiveDomain(MockShinySession$new(), {
inner_reactive <- isolate(outer_reactive())
inner_attrs <- attr(inner_reactive, "observable")$.otelAttrs
expect_equal(inner_attrs[["code.filepath"]], "test-otel-attr-srcref.R")
expect_true(is.numeric(inner_attrs[["code.lineno"]]))
expect_equal(inner_attrs[["code.file.path"]], "test-otel-attr-srcref.R")
expect_true(is.numeric(inner_attrs[["code.line.number"]]))
# Inner should have different line number than outer
expect_false(inner_attrs[["code.lineno"]] == outer_attrs[["code.lineno"]])
expect_false(inner_attrs[["code.line.number"]] == outer_attrs[["code.line.number"]])
})
})

93
tests/testthat/test-otel-mock.R
View File

@@ -1,14 +1,47 @@
skip_on_cran()
skip_if_not_installed("otelsdk")
expect_code_attrs <- function(trace) {
expect_code_attrs <- function(trace, expected_fn_name = NULL) {
testthat::expect_true(!is.null(trace))
testthat::expect_true(is.list(trace$attributes))
# Check preferred attribute names
testthat::expect_true(is.character(trace$attributes[["code.file.path"]]))
testthat::expect_equal(trace$attributes[["code.file.path"]], "test-otel-mock.R")
testthat::expect_true(is.numeric(trace$attributes[["code.line.number"]]))
testthat::expect_true(is.numeric(trace$attributes[["code.column.number"]]))
# Check deprecated attribute names (for backward compatibility)
testthat::expect_true(is.character(trace$attributes[["code.filepath"]]))
testthat::expect_equal(trace$attributes[["code.filepath"]], "test-otel-mock.R")
testthat::expect_true(is.numeric(trace$attributes[["code.lineno"]]))
testthat::expect_true(is.numeric(trace$attributes[["code.column"]]))
# Verify deprecated names match preferred names
testthat::expect_equal(
trace$attributes[["code.file.path"]],
trace$attributes[["code.filepath"]]
)
testthat::expect_equal(
trace$attributes[["code.line.number"]],
trace$attributes[["code.lineno"]]
)
testthat::expect_equal(
trace$attributes[["code.column.number"]],
trace$attributes[["code.column"]]
)
# Check code.function.name if expected
if (!is.null(expected_fn_name)) {
testthat::expect_true(
is.character(trace$attributes[["code.function.name"]])
)
testthat::expect_equal(
trace$attributes[["code.function.name"]],
expected_fn_name
)
}
invisible(trace)
}
MOCK_SESSION_TOKEN <- "test-session-token"
@@ -21,7 +54,7 @@ expect_session_id <- function(trace) {
invisible(trace)
}
expect_trace <- function(traces, name, pos = 1) {
expect_trace <- function(traces, name, pos = 1, expected_fn_name = NULL) {
# Filter to traces with the given name
trace_set <- traces[which(names(traces) == name)]
testthat::expect_gte(length(trace_set), pos)
@@ -30,7 +63,7 @@ expect_trace <- function(traces, name, pos = 1) {
trace <- trace_set[[pos]]
testthat::expect_true(is.list(trace))
expect_code_attrs(trace)
expect_code_attrs(trace, expected_fn_name = expected_fn_name)
expect_session_id(trace)
trace
@@ -78,9 +111,9 @@ for (bind in c("all", "reactivity")) {
session$flushReact()
})
expect_trace(traces, "observe mock-session:<anonymous>")
expect_trace(traces, "observe mock-session:my_observe")
expect_trace(traces, "observe mock-session:labeled observer")
expect_trace(traces, "observe mock-session:<anonymous>", 1, "observe")
expect_trace(traces, "observe mock-session:my_observe", 1, "observe")
expect_trace(traces, "observe mock-session:labeled observer", 1, "observe")
})
test_that(paste0("bind='", bind, "' handles reactiveVal / reactiveValues"), {
@@ -104,7 +137,7 @@ for (bind in c("all", "reactivity")) {
expect_equal(rv(), 1)
})
expect_trace(traces, "observe mock-session:<anonymous>")
expect_trace(traces, "observe mock-session:<anonymous>", 1, "observe")
# TODO-future: Add tests to see the `Set reactiveVal mock-session:rv` logs
# Requires: https://github.com/r-lib/otelsdk/issues/21
@@ -131,10 +164,16 @@ for (bind in c("all", "reactivity")) {
expect_equal(r3(), 42)
})
observe_trace <- expect_trace(traces, "observe mock-session:obs_r3")
r_trace <- expect_trace(traces, "reactive mock-session:r")
r2_trace <- expect_trace(traces, "reactive mock-session:<anonymous>")
r3_trace <- expect_trace(traces, "reactive mock-session:labeled_rv")
observe_trace <- expect_trace(
traces, "observe mock-session:obs_r3", 1, "observe"
)
r_trace <- expect_trace(traces, "reactive mock-session:r", 1, "reactive")
r2_trace <- expect_trace(
traces, "reactive mock-session:<anonymous>", 1, "reactive"
)
r3_trace <- expect_trace(
traces, "reactive mock-session:labeled_rv", 1, "reactive"
)
expect_equal(r_trace$parent, r2_trace$span_id)
expect_equal(r2_trace$parent, r3_trace$span_id)
@@ -157,7 +196,9 @@ for (bind in c("all", "reactivity")) {
expect_equal(output$txt, "Hello, world!")
})
expect_trace(traces, "output mock-session:txt")
# Outputs (render functions) should NOT have code.function.name
trace <- expect_trace(traces, "output mock-session:txt", 1, NULL)
expect_false("code.function.name" %in% names(trace$attributes))
})
test_that(paste0("bind='", bind, "' extended tasks are supported"), {
@@ -183,18 +224,28 @@ for (bind in c("all", "reactivity")) {
traces <- test_server_with_otel(session, server, bind = bind, {
session$flushReact()
while(!later::loop_empty()) {
while (!later::loop_empty()) {
later::run_now()
session$flushReact()
}
session$flushReact()
})
invoke_obs <- expect_trace(traces, "observe mock-session:invoke task")
render1_trace <- expect_trace(traces, "output mock-session:result")
ex_task_trace <- expect_trace(traces, "ExtendedTask mock-session:rand_task")
invoke_obs <- expect_trace(
traces, "observe mock-session:invoke task", 1, "observe"
)
# Render functions should NOT have code.function.name
render1_trace <- expect_trace(traces, "output mock-session:result", 1, NULL)
expect_false("code.function.name" %in% names(render1_trace$attributes))
render2_trace <- expect_trace(traces, "output mock-session:result", pos = 2)
ex_task_trace <- expect_trace(
traces, "ExtendedTask mock-session:rand_task", 1, "ExtendedTask"
)
render2_trace <- expect_trace(
traces, "output mock-session:result", pos = 2, NULL
)
expect_false("code.function.name" %in% names(render2_trace$attributes))
expect_equal(invoke_obs$span_id, ex_task_trace$parent)
})
@@ -222,9 +273,11 @@ test_that("bind = 'reactivity' traces reactive components", {
})
# Should trace reactive components (equivalent to "all")
expect_trace(traces, "observe mock-session:test_obs")
expect_trace(traces, "reactive mock-session:r")
expect_trace(traces, "output mock-session:txt")
expect_trace(traces, "observe mock-session:test_obs", 1, "observe")
expect_trace(traces, "reactive mock-session:r", 1, "reactive")
# Render functions should NOT have code.function.name
txt_trace <- expect_trace(traces, "output mock-session:txt", 1, NULL)
expect_false("code.function.name" %in% names(txt_trace$attributes))
})