From c34b3d67a9bc06d99a7a1d9f7fe13967dc6fbf72 Mon Sep 17 00:00:00 2001 From: shikokuchuo <53399081+shikokuchuo@users.noreply.github.com> Date: Thu, 6 Nov 2025 13:31:25 +0000 Subject: [PATCH 1/4] OpenTelemetry instrumentation concept --- DESCRIPTION | 2 ++ R/otel.R | 53 ++++++++++++++++++++++++++++++++++++++ R/test-that.R | 1 + R/testthat-package.R | 8 ++++++ tests/testthat/test-otel.R | 18 +++++++++++++ 5 files changed, 82 insertions(+) create mode 100644 R/otel.R create mode 100644 tests/testthat/test-otel.R diff --git a/DESCRIPTION b/DESCRIPTION index dac7aaf67..348378e2d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -42,6 +42,8 @@ Suggests: digest (>= 0.6.33), gh, knitr, + otel, + otelsdk, rmarkdown, rstudioapi, S7, diff --git a/R/otel.R b/R/otel.R new file mode 100644 index 000000000..bb85c88fd --- /dev/null +++ b/R/otel.R @@ -0,0 +1,53 @@ +otel_tracer_name <- "org.r-lib.testthat" +otel_is_tracing <- FALSE +otel_tracer <- NULL + +# generic otel helpers --------------------------------------------------------- + +# nocov start + +otel_cache_tracer <- function() { + requireNamespace("otel", quietly = TRUE) || return() + otel_tracer <<- otel::get_tracer(otel_tracer_name) + otel_is_tracing <<- tracer_enabled(otel_tracer) +} + +# nocov end + +tracer_enabled <- function(tracer) { + .subset2(tracer, "is_enabled")() +} + +otel_refresh_tracer <- function() { + requireNamespace("otel", quietly = TRUE) || return() + tracer <- otel::get_tracer() + modify_binding( + topenv(), + list(otel_tracer = tracer, otel_is_tracing = tracer_enabled(tracer)) + ) +} + +modify_binding <- function(env, lst) { + lapply(names(lst), unlockBinding, env) + list2env(lst, envir = env) + lapply(names(lst), lockBinding, env) +} + +otel_local_active_span <- function( + name, + label, + attributes = list(), + links = NULL, + options = NULL, + scope = parent.frame() +) { + otel_is_tracing || return() + spn <- otel::start_local_active_span( + sprintf("%s %s", name, label), + attributes = otel::as_attributes(attributes), + links = links, + options = options, + tracer = otel_tracer, + activation_scope = scope + ) +} diff --git a/R/test-that.R b/R/test-that.R index 4e7fbae92..c5650f3f8 100644 --- a/R/test-that.R +++ b/R/test-that.R @@ -35,6 +35,7 @@ #' } test_that <- function(desc, code) { local_description_push(desc) + otel_local_active_span("test that", desc) code <- substitute(code) test_code(code, parent.frame()) diff --git a/R/testthat-package.R b/R/testthat-package.R index 61fa9b316..cd37f9674 100644 --- a/R/testthat-package.R +++ b/R/testthat-package.R @@ -30,3 +30,11 @@ the$in_check_reporter <- FALSE #' @importFrom lifecycle deprecated ## usethis namespace: end NULL + +# nocov start + +.onLoad <- function(libname, pkgname) { + otel_cache_tracer() +} + +# nocov end diff --git a/tests/testthat/test-otel.R b/tests/testthat/test-otel.R new file mode 100644 index 000000000..1954347a1 --- /dev/null +++ b/tests/testthat/test-otel.R @@ -0,0 +1,18 @@ +test_that("otel instrumentation works", { + skip_if_not_installed("otelsdk") + + record <- otelsdk::with_otel_record({ + otel_refresh_tracer() + test_that("otel testing", { + expect_equal(1, 1) + expect_error(stop("otel error")) + }) + }) + # reset tracer after tests + otel_refresh_tracer() + + traces <- record$traces + expect_length(traces, 1L) + expect_equal(traces[[1L]]$name, "test that otel testing") + expect_equal(traces[[1L]]$instrumentation_scope$name , "org.r-lib.testthat") +}) From 0a2deba7f877bd458a3963795d0270be9322b623 Mon Sep 17 00:00:00 2001 From: shikokuchuo <53399081+shikokuchuo@users.noreply.github.com> Date: Thu, 6 Nov 2025 13:44:55 +0000 Subject: [PATCH 2/4] CI: skip otelsdk installation on older platforms --- .github/workflows/R-CMD-check.yaml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index a003f2e78..2f7950c55 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -58,7 +58,9 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::rcmdcheck + extra-packages: | + any::rcmdcheck + otelsdk=?ignore-before-r=4.3.0 needs: check - uses: r-lib/actions/check-r-package@v2 From efbf81965666eda050770f6a1b043f0f603b0bc3 Mon Sep 17 00:00:00 2001 From: shikokuchuo <53399081+shikokuchuo@users.noreply.github.com> Date: Sat, 8 Nov 2025 12:48:35 +0000 Subject: [PATCH 3/4] Update otel tracer caching implementation --- R/otel.R | 81 ++++++++++++++++++-------------------- tests/testthat/test-otel.R | 5 +-- 2 files changed, 39 insertions(+), 47 deletions(-) diff --git a/R/otel.R b/R/otel.R index bb85c88fd..5c7d27d21 100644 --- a/R/otel.R +++ b/R/otel.R @@ -1,53 +1,48 @@ otel_tracer_name <- "org.r-lib.testthat" -otel_is_tracing <- FALSE -otel_tracer <- NULL # generic otel helpers --------------------------------------------------------- -# nocov start - -otel_cache_tracer <- function() { - requireNamespace("otel", quietly = TRUE) || return() - otel_tracer <<- otel::get_tracer(otel_tracer_name) - otel_is_tracing <<- tracer_enabled(otel_tracer) -} - -# nocov end +otel_cache_tracer <- NULL +otel_local_active_span <- NULL + +local({ + otel_is_tracing <- FALSE + otel_tracer <- NULL + + otel_cache_tracer <<- function() { + requireNamespace("otel", quietly = TRUE) || return() + otel_tracer <<- otel::get_tracer(otel_tracer_name) + otel_is_tracing <<- tracer_enabled(otel_tracer) + } + + otel_local_active_span <<- function( + name, + label, + attributes = list(), + links = NULL, + options = NULL, + scope = parent.frame() + ) { + otel_is_tracing || return() + spn <- otel::start_local_active_span( + sprintf("%s %s", name, label), + attributes = otel::as_attributes(attributes), + links = links, + options = options, + tracer = otel_tracer, + activation_scope = scope + ) + } +}) tracer_enabled <- function(tracer) { .subset2(tracer, "is_enabled")() } -otel_refresh_tracer <- function() { - requireNamespace("otel", quietly = TRUE) || return() - tracer <- otel::get_tracer() - modify_binding( - topenv(), - list(otel_tracer = tracer, otel_is_tracing = tracer_enabled(tracer)) - ) -} - -modify_binding <- function(env, lst) { - lapply(names(lst), unlockBinding, env) - list2env(lst, envir = env) - lapply(names(lst), lockBinding, env) -} - -otel_local_active_span <- function( - name, - label, - attributes = list(), - links = NULL, - options = NULL, - scope = parent.frame() -) { - otel_is_tracing || return() - spn <- otel::start_local_active_span( - sprintf("%s %s", name, label), - attributes = otel::as_attributes(attributes), - links = links, - options = options, - tracer = otel_tracer, - activation_scope = scope - ) +with_otel_record <- function(expr) { + on.exit(otel_cache_tracer()) + otelsdk::with_otel_record({ + otel_cache_tracer() + expr + }) } diff --git a/tests/testthat/test-otel.R b/tests/testthat/test-otel.R index 1954347a1..5f0c4d759 100644 --- a/tests/testthat/test-otel.R +++ b/tests/testthat/test-otel.R @@ -1,15 +1,12 @@ test_that("otel instrumentation works", { skip_if_not_installed("otelsdk") - record <- otelsdk::with_otel_record({ - otel_refresh_tracer() + record <- with_otel_record({ test_that("otel testing", { expect_equal(1, 1) expect_error(stop("otel error")) }) }) - # reset tracer after tests - otel_refresh_tracer() traces <- record$traces expect_length(traces, 1L) From c2917afe291538704adeffd4c672067447ddc4d0 Mon Sep 17 00:00:00 2001 From: shikokuchuo <53399081+shikokuchuo@users.noreply.github.com> Date: Sat, 8 Nov 2025 23:29:00 +0000 Subject: [PATCH 4/4] Move instrumentation to within `test_code()` --- R/otel.R | 8 +------- R/test-that.R | 2 +- tests/testthat/test-otel.R | 2 +- 3 files changed, 3 insertions(+), 9 deletions(-) diff --git a/R/otel.R b/R/otel.R index 5c7d27d21..192446310 100644 --- a/R/otel.R +++ b/R/otel.R @@ -18,17 +18,11 @@ local({ otel_local_active_span <<- function( name, label, - attributes = list(), - links = NULL, - options = NULL, scope = parent.frame() ) { otel_is_tracing || return() - spn <- otel::start_local_active_span( + otel::start_local_active_span( sprintf("%s %s", name, label), - attributes = otel::as_attributes(attributes), - links = links, - options = options, tracer = otel_tracer, activation_scope = scope ) diff --git a/R/test-that.R b/R/test-that.R index c5650f3f8..638edb0e6 100644 --- a/R/test-that.R +++ b/R/test-that.R @@ -35,7 +35,6 @@ #' } test_that <- function(desc, code) { local_description_push(desc) - otel_local_active_span("test that", desc) code <- substitute(code) test_code(code, parent.frame()) @@ -52,6 +51,7 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) { test <- test_description() if (!is.null(test)) { + otel_local_active_span("test that", test, scope = frame) reporter$start_test(context = reporter$.context, test = test) withr::defer(reporter$end_test(context = reporter$.context, test = test)) } diff --git a/tests/testthat/test-otel.R b/tests/testthat/test-otel.R index 5f0c4d759..f60ab321a 100644 --- a/tests/testthat/test-otel.R +++ b/tests/testthat/test-otel.R @@ -10,6 +10,6 @@ test_that("otel instrumentation works", { traces <- record$traces expect_length(traces, 1L) - expect_equal(traces[[1L]]$name, "test that otel testing") + expect_equal(traces[[1L]]$name, "test that otel instrumentation works / otel testing") expect_equal(traces[[1L]]$instrumentation_scope$name , "org.r-lib.testthat") })