From 63a00f775f5de7c1a8aa8de8805aed92457bc0bf Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Wed, 3 Dec 2025 16:37:20 -0500 Subject: [PATCH] fix(otel): Duplicate otel code attribute keys using both deprecated and preferred names (#4325) --- NEWS.md | 1 + R/bind-cache.R | 2 +- R/bind-event.R | 4 +- R/extended-task.R | 2 +- R/otel-attr-srcref.R | 16 +- R/reactives.R | 18 +- R/shinywrappers.R | 4 +- tests/testthat/test-otel-attr-srcref.R | 306 ++++++++++++++++--------- tests/testthat/test-otel-mock.R | 93 ++++++-- 9 files changed, 306 insertions(+), 140 deletions(-) diff --git a/NEWS.md b/NEWS.md index a63076d51..947f2d22b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -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 diff --git a/R/bind-cache.R b/R/bind-cache.R index 7fdd20262..96b2717f7 100644 --- a/R/bind-cache.R +++ b/R/bind-cache.R @@ -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")) { diff --git a/R/bind-event.R b/R/bind-event.R index df93ef301..814567e3d 100644 --- a/R/bind-event.R +++ b/R/bind-event.R @@ -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) diff --git a/R/extended-task.R b/R/extended-task.R index 4b3069ac7..0c3f001e5 100644 --- a/R/extended-task.R +++ b/R/extended-task.R @@ -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() }, diff --git a/R/otel-attr-srcref.R b/R/otel-attr-srcref.R index 019a5768f..34114a30f 100644 --- a/R/otel-attr-srcref.R +++ b/R/otel-attr-srcref.R @@ -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) } diff --git a/R/reactives.R b/R/reactives.R index 25f2d5c91..8d098c7f9 100644 --- a/R/reactives.R +++ b/R/reactives.R @@ -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 diff --git a/R/shinywrappers.R b/R/shinywrappers.R index b3d1684c1..dca587398 100644 --- a/R/shinywrappers.R +++ b/R/shinywrappers.R @@ -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( diff --git a/tests/testthat/test-otel-attr-srcref.R b/tests/testthat/test-otel-attr-srcref.R index 41abdbc94..8246c3372 100644 --- a/tests/testthat/test-otel-attr-srcref.R +++ b/tests/testthat/test-otel-attr-srcref.R @@ -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"]]) }) }) diff --git a/tests/testthat/test-otel-mock.R b/tests/testthat/test-otel-mock.R index 0bc30d2f8..2b8c78222 100644 --- a/tests/testthat/test-otel-mock.R +++ b/tests/testthat/test-otel-mock.R @@ -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:") - expect_trace(traces, "observe mock-session:my_observe") - expect_trace(traces, "observe mock-session:labeled observer") + expect_trace(traces, "observe mock-session:", 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:") + expect_trace(traces, "observe mock-session:", 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:") - 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:", 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)) })