diff --git a/DESCRIPTION b/DESCRIPTION index ff7e69e..6ae55c6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: typetracer Title: Trace Function Parameter Types -Version: 0.2.1.004 +Version: 0.2.1.009 Authors@R: c( person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-2172-5265")), diff --git a/R/directory-fns.R b/R/directory-fns.R index 4fd658b..fa2dbcc 100644 --- a/R/directory-fns.R +++ b/R/directory-fns.R @@ -12,6 +12,19 @@ clear_fn_bodies_dir <- function () { fn_bodies_dir <- file.path (get_typetrace_dir (), "fn_bodies") if (dir.exists (fn_bodies_dir)) { + has_files <- length (list.files (fn_bodies_dir)) > 0L + if (has_files && interactive ()) { + chk <- readline (paste0 ( + "All functions should first be uninjected before calling ", + "this function. Do you wish to continue (y/n)? " + )) + if (tolower (substring (chk, 1, 1)) != "y") { + stop ( + "Please call 'uninject_tracer() first", + call. = FALSE + ) + } + } unlink (fn_bodies_dir, recursive = TRUE) } } diff --git a/R/load-and-clear-traces.R b/R/load-and-clear-traces.R index 97f56d8..20c5294 100644 --- a/R/load-and-clear-traces.R +++ b/R/load-and-clear-traces.R @@ -75,7 +75,7 @@ load_traces <- function (files = FALSE, quiet = FALSE) { call_envs$call_env <- paste0 (call_envs$namespace, "::", call_envs$name) call_envs$call_env [which (is.na (call_envs$name))] <- NA_character_ - tibble::tibble ( + out_i <- tibble::tibble ( trace_name = i, trace_number = num_traces, trace_source = trace_source, @@ -92,6 +92,40 @@ load_traces <- function (files = FALSE, quiet = FALSE) { uneval = par_uneval, eval = par_eval ) + + has_list <- integer (0L) + if (get_trace_lists_param ()) { + has_list <- which (vapply ( + tr_i, + function (i) "list_data" %in% names (i), + logical (1L) + )) + } + + if (length (has_list) > 0L) { + + out_list_i <- lapply (tr_i [has_list], function (j) { + j_out <- do.call (rbind, lapply (j$list_data, as.data.frame)) + j_out$par <- paste0 (j$par, "$", j_out$par) + return (j_out) + }) + out_list_i <- do.call (rbind, out_list_i) + names (out_list_i) [names (out_list_i) == "par"] <- "par_name" + names (out_list_i) [names (out_list_i) == "par_uneval"] <- "uneval" + names (out_list_i) [names (out_list_i) == "par_eval"] <- "eval" + + out_list <- out_i [integer (0L), ] + out_list <- out_list [seq_len (nrow (out_list_i)), ] + index <- match (names (out_list_i), names (out_list)) + out_list [, index] <- out_list_i + index1 <- which (!names (out_list) %in% names (out_list_i)) + index2 <- match (names (out_list) [index1], names (out_i)) + out_list [, index1] <- out_i [seq_len (nrow (out_list_i)), index2] + + out_i <- rbind (out_i, out_list) + } + + return (out_i) }) out <- do.call (rbind, out) diff --git a/R/trace-package.R b/R/trace-package.R index 0b996c2..2eb19b8 100644 --- a/R/trace-package.R +++ b/R/trace-package.R @@ -2,14 +2,18 @@ #' Trace all parameters for all functions in a specified package #' #' @param package Name of package to be traced (as character value). +#' @param pkg_dir For "types" including "tests", a local directory to the source +#' code of the package. (This is needed because installed versions do not +#' generally include tests.) #' @param functions Optional character vector of names of functions to trace. #' Defaults to tracing all functions. #' @param types The types of code to be run to generate traces: one or both #' values of "examples" or "tests" (as for `tools::testInstalledPackage`). Note #' that only tests run via the \pkg{testthat} package can be traced. -#' @param pkg_dir For "types" including "tests", a local directory to the source -#' code of the package. (This is needed because installed versions do not -#' generally include tests.) +#' @param trace_lists If `TRUE`, trace into any nested list parameters +#' (including `data.frame`-type objects), and return type information on each +#' list component. The parameter names for these list-components are then +#' specified in "dollar-notation", as '$', for example 'Orange$age'. #' @return A `data.frame` of data on every parameter of every function as #' specified in code provided in package examples. #' @export @@ -19,13 +23,15 @@ #' res <- trace_package (pkg_dir = "////") #' } trace_package <- function (package = NULL, + pkg_dir = NULL, functions = NULL, types = c ("examples", "tests"), - pkg_dir = NULL) { + trace_lists = FALSE) { types <- match.arg (types, c ("examples", "tests"), several.ok = TRUE ) + set_trace_list_option (trace_lists) package <- assert_trace_package_inputs (package, types, pkg_dir) pkg_was_attached <- any (grepl (paste0 ("package:", package), search ())) @@ -53,6 +59,9 @@ trace_package <- function (package = NULL, if (is.null (trace_fns)) { trace_fns <- ls (p, all.names = TRUE) } + + clear_traces () + pkg_env <- as.environment (p) for (fnm in trace_fns) { f <- get (fnm, envir = pkg_env) @@ -61,8 +70,6 @@ trace_package <- function (package = NULL, } } - clear_traces () - traces_ex <- NULL if ("examples" %in% types) { @@ -109,19 +116,18 @@ trace_package <- function (package = NULL, traces$trace_name <- traces$trace_source <- NULL } - # Envvar to enable traces to remain so that package can be used by - # 'autotest', through loading traces after calling 'trace_package()' - if (!Sys.getenv ("TYPETRACER_LEAVE_TRACES") == "true") { - clear_traces () - } - for (f in trace_fns) { f <- get (f, envir = pkg_env) if (is.function (f)) { uninject_tracer (f) } } - clear_fn_bodies_dir () + + # Envvar to enable traces to remain so that package can be used by + # 'autotest', through loading traces after calling 'trace_package()' + if (!Sys.getenv ("TYPETRACER_LEAVE_TRACES") == "true") { + clear_traces () + } tryCatch ( unloadNamespace (package), diff --git a/R/tracer-define.R b/R/tracer-define.R index d776593..a5d5102 100644 --- a/R/tracer-define.R +++ b/R/tracer-define.R @@ -53,9 +53,13 @@ typetracer_header <- function () { utils::getFromNamespace ("trace_one_param", "typetracer") typetracer_env$trace_one_list <- utils::getFromNamespace ("trace_one_list", "typetracer") + typetracer_env$get_trace_lists_param <- + utils::getFromNamespace ("get_trace_lists_param", "typetracer") + typetracer_env$data <- lapply (typetracer_env$par_names, function (p) { dat_i <- typetracer_env$trace_one_param (typetracer_env, p, fn_env) - if (dat_i$typeof == "list") { + trace_lists <- typetracer_env$get_trace_lists_param () + if (dat_i$typeof == "list" && trace_lists) { dat_i$list_data <- typetracer_env$trace_one_list (typetracer_env, p, fn_env) } @@ -179,6 +183,15 @@ trace_one_list <- function (typetracer_env, p, fn_env) { get (p, envir = fn_env, inherits = FALSE), error = function (e) NULL ) + + # non-standard evaluation, which is also necessary for lists passed as + # `...`: + if (is.null (res)) { + res <- tryCatch ( + eval (typetracer_env$pars [[p]], envir = fn_env), + error = function (e) NULL + ) + } if (is.null (res)) { return (res) } diff --git a/R/tracer-inject.R b/R/tracer-inject.R index 36c5f8d..e78ef0f 100644 --- a/R/tracer-inject.R +++ b/R/tracer-inject.R @@ -3,6 +3,7 @@ #' #' @param f A function (that is, an object of class "function", and not a #' character string). +#' @inheritParams trace_package #' @return Nothing (will error on fail). #' #' @note The tracer is defined in the internal `typetracer_header()` function. @@ -23,9 +24,10 @@ #' uninject_tracer (f) #' # Traces may also be removed: #' clear_traces () -inject_tracer <- function (f) { +inject_tracer <- function (f, trace_lists = FALSE) { checkmate::assert_function (f) + set_trace_list_option (trace_lists) # save body for re-injection: f_name <- deparse (substitute (f)) diff --git a/R/utils.R b/R/utils.R index 76884af..1e9e199 100644 --- a/R/utils.R +++ b/R/utils.R @@ -36,3 +36,17 @@ get_pkg_lib_path <- function (package, lib_paths) { return (lib_path) } + +set_trace_list_option <- function (trace_lists) { + + options (typetracer_trace_lists = trace_lists) +} + +get_trace_lists_param <- function () { + + op <- options ("typetracer_trace_lists") [[1]] + if (length (op) == 0L) { + op <- FALSE + } + return (op) +} diff --git a/R/zzz.R b/R/zzz.R index 8b43bad..7865768 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -9,6 +9,7 @@ .onUnload <- function (libname, pkgname) { # nolint options ("typetracedir" = NULL) + options ("typetrace_trace_lists" = NULL) f <- file.path (tempdir (), "fn_bodies") if (dir.exists (f)) { unlink (f, recursive = TRUE) diff --git a/README.Rmd b/README.Rmd index 9a1fa1c..c72f42d 100644 --- a/README.Rmd +++ b/README.Rmd @@ -165,12 +165,54 @@ For the function, `r`, above, this simply requires, uninject_tracer (f) ``` +All traces can also be removed with this functions: + +```{r} +clear_traces () +``` + + Because `typetracer` modifies the internal code of functions as defined within a current R session, we strongly recommend restarting your R session after using `typetracer`, to ensure expected function behaviour is restored. -## Example #2 - Tracing a Package +## Example #2 - Recursion into lists + +R has extensive support for list structures, notably including all +`data.frame`-like objects in which each column is actually a list item. +`typetracer` also offers the ability to recurse into the list structures of +individual parameters, to recursively trace the properties of each list item. +To do this, the traces themselves have to be injected with the additional +parameter, `trace_lists = TRUE`. + + +The final call above included an additional parameter passed as a list. The +following code re-injects a tracer with the ability to traverse into list +structures: + +```{r} +inject_tracer (f, trace_lists = TRUE) +val <- f ( + x = 1:2, + y = 3:4 + 0., + a = "blah", + b = list (a = 1, b = "b"), + f = a ~ b +) +x_lists <- load_traces () +print (x_lists) +``` + +And that result now has `r nrow(x_lists)` rows, or +`r nrow(x_lists) - nrow(x)` more than the previous example, reflecting the two +items passed as a `list` to the parameter, `b`. List-parameter items are +identifiable in typetracer output through the "dollar-notation" in the +`par_name` field. The final two values in the above table are `b$a` and `b$b`, +representing the two elements of the list passed as the parameter, `b`. + + +## Example #3 - Tracing a Package This section presents a more complex example tracing all function calls from [the `rematch` package](https://github.com/MangoTheCat/rematch), chosen because @@ -183,6 +225,9 @@ function within the package, so there is no need to explicitly call [the `inject_tracer()` function](https://mpadge.github.io/typetracer/reference/inject_tracer). +(This function also includes a `trace_lists` parameter, as demonstrated above, +with a default of `FALSE` to not recurse into tracing list structures.) + ```{r trace-rematch, message = FALSE} res <- trace_package ("rematch") res @@ -227,7 +272,7 @@ from the ["testthat" package](https://testthat.r-lib.org). These calling environments are useful to discern whether, for example, a call was made with an expectation that it should error. -### Example #2(a) - Specifying Functions to Trace +### Example #3(a) - Specifying Functions to Trace [The `trace_package()` function](https://mpadge.github.io/typetracer/reference/trace_package.html) diff --git a/README.md b/README.md index 3ede62a..ee7050b 100644 --- a/README.md +++ b/README.md @@ -83,13 +83,13 @@ from each function call. ## # A tibble: 7 × 12 ## trace_number fn_name fn_call_hash par_name class typeof mode storage_mode ## > - ## 1 0 f EMWxFUiu x integ… nume… integer - ## 2 0 f EMWxFUiu y double nume… double - ## 3 0 f EMWxFUiu z NULL NULL NULL - ## 4 0 f EMWxFUiu ... NULL NULL NULL - ## 5 0 f EMWxFUiu a chara… char… character - ## 6 0 f EMWxFUiu b list list list - ## 7 0 f EMWxFUiu f langu… call language + ## 1 0 f uDgEbied x integ… nume… integer + ## 2 0 f uDgEbied y double nume… double + ## 3 0 f uDgEbied z NULL NULL NULL + ## 4 0 f uDgEbied ... NULL NULL NULL + ## 5 0 f uDgEbied a chara… char… character + ## 6 0 f uDgEbied b list list list + ## 7 0 f uDgEbied f langu… call language ## # ℹ 4 more variables: length , formal , uneval >, ## # eval > @@ -142,7 +142,7 @@ unevaluated and evaluated forms of parameters: ## ## $f ## a ~ b - ## + ## Unevaluated parameters are generally converted to equivalent character expressions. @@ -178,12 +178,62 @@ For the function, `r`, above, this simply requires, ## [1] TRUE +All traces can also be removed with this functions: + + clear_traces () + Because `typetracer` modifies the internal code of functions as defined within a current R session, we strongly recommend restarting your R session after using `typetracer`, to ensure expected function behaviour is restored. -## Example \#2 - Tracing a Package +## Example \#2 - Recursion into lists + +R has extensive support for list structures, notably including all +`data.frame`-like objects in which each column is actually a list item. +`typetracer` also offers the ability to recurse into the list structures +of individual parameters, to recursively trace the properties of each +list item. To do this, the traces themselves have to be injected with +the additional parameter, `trace_lists = TRUE`. + +The final call above included an additional parameter passed as a list. +The following code re-injects a tracer with the ability to traverse into +list structures: + + inject_tracer (f, trace_lists = TRUE) + val <- f ( + x = 1:2, + y = 3:4 + 0., + a = "blah", + b = list (a = 1, b = "b"), + f = a ~ b + ) + x_lists <- load_traces () + print (x_lists) + + ## # A tibble: 9 × 12 + ## trace_number fn_name fn_call_hash par_name class typeof mode storage_mode + ## > + ## 1 0 f LzZIbYvx x integ… nume… integer + ## 2 0 f LzZIbYvx y double nume… double + ## 3 0 f LzZIbYvx z NULL NULL NULL + ## 4 0 f LzZIbYvx ... NULL NULL NULL + ## 5 0 f LzZIbYvx a chara… char… character + ## 6 0 f LzZIbYvx b list list list + ## 7 0 f LzZIbYvx f langu… call language + ## 8 0 f LzZIbYvx b$a double nume… double + ## 9 0 f LzZIbYvx b$b chara… char… character + ## # ℹ 4 more variables: length , formal , uneval >, + ## # eval > + +And that result now has 9 rows, or 2 more than the previous example, +reflecting the two items passed as a `list` to the parameter, `b`. +List-parameter items are identifiable in typetracer output through the +“dollar-notation” in the `par_name` field. The final two values in the +above table are `b$a` and `b$b`, representing the two elements of the +list passed as the parameter, `b`. + +## Example \#3 - Tracing a Package This section presents a more complex example tracing all function calls from [the `rematch` package](https://github.com/MangoTheCat/rematch), @@ -195,23 +245,26 @@ automatically injects tracing code into every function within the package, so there is no need to explicitly call [the `inject_tracer()` function](https://mpadge.github.io/typetracer/reference/inject_tracer). +(This function also includes a `trace_lists` parameter, as demonstrated +above, with a default of `FALSE` to not recurse into tracing list +structures.) + res <- trace_package ("rematch") res - ## # A tibble: 8 × 16 - ## trace_number trace_source fn_name fn_call_hash trace_file call_env par_name - ## - ## 1 0 examples re_match ULkYuvZJ pattern - ## 2 0 examples re_match ULkYuvZJ text - ## 3 0 examples re_match ULkYuvZJ perl - ## 4 0 examples re_match ULkYuvZJ ... - ## 5 1 examples re_match oyqnuZhG pattern - ## 6 1 examples re_match oyqnuZhG text - ## 7 1 examples re_match oyqnuZhG perl - ## 8 1 examples re_match oyqnuZhG ... - ## # ℹ 9 more variables: class >, typeof , mode , - ## # storage_mode , length , formal , uneval >, - ## # eval >, source_file_name + ## # A tibble: 8 × 14 + ## trace_number source_file_name fn_name fn_call_hash call_env par_name class + ## + ## 1 0 man/re_match.Rd re_match UJfHAIRp pattern + ## 2 0 man/re_match.Rd re_match UJfHAIRp text + ## 3 0 man/re_match.Rd re_match UJfHAIRp perl + ## 4 0 man/re_match.Rd re_match UJfHAIRp ... + ## 5 1 man/re_match.Rd re_match Anyflkea pattern + ## 6 1 man/re_match.Rd re_match Anyflkea text + ## 7 1 man/re_match.Rd re_match Anyflkea perl + ## 8 1 man/re_match.Rd re_match Anyflkea ... + ## # ℹ 7 more variables: typeof , mode , storage_mode , + ## # length , formal , uneval >, eval > The `data.frame` returned by the `trace_package()` function includes three more columns than the result directly returned by `load_traces()`. @@ -226,7 +279,7 @@ calling environment which generated each trace, while unique (res$source_file_name) - ## [1] "rd_re_match" + ## [1] "man/re_match.Rd" Although the “call\_env” columns contains no useful information for that package, it includes information on the full environment in which each @@ -257,7 +310,7 @@ package](https://testthat.r-lib.org). These calling environments are useful to discern whether, for example, a call was made with an expectation that it should error. -### Example \#2(a) - Specifying Functions to Trace +### Example \#3(a) - Specifying Functions to Trace [The `trace_package()` function](https://mpadge.github.io/typetracer/reference/trace_package.html) diff --git a/codemeta.json b/codemeta.json index 294522f..8207161 100644 --- a/codemeta.json +++ b/codemeta.json @@ -11,7 +11,7 @@ "codeRepository": "https://github.com/mpadge/typetracer", "issueTracker": "https://github.com/mpadge/typetracer/issues", "license": "https://spdx.org/licenses/MIT", - "version": "0.2.1.004", + "version": "0.2.1.009", "programmingLanguage": { "@type": "ComputerLanguage", "name": "R", diff --git a/man/inject_tracer.Rd b/man/inject_tracer.Rd index 9bc4a9e..ac2b332 100644 --- a/man/inject_tracer.Rd +++ b/man/inject_tracer.Rd @@ -4,11 +4,16 @@ \alias{inject_tracer} \title{Inject parameter tracer into one function} \usage{ -inject_tracer(f) +inject_tracer(f, trace_lists = FALSE) } \arguments{ \item{f}{A function (that is, an object of class "function", and not a character string).} + +\item{trace_lists}{If \code{TRUE}, trace into any nested list parameters +(including \code{data.frame}-type objects), and return type information on each +list component. The parameter names for these list-components are then +specified in "dollar-notation", as '\if{html}{\out{}}$\if{html}{\out{}}', for example 'Orange$age'.} } \value{ Nothing (will error on fail). diff --git a/man/trace_package.Rd b/man/trace_package.Rd index 9235c9c..ef2ed8e 100644 --- a/man/trace_package.Rd +++ b/man/trace_package.Rd @@ -6,14 +6,19 @@ \usage{ trace_package( package = NULL, + pkg_dir = NULL, functions = NULL, types = c("examples", "tests"), - pkg_dir = NULL + trace_lists = FALSE ) } \arguments{ \item{package}{Name of package to be traced (as character value).} +\item{pkg_dir}{For "types" including "tests", a local directory to the source +code of the package. (This is needed because installed versions do not +generally include tests.)} + \item{functions}{Optional character vector of names of functions to trace. Defaults to tracing all functions.} @@ -21,9 +26,10 @@ Defaults to tracing all functions.} values of "examples" or "tests" (as for \code{tools::testInstalledPackage}). Note that only tests run via the \pkg{testthat} package can be traced.} -\item{pkg_dir}{For "types" including "tests", a local directory to the source -code of the package. (This is needed because installed versions do not -generally include tests.)} +\item{trace_lists}{If \code{TRUE}, trace into any nested list parameters +(including \code{data.frame}-type objects), and return type information on each +list component. The parameter names for these list-components are then +specified in "dollar-notation", as '\if{html}{\out{}}$\if{html}{\out{}}', for example 'Orange$age'.} } \value{ A \code{data.frame} of data on every parameter of every function as diff --git a/tests/testthat/_snaps/trace-fns.md b/tests/testthat/_snaps/trace-fns.md index 6ed7755..d841e46 100644 --- a/tests/testthat/_snaps/trace-fns.md +++ b/tests/testthat/_snaps/trace-fns.md @@ -29,10 +29,13 @@ "typetracer") typetracer_env$trace_one_list <- utils::getFromNamespace("trace_one_list", "typetracer") + typetracer_env$get_trace_lists_param <- utils::getFromNamespace("get_trace_lists_param", + "typetracer") typetracer_env$data <- lapply(typetracer_env$par_names, function(p) { dat_i <- typetracer_env$trace_one_param(typetracer_env, p, fn_env) - if (dat_i$typeof == "list") { + trace_lists <- typetracer_env$get_trace_lists_param() + if (dat_i$typeof == "list" && trace_lists) { dat_i$list_data <- typetracer_env$trace_one_list(typetracer_env, p, fn_env) } diff --git a/tests/testthat/test-trace-fns.R b/tests/testthat/test-trace-fns.R index 95413dc..cfeed39 100644 --- a/tests/testthat/test-trace-fns.R +++ b/tests/testthat/test-trace-fns.R @@ -25,6 +25,7 @@ test_that ("injected tracer body", { expect_true (length (body1) > length (body0)) expect_equal (body1 [[2]], body (typetracer_header)) + expect_true (uninject_tracer (f)) }) test_that ("No traces", { @@ -43,9 +44,9 @@ test_that ("trace call", { x * x + y * y } + clear_traces () inject_tracer (f) - clear_traces () val <- f (x = 1:2, y = 3:4 + 0.) flist <- list.files (tempdir (), pattern = "^typetrace\\_", @@ -54,6 +55,7 @@ test_that ("trace call", { expect_true (length (flist) > 0L) x <- load_traces (files = TRUE) + expect_true (uninject_tracer (f)) expect_s3_class (x, "tbl_df") expect_equal (nrow (x), 2L) # x and y @@ -89,4 +91,30 @@ test_that ("untrace call", { expect_false (identical (e0, e1)) expect_identical (e0, e2) + expect_false (uninject_tracer (f)) +}) + +test_that ("trace lists", { + + f <- function (x, y, a) { + stopifnot (is.list (a)) + stopifnot ("x" %in% names (a)) + x * x + y * y + a$x + } + + clear_traces () + inject_tracer (f, trace_lists = FALSE) + val <- f (x = 1:2, y = 3:4 + 0., a = list (x = 4)) + x0 <- load_traces () + expect_true (uninject_tracer (f)) + + clear_traces () + inject_tracer (f, trace_lists = TRUE) + val <- f (x = 1:2, y = 3:4 + 0., a = list (x = 4)) + x1 <- load_traces () + expect_true (uninject_tracer (f)) + + expect_true (nrow (x1) > nrow (x0)) + expect_false (any (grepl ("\\$", x0$par_name))) + expect_true (any (grepl ("\\$", x1$par_name))) })