Add OpenTelemetry instrumentation

.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

DESCRIPTION

@@ -42,6 +42,8 @@ Suggests:
     digest (>= 0.6.33),
     gh,
     knitr,
+    otel,
+    otelsdk,
     rmarkdown,
     rstudioapi,
     S7,

R/otel.R

@@ -0,0 +1,74 @@
+otel_tracer_name <- "org.r-lib.testthat"
+
+# generic otel helpers ---------------------------------------------------------
+
+otel_cache_tracer <- NULL
+otel_local_test_span <- NULL
+otel_update_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_test_span <<- function(name, scope = parent.frame()) {
+    otel_is_tracing || return()
+    otel::start_local_active_span(
+      sprintf("test that %s", name),
+      tracer = otel_tracer,
+      activation_scope = scope
+    )
+  }
+
+  otel_update_span <<- function(
+    span,
+    n_success,
+    n_failure,
+    n_error,
+    n_skip,
+    n_warning
+  ) {
+    otel_is_tracing || return()
+
+    total <- n_success + n_failure + n_error + n_skip + n_warning
+    test_status <- if (n_error > 0) {
+      "error"
+    } else if (n_failure > 0) {
+      "fail"
+    } else if (total == 0 || n_skip == total) {
+      "skip"
+    } else {
+      "pass"
+    }
+    span$set_attribute("test.expectations.total", total)
+    span$set_attribute("test.expectations.passed", n_success)
+    span$set_attribute("test.expectations.failed", n_failure)
+    span$set_attribute("test.expectations.error", n_error)
+    span$set_attribute("test.expectations.skipped", n_skip)
+    span$set_attribute("test.expectations.warning", n_warning)
+    span$set_attribute("test.status", test_status)
+
+    if (test_status %in% c("pass", "skip")) {
+      span$set_status("ok")
+    } else {
+      span$set_status("error", paste("Test", test_status))
+    }
+  }
+})
+
+tracer_enabled <- function(tracer) {
+  .subset2(tracer, "is_enabled")()
+}
+
+with_otel_record <- function(expr) {
+  on.exit(otel_cache_tracer())
+  otelsdk::with_otel_record({
+    otel_cache_tracer()
+    expr
+  })
+}

R/test-that.R

@@ -49,10 +49,27 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) {
 
   frame <- caller_env()
 
+  otel_n_success <- 0L
+  otel_n_failure <- 0L
+  otel_n_error <- 0L
+  otel_n_skip <- 0L
+  otel_n_warning <- 0L
+
   test <- test_description()
   if (!is.null(test)) {
+    span <- otel_local_test_span(test, scope = frame)
     reporter$start_test(context = reporter$.context, test = test)
-    withr::defer(reporter$end_test(context = reporter$.context, test = test))
+    withr::defer({
+      otel_update_span(
+        span,
+        otel_n_success,
+        otel_n_failure,
+        otel_n_error,
+        otel_n_skip,
+        otel_n_warning
+      )
+      reporter$end_test(context = reporter$.context, test = test)
+    })
   }
 
   if (the$top_level_test) {
@@ -82,6 +99,17 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) {
 
     e$test <- test %||% "(code run outside of `test_that()`)"
 
+    # record keeping for otel
+    switch(
+      expectation_type(e),
+      success = otel_n_success <<- otel_n_success + 1L,
+      failure = otel_n_failure <<- otel_n_failure + 1L,
+      error = otel_n_error <<- otel_n_error + 1L,
+      skip = otel_n_skip <<- otel_n_skip + 1L,
+      warning = otel_n_warning <<- otel_n_warning + 1L,
+      NULL
+    )
+
     ok <<- ok && expectation_ok(e)
     reporter$add_result(context = reporter$.context, test = test, result = e)
   }

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

tests/testthat/test-otel.R

@@ -0,0 +1,35 @@
+test_that("otel instrumentation works", {
+  skip_if_not_installed("otelsdk")
+
+  record <- with_otel_record({
+    test_that("testing is traced", {
+      expect_equal(1, 1)
+      expect_error(stop("expected error"))
+    })
+    test_that("all expectations are recorded", {
+      expect_equal(1, 1)
+      expect_true(TRUE)
+      expect_length(1:3, 3)
+      expect_warning(warning("expected warning"))
+      expect_error(stop("expected error"))
+    })
+  })
+
+  traces <- record$traces
+  expect_length(traces, 2L)
+  span <- traces[[1L]]
+  expect_equal(
+    span$name,
+    "test that otel instrumentation works / testing is traced"
+  )
+  expect_equal(span$instrumentation_scope$name, "org.r-lib.testthat")
+  span <- traces[[2L]]
+  expect_equal(span$attributes[["test.status"]], "pass")
+  expect_equal(span$attributes[["test.expectations.total"]], 5)
+  expect_equal(span$attributes[["test.expectations.passed"]], 5)
+  expect_equal(span$attributes[["test.expectations.failed"]], 0)
+  expect_equal(span$attributes[["test.expectations.error"]], 0)
+  expect_equal(span$attributes[["test.expectations.skipped"]], 0)
+  expect_equal(span$attributes[["test.expectations.warning"]], 0)
+  expect_equal(span$status, "ok")
+})