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 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..d66a3b1ff --- /dev/null +++ b/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 + }) +} diff --git a/R/test-that.R b/R/test-that.R index 4e7fbae92..8bb17cf35 100644 --- a/R/test-that.R +++ b/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) } 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..4faf89d4c --- /dev/null +++ b/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") +})