├── .github ├── .gitignore └── workflows │ ├── pkgdown.yaml │ ├── R-CMD-check.yaml │ └── test-coverage.yaml ├── src ├── .gitignore └── utils.c ├── LICENSE ├── R ├── typetracer-package.R ├── zzz.R ├── prepend-code.R ├── directory-fns.R ├── testthat-fns.R ├── utils.R ├── tracer-inject.R ├── install.R ├── load-and-clear-traces.R ├── tracer-define.R └── trace-package.R ├── _pkgdown.yml ├── tests ├── testthat.R ├── rematch_1.0.1.tar.gz └── testthat │ ├── test-utils.R │ ├── _snaps │ └── trace-fns.md │ ├── test-trace-fns.R │ └── test-trace-package.R ├── .dir-locals.el ├── NAMESPACE ├── .gitignore ├── .Rbuildignore ├── vignettes ├── makefile └── nse.Rmd ├── NEWS.md ├── .hooks └── description ├── cran-comments.md ├── man ├── uninject_tracer.Rd ├── clear_traces.Rd ├── load_traces.Rd ├── inject_tracer.Rd └── trace_package.Rd ├── CONTRIBUTING.md ├── Makefile ├── DESCRIPTION ├── .pre-commit-config.yaml ├── codemeta.json ├── README.Rmd └── README.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /src/.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.so 3 | *.dll 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2022 2 | COPYRIGHT HOLDER: 'typetracer' authors 3 | -------------------------------------------------------------------------------- /R/typetracer-package.R: -------------------------------------------------------------------------------- 1 | #' @useDynLib typetracer, .registration = TRUE 2 | NULL 3 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://mpadge.github.io/typetracer/ 2 | template: 3 | bootstrap: 5 4 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library (testthat) 2 | library (typetracer) 3 | 4 | test_check ("typetracer") 5 | -------------------------------------------------------------------------------- /tests/rematch_1.0.1.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mpadge/typetracer/HEAD/tests/rematch_1.0.1.tar.gz -------------------------------------------------------------------------------- /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ((nil . ((projectile-project-compile-cmd . "make compile") 2 | (projectile-project-test-cmd . "make test")))) 3 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(clear_traces) 4 | export(inject_tracer) 5 | export(load_traces) 6 | export(trace_package) 7 | export(uninject_tracer) 8 | useDynLib(typetracer, .registration = TRUE) 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | inst/doc 5 | inst/WORDLIST 6 | data-raw/ 7 | literature/ 8 | aaa\.Rmd* 9 | # History files 10 | .Rhistory 11 | .Rapp.history 12 | # Session Data files 13 | .RData 14 | # Output files from R CMD build 15 | /*.tar.gz 16 | # vim files 17 | .*.un~ 18 | .*.swp 19 | # compiled object files 20 | *.o 21 | *.so 22 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^aaa* 2 | ^README\.Rmd$ 3 | ^README\.html$ 4 | ^\.ccls.*$ 5 | ^\.gitignore$ 6 | ^\.git$ 7 | ^cran-comments.md$ 8 | ^CONTRIBUTING.md$ 9 | ^inst/WORDLIST$ 10 | ^typetracer.Rcheck$ 11 | ^Makefile$ 12 | ^typetracer_.*\.tar\.gz$ 13 | ^.dir-locals\.el$ 14 | ^\.pre-commit-config\.yaml$ 15 | ^vignettes/makefile$ 16 | ^\.hooks$ 17 | ^codemeta\.json$ 18 | ^\.github$ 19 | ^_pkgdown\.yml$ 20 | ^docs$ 21 | ^pkgdown$ 22 | -------------------------------------------------------------------------------- /vignettes/makefile: -------------------------------------------------------------------------------- 1 | LFILE = nse 2 | 3 | all: knith 4 | #all: knith open 5 | 6 | knith: $(LFILE).Rmd 7 | echo "rmarkdown::render('$(LFILE).Rmd',output_file='$(LFILE).html')" | R --no-save -q 8 | 9 | knitr: $(LFILE).Rmd 10 | echo "rmarkdown::render('$(LFILE).Rmd',rmarkdown::md_document(variant='gfm'))" | R --no-save -q 11 | 12 | open: $(LFILE).html 13 | xdg-open $(LFILE).html & 14 | 15 | clean: 16 | rm -rf *.html *.png 17 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | # nocov start 2 | .onLoad <- function (libname, pkgname) { # nolint 3 | 4 | options ("typetracedir" = tempdir ()) 5 | 6 | } 7 | 8 | .onUnload <- function (libname, pkgname) { # nolint 9 | 10 | options ("typetracedir" = NULL) 11 | options ("typetrace_trace_lists" = NULL) 12 | f <- file.path (tempdir (), "fn_bodies") 13 | if (dir.exists (f)) { 14 | unlink (f, recursive = TRUE) 15 | } 16 | } 17 | # nocov end 18 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | 0.2.3.00x (dev) 2 | =================== 3 | 4 | 5 | 6 | 0.2.3 7 | =================== 8 | 9 | ## Major changes 10 | 11 | - Code for injecting tracers into function bodies entire updated as described in https://github.com/r-lib/covr/pull/587 12 | 13 | 0.2.2 14 | =================== 15 | 16 | ## Major changes 17 | 18 | - `trace_package()` now reports environment from which traces were called (issue #14) 19 | - Additional parameter added to `trace_package()` and `tracer_inject()` to allow recursive tracing into list structures (#19). 20 | 21 | 0.1.2 22 | =================== 23 | 24 | ## Initial CRAN Release 25 | -------------------------------------------------------------------------------- /R/prepend-code.R: -------------------------------------------------------------------------------- 1 | # Modified from original 'injectr' code by Filip Krikava 2 | # https://github.com/PRL-PRG/injectr 3 | 4 | prepend_code <- function (orig_code, code) { 5 | # is.language will not work since SYMSXP and EXPRSXP are also of language 6 | # type 7 | # if (typeof (orig_code) == "language" && 8 | # identical (orig_code [[1]], as.name ("{"))) { 9 | # as.call (append (as.list (orig_code), code, 1)) 10 | # } 11 | 12 | # fns do not need curly braces to be defined: 13 | if (typeof (orig_code) == "language") { 14 | as.call (append (as.list (orig_code), code, 1)) 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /.hooks/description: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env Rscript 2 | 3 | # only stop on main branch 4 | on_main <- identical (gert::git_branch (), "main") 5 | 6 | s <- gert::git_status() 7 | chk <- ("DESCRIPTION" %in% s$file && 8 | (s$status [s$file == "DESCRIPTION"] == "modified" | 9 | s$status [s$file == "DESCRIPTION"] == "new")) 10 | if (!chk & on_main) 11 | stop ("DESCRIPTION has not been updated") 12 | 13 | f <- file.path (rprojroot::find_root("DESCRIPTION"), "DESCRIPTION") 14 | x <- system2 ("git", args = c ("diff", "--cached", "-U0", f), stdout = TRUE) 15 | if (!any (grepl ("^\\+Version", x)) & on_main) 16 | stop ("Version number in DESCRIPTION has not been incremented") 17 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | # CRAN notes for typetracer_0.2.3 submission 2 | 3 | This submission rectifies previous warning about non-API call to the C function 'SET_BODY'. The call to that entry point has been removed, and replaced with equivalent calls to official R API entry points. 4 | 5 | The package has been checked on all environments listed below, and generates no notes 6 | 7 | GitHub actions: 8 | * Linux: R-release, R-devel, R-oldrelease 9 | * OSX: R-release 10 | * Windows: R-release 11 | 12 | CRAN win-builder: 13 | * R-oldrelease, R-release, R-devel 14 | 15 | Package also checked using `Clang++ -Weverything`, and both local memory sanitzer and `rocker/r-devel-san` with clean results. 16 | -------------------------------------------------------------------------------- /man/uninject_tracer.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tracer-inject.R 3 | \name{uninject_tracer} 4 | \alias{uninject_tracer} 5 | \title{Remove parameter tracer from one function} 6 | \usage{ 7 | uninject_tracer(f) 8 | } 9 | \arguments{ 10 | \item{f}{A function (that is, an object of class "function", and not a 11 | character string).} 12 | } 13 | \value{ 14 | Logical value indicating whether or not tracer was able to be removed 15 | ("uninjected"). 16 | } 17 | \description{ 18 | This function removes traces previous injected into functions with the 19 | \link{inject_tracer} function. 20 | } 21 | \examples{ 22 | f <- function (x, y, z, ...) { 23 | x * x + y * y 24 | } 25 | inject_tracer (f) 26 | val <- f (1:2, 3:4 + 0., a = "blah") 27 | x <- load_traces () 28 | 29 | # Traces should always be "uninjected": 30 | uninject_tracer (f) 31 | # Traces may also be removed: 32 | clear_traces () 33 | } 34 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing to typetracer 2 | 3 | ## Opening issues 4 | 5 | The easiest way to note any behavioural curiosities or to request any new 6 | features is by opening a [github issue](https://github.com/mpadge/typetracer/issues). 7 | 8 | 9 | ## Development guidelines 10 | 11 | If you'd like to contribute changes to `typetracer`, we use [the GitHub 12 | flow](https://guides.github.com/introduction/flow/index.html) for proposing, 13 | submitting, reviewing, and accepting changes. If you haven't done this before, 14 | there's a nice overview of git [here](http://r-pkgs.had.co.nz/git.html), as well 15 | as best practices for submitting pull requests 16 | [here](http://r-pkgs.had.co.nz/git.html#pr-make). 17 | 18 | 19 | ## Code of conduct 20 | 21 | Please note that contributions to this package are expected to comply with 22 | rOpenSci's [Contributor Code of 23 | Conduct](https://ropensci.org/code-of-conduct/). By contributing to this 24 | project, you agree to abide by its terms. 25 | -------------------------------------------------------------------------------- /man/clear_traces.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/load-and-clear-traces.R 3 | \name{clear_traces} 4 | \alias{clear_traces} 5 | \title{Clear previous traces} 6 | \usage{ 7 | clear_traces() 8 | } 9 | \value{ 10 | (Invisibly) A single logical value indicating whether or not traces 11 | were successfully cleared. 12 | } 13 | \description{ 14 | Traces are by default appended to previous traces. This function can be used 15 | to clean those previous ones, to enable subsequent calls to generate new 16 | traces that are not appended to previous ones. 17 | } 18 | \examples{ 19 | f <- function (x, y, z, ...) { 20 | x * x + y * y 21 | } 22 | inject_tracer (f) 23 | val <- f (1:2, 3:4 + 0., a = "blah") 24 | x <- load_traces () 25 | print (x) 26 | 27 | # Then call 'clear_traces' to remove them: 28 | clear_traces () 29 | # Trying to load again wil then indicate 'No traces found': 30 | x <- load_traces () 31 | # Traces should also always be "uninjected": 32 | uninject_tracer (f) 33 | } 34 | -------------------------------------------------------------------------------- /man/load_traces.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/load-and-clear-traces.R 3 | \name{load_traces} 4 | \alias{load_traces} 5 | \title{Load traces of parameter types} 6 | \usage{ 7 | load_traces(files = FALSE, quiet = FALSE) 8 | } 9 | \arguments{ 10 | \item{files}{If \code{TRUE}, return paths to all temporary files holding trace 11 | data.} 12 | 13 | \item{quiet}{If \code{FALSE}, issue message when no traces found.} 14 | } 15 | \value{ 16 | A 'data.frame' of traces, including names of functions and 17 | parameters, and values of each parameter traced in both unevaluated and 18 | evaluated forms. 19 | } 20 | \description{ 21 | Load traces of parameter types 22 | } 23 | \examples{ 24 | f <- function (x, y, z, ...) { 25 | x * x + y * y 26 | } 27 | inject_tracer (f) 28 | val <- f (1:2, 3:4 + 0., a = "blah") 29 | x <- load_traces () 30 | print (x) 31 | 32 | # Traces should always be "uninjected": 33 | uninject_tracer (f) 34 | # Traces may also be removed: 35 | clear_traces () 36 | } 37 | -------------------------------------------------------------------------------- /R/directory-fns.R: -------------------------------------------------------------------------------- 1 | get_typetrace_dir <- function () { 2 | 3 | td <- getOption ("typetracedir") 4 | if (is.null (td)) { 5 | td <- tempdir () 6 | } 7 | return (td) 8 | } 9 | 10 | clear_fn_bodies_dir <- function () { 11 | 12 | fn_bodies_dir <- file.path (get_typetrace_dir (), "fn_bodies") 13 | if (dir.exists (fn_bodies_dir)) { 14 | has_files <- length (list.files (fn_bodies_dir)) > 0L 15 | if (has_files && interactive ()) { 16 | chk <- readline (paste0 ( 17 | "All functions should first be uninjected before calling ", 18 | "this function. Do you wish to continue (y/n)? " 19 | )) 20 | if (tolower (substring (chk, 1, 1)) != "y") { 21 | stop ( 22 | "Please call 'uninject_tracer() first", 23 | call. = FALSE 24 | ) 25 | } 26 | } 27 | unlink (fn_bodies_dir, recursive = TRUE) 28 | } 29 | } 30 | 31 | list_traces <- function () { 32 | 33 | td <- get_typetrace_dir () 34 | list.files ( 35 | td, 36 | full.names = TRUE, 37 | pattern = "^typetrace\\_.*\\.Rds$" 38 | ) 39 | } 40 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | LFILE = README 2 | VIGNETTE = F_extended-use-case 3 | 4 | 5 | all: help 6 | 7 | doc: ## Update package documentation with `roxygen2` 8 | Rscript -e "roxygen2::roxygenise()"; \ 9 | 10 | knith: $(LFILE).Rmd ## Render README as HTML 11 | echo "rmarkdown::render('$(LFILE).Rmd',output_file='$(LFILE).html')" | R --no-save -q 12 | 13 | knitr: $(LFILE).Rmd ## Render README as markdown 14 | echo "rmarkdown::render('$(LFILE).Rmd',output_file='$(LFILE).md')" | R --no-save -q 15 | 16 | open: ## Open main HTML vignette in browser 17 | xdg-open docs/articles/$(VIGNETTE).html & 18 | 19 | allcon: ## Run 'allcontributors::add_contributors' 20 | Rscript -e 'allcontributors::add_contributors()' 21 | 22 | check: ## Run `rcmdcheck` 23 | Rscript -e 'rcmdcheck::rcmdcheck()' 24 | 25 | test: ## Run test suite 26 | Rscript -e 'testthat::test_local()' 27 | 28 | pkgcheck: ## Run `pkgcheck` and print results to screen. 29 | Rscript -e 'library(pkgcheck); checks <- pkgcheck(); print(checks); summary (checks)' 30 | 31 | install: ## Install current local version 32 | R CMD INSTALL '.' 33 | 34 | clean: ## Clean all junk files, including all pkgdown docs 35 | rm -rf *.html *.png README_cache docs/ 36 | 37 | help: ## Show this help 38 | @printf "Usage:\033[36m make [target]\033[0m\n" 39 | @grep -E '^[a-zA-Z_-]+:.*?## .*$$' $(MAKEFILE_LIST) | sort | awk 'BEGIN {FS = ":.*?## "}; {printf "\033[36m%-20s\033[0m %s\n", $$1, $$2}' 40 | -------------------------------------------------------------------------------- /R/testthat-fns.R: -------------------------------------------------------------------------------- 1 | testthat_is_parallel <- function (pkg_dir) { 2 | 3 | flist <- list.files (pkg_dir, recursive = TRUE, full.names = TRUE) 4 | desc <- grep ("DESCRIPTION$", flist, value = TRUE) 5 | if (length (desc) != 1L) { 6 | return (FALSE) 7 | } 8 | desc <- read.dcf (desc) 9 | field <- "Config/testthat/parallel" 10 | if (!field %in% colnames (desc)) { 11 | return (FALSE) 12 | } 13 | ret <- as.logical (desc [1L, field]) 14 | ret <- ifelse (is.na (ret), FALSE, ret) 15 | 16 | return (ret) 17 | } 18 | 19 | #' Remove testthat "parallel = true" config entry from DESCRIPTION 20 | #' 21 | #' Tests can not be traced in parallel (issue#10), so this line needs to be 22 | #' removed in order to enable tracing. 23 | #' @noRd 24 | rm_testthat_parallel <- function (pkg_dir) { 25 | 26 | message ( 27 | "Tests can not be traced with testthat tests run in parallel; ", 28 | "parallel testing has been temporarily deactivated." 29 | ) 30 | 31 | flist <- list.files (pkg_dir, recursive = TRUE, full.names = TRUE) 32 | desc_file <- grep ("DESCRIPTION$", flist, value = TRUE) 33 | if (length (desc_file) != 1L) { 34 | return (NULL) 35 | } 36 | desc <- brio::read_lines (desc_file) 37 | field <- "Config/testthat/parallel" 38 | desc <- desc [-grep (field, desc, fixed = TRUE)] 39 | 40 | brio::write_lines (desc, desc_file) 41 | } 42 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | pkg_name_from_desc <- function (path) { 2 | 3 | desc <- list.files ( 4 | path, 5 | pattern = "DESCRIPTION", 6 | recursive = TRUE, 7 | full.names = TRUE 8 | ) 9 | 10 | if (length (desc) < 1L) { 11 | stop ("No 'DESCRIPTION' file found", call. = FALSE) 12 | } else if (length (desc) > 1L) { 13 | stop ("Multiple 'DESCRIPTION' files found", call. = FALSE) 14 | } 15 | 16 | as.character (read.dcf (desc) [, "Package"]) 17 | } 18 | 19 | get_pkg_lib_path <- function (package, lib_paths) { 20 | 21 | pkg_path <- tryCatch ( 22 | find.package (package, lib.loc = lib_paths), 23 | error = function (e) NULL 24 | ) 25 | 26 | if (is.null (pkg_path)) { 27 | stop ( 28 | "Package '", package, "' is not installed. Please ", 29 | "install locally, or use 'devtools::load_all()' ", 30 | "before calling 'trace_package()'", 31 | call. = FALSE 32 | ) 33 | } 34 | 35 | lib_path <- normalizePath (file.path (pkg_path, "..")) 36 | 37 | return (lib_path) 38 | } 39 | 40 | set_trace_list_option <- function (trace_lists) { 41 | 42 | options (typetracer_trace_lists = trace_lists) 43 | } 44 | 45 | get_trace_lists_param <- function () { 46 | 47 | op <- options ("typetracer_trace_lists") [[1]] 48 | if (length (op) == 0L) { 49 | op <- FALSE 50 | } 51 | return (op) 52 | } 53 | -------------------------------------------------------------------------------- /man/inject_tracer.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tracer-inject.R 3 | \name{inject_tracer} 4 | \alias{inject_tracer} 5 | \title{Inject parameter tracer into one function} 6 | \usage{ 7 | inject_tracer(f, trace_lists = FALSE) 8 | } 9 | \arguments{ 10 | \item{f}{A function (that is, an object of class "function", and not a 11 | character string).} 12 | 13 | \item{trace_lists}{If \code{TRUE}, trace into any nested list parameters 14 | (including \code{data.frame}-type objects), and return type information on each 15 | list component. The parameter names for these list-components are then 16 | specified in "dollar-notation", for example 'Orange$age'.} 17 | } 18 | \value{ 19 | Nothing (will error on fail). 20 | } 21 | \description{ 22 | Inject parameter tracer into one function 23 | } 24 | \note{ 25 | The tracer is defined in the internal \code{typetracer_header()} function. 26 | This uses an \code{options} variable defined on package load for the current 27 | \code{tempdir}, defining a single location where all traced values are dumped. 28 | This is done via \code{options} to allow both multi-threaded function calls and 29 | calls via \pkg{callr} to be traced. 30 | } 31 | \examples{ 32 | f <- function (x, y, z, ...) { 33 | x * x + y * y 34 | } 35 | inject_tracer (f) 36 | val <- f (1:2, 3:4 + 0., a = "blah") 37 | x <- load_traces () 38 | 39 | # Traces should always be "uninjected": 40 | uninject_tracer (f) 41 | # Traces may also be removed: 42 | clear_traces () 43 | } 44 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | release: 8 | types: [published] 9 | workflow_dispatch: 10 | 11 | name: pkgdown.yaml 12 | 13 | permissions: read-all 14 | 15 | jobs: 16 | pkgdown: 17 | runs-on: ubuntu-latest 18 | # Only restrict concurrency for non-PR jobs 19 | concurrency: 20 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 21 | env: 22 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 23 | permissions: 24 | contents: write 25 | steps: 26 | - uses: actions/checkout@v4 27 | 28 | - uses: r-lib/actions/setup-pandoc@v2 29 | 30 | - uses: r-lib/actions/setup-r@v2 31 | with: 32 | use-public-rspm: true 33 | 34 | - uses: r-lib/actions/setup-r-dependencies@v2 35 | with: 36 | extra-packages: any::pkgdown, local::. 37 | needs: website 38 | 39 | - name: Build site 40 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 41 | shell: Rscript {0} 42 | 43 | - name: Deploy to GitHub pages 🚀 44 | if: github.event_name != 'pull_request' 45 | uses: JamesIves/github-pages-deploy-action@v4.5.0 46 | with: 47 | clean: false 48 | branch: gh-pages 49 | folder: docs 50 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: main 6 | pull_request: 7 | branches: main 8 | 9 | name: R-CMD-check.yaml 10 | 11 | permissions: read-all 12 | 13 | jobs: 14 | R-CMD-check: 15 | runs-on: ${{ matrix.config.os }} 16 | 17 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 18 | 19 | strategy: 20 | fail-fast: false 21 | matrix: 22 | config: 23 | - {os: macos-latest, r: 'release'} 24 | - {os: windows-latest, r: 'release'} 25 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 26 | - {os: ubuntu-latest, r: 'release'} 27 | - {os: ubuntu-latest, r: 'oldrel-1'} 28 | 29 | env: 30 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 31 | R_KEEP_PKG_SOURCE: yes 32 | 33 | steps: 34 | - uses: actions/checkout@v4 35 | 36 | - uses: r-lib/actions/setup-pandoc@v2 37 | 38 | - uses: r-lib/actions/setup-r@v2 39 | with: 40 | r-version: ${{ matrix.config.r }} 41 | http-user-agent: ${{ matrix.config.http-user-agent }} 42 | use-public-rspm: true 43 | 44 | - uses: r-lib/actions/setup-r-dependencies@v2 45 | with: 46 | extra-packages: any::rcmdcheck 47 | needs: check 48 | 49 | - uses: r-lib/actions/check-r-package@v2 50 | with: 51 | upload-snapshots: true 52 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 53 | -------------------------------------------------------------------------------- /man/trace_package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/trace-package.R 3 | \name{trace_package} 4 | \alias{trace_package} 5 | \title{Trace all parameters for all functions in a specified package} 6 | \usage{ 7 | trace_package( 8 | package = NULL, 9 | pkg_dir = NULL, 10 | functions = NULL, 11 | types = c("examples", "tests"), 12 | trace_lists = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{package}{Name of package to be traced (as character value).} 17 | 18 | \item{pkg_dir}{For "types" including "tests", a local directory to the source 19 | code of the package. (This is needed because installed versions do not 20 | generally include tests.)} 21 | 22 | \item{functions}{Optional character vector of names of functions to trace. 23 | Defaults to tracing all functions.} 24 | 25 | \item{types}{The types of code to be run to generate traces: one or both 26 | values of "examples" or "tests" (as for \code{tools::testInstalledPackage}). Note 27 | that only tests run via the \pkg{testthat} package can be traced.} 28 | 29 | \item{trace_lists}{If \code{TRUE}, trace into any nested list parameters 30 | (including \code{data.frame}-type objects), and return type information on each 31 | list component. The parameter names for these list-components are then 32 | specified in "dollar-notation", for example 'Orange$age'.} 33 | } 34 | \value{ 35 | A \code{data.frame} of data on every parameter of every function as 36 | specified in code provided in package examples. 37 | } 38 | \description{ 39 | Trace all parameters for all functions in a specified package 40 | } 41 | \examples{ 42 | \dontrun{ 43 | res <- trace_package ("rematch") 44 | res <- trace_package (pkg_dir = "////") 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /tests/testthat/test-utils.R: -------------------------------------------------------------------------------- 1 | test_that ("reassign_function_body changes function body", { 2 | 3 | f1 <- function (x) x 4 | 5 | attr (f1, "a") <- 1 6 | 7 | environment (f1) <- new.env () 8 | 9 | f1_formals <- formals (f1) 10 | f1_env <- environment (f1) 11 | f1_attrs <- attributes (f1) 12 | 13 | new_body <- quote (x * x) 14 | 15 | expect_null (reassign_function_body (f1, new_body)) 16 | 17 | expect_equal (body (f1), new_body) 18 | 19 | # check no side-effects 20 | expect_equal (formals (f1), f1_formals) 21 | expect_equal (environment (f1), f1_env) 22 | expect_identical (attributes (f1), f1_attrs) 23 | }) 24 | 25 | test_that ("reassign_function_body returns silently", { 26 | 27 | f1 <- function () 1 28 | expect_silent (reassign_function_body (f1, 2)) 29 | }) 30 | 31 | test_that ("reassign_function_body returns invisibly", { 32 | 33 | f1 <- function () 1 34 | expect_invisible (reassign_function_body (f1, 2)) 35 | }) 36 | 37 | test_that ("package not installed error", { 38 | expect_error ( 39 | trace_package (package = "abc123"), 40 | "there is no package called" 41 | ) 42 | }) 43 | 44 | skip_on_os ("windows") # sometimes fails to install 'rematch' package 45 | # CRAN: "Please do not install packages ... This can make the functions, 46 | # examples, and cran-check very slow. 47 | skip_on_cran () 48 | 49 | test_that ("utils functions", { 50 | package <- "rematch" 51 | lib_path <- pre_install (package) 52 | pkg_dir <- file.path (lib_path, package) 53 | 54 | expect_equal (package, pkg_name_from_desc (pkg_dir)) 55 | 56 | expect_error ( 57 | get_pkg_lib_path ("abc123"), 58 | "Package 'abc123' is not installed." 59 | ) 60 | }) 61 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: typetracer 2 | Title: Trace Function Parameter Types 3 | Version: 0.2.3.001 4 | Authors@R: c( 5 | person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre"), 6 | comment = c(ORCID = "0000-0003-2172-5265")), 7 | person("Filip", "Krikava", role = "ctb", 8 | comment = "Author of original 'injectr' code on which this package builds; https://github.com/PRL-PRG/injectr"), 9 | person("covr authors", role = "cph", 10 | comment = "Original authors of sections of code from 'covr' package included here in modified form.") 11 | ) 12 | Description: The 'R' language includes a set of defined types, but the language 13 | itself is "absurdly dynamic" (Turcotte & Vitek (2019) 14 | ), and lacks any way to specify which types are 15 | expected by any expression. The 'typetracer' package enables code to be 16 | traced to extract detailed information on the properties of parameters 17 | passed to 'R' functions. 'typetracer' can trace individual functions or 18 | entire packages. 19 | License: MIT + file LICENSE 20 | URL: https://github.com/mpadge/typetracer, 21 | https://mpadge.github.io/typetracer/ 22 | BugReports: https://github.com/mpadge/typetracer/issues 23 | Imports: 24 | brio, 25 | checkmate, 26 | methods, 27 | rlang, 28 | tibble, 29 | withr 30 | Suggests: 31 | knitr, 32 | rematch, 33 | rmarkdown, 34 | testthat (>= 3.0.0) 35 | VignetteBuilder: 36 | knitr 37 | Config/testthat/edition: 3 38 | Encoding: UTF-8 39 | Language: en-GB 40 | LazyData: true 41 | Roxygen: list(markdown = TRUE) 42 | RoxygenNote: 7.3.3 43 | FigshareCategories: 29203, 29200 44 | FigshareKeywords: software, R, computer, language, parameter types 45 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: main 6 | pull_request: 7 | branches: main 8 | 9 | name: test-coverage.yaml 10 | 11 | permissions: read-all 12 | 13 | jobs: 14 | test-coverage: 15 | runs-on: ubuntu-latest 16 | env: 17 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 18 | 19 | steps: 20 | - uses: actions/checkout@v4 21 | 22 | - uses: r-lib/actions/setup-r@v2 23 | with: 24 | use-public-rspm: true 25 | 26 | - uses: r-lib/actions/setup-r-dependencies@v2 27 | with: 28 | extra-packages: any::covr, any::xml2 29 | needs: coverage 30 | 31 | - name: Test coverage 32 | run: | 33 | cov <- covr::package_coverage( 34 | quiet = FALSE, 35 | clean = FALSE, 36 | install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") 37 | ) 38 | print(cov) 39 | covr::to_cobertura(cov) 40 | shell: Rscript {0} 41 | 42 | - uses: codecov/codecov-action@v5 43 | with: 44 | # Fail if error if not on PR, or if on PR and token is given 45 | fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} 46 | files: ./cobertura.xml 47 | plugins: noop 48 | disable_search: true 49 | token: ${{ secrets.CODECOV_TOKEN }} 50 | 51 | - name: Show testthat output 52 | if: always() 53 | run: | 54 | ## -------------------------------------------------------------------- 55 | find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true 56 | shell: bash 57 | 58 | - name: Upload test results 59 | if: failure() 60 | uses: actions/upload-artifact@v4 61 | with: 62 | name: coverage-test-failures 63 | path: ${{ runner.temp }}/package 64 | -------------------------------------------------------------------------------- /vignettes/nse.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Non-Standard Evaluation" 3 | author: 4 | - "Mark Padgham" 5 | date: "`r Sys.Date()`" 6 | vignette: > 7 | %\VignetteIndexEntry{Non-Standard Evaluat ion} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | ```{r setup, include=FALSE} 13 | knitr::opts_chunk$set ( 14 | collapse = TRUE, 15 | warning = TRUE, 16 | message = TRUE, 17 | width = 120, 18 | comment = "#>", 19 | fig.retina = 2, 20 | fig.path = "README-" 21 | ) 22 | options (repos = c ( 23 | ropenscireviewtools = "https://mpadge.r-universe.dev", 24 | CRAN = "https://cloud.r-project.org" 25 | )) 26 | library (typetracer) 27 | ``` 28 | 29 | This vignette briefly illustrates some examples of tracing parameters evaluated 30 | in non-standard ways. This first examples demonstrates that parameter values 31 | are captured at the initial point of function entry. 32 | 33 | ```{r nse1} 34 | eval_x_late_NSE <- function (x, y) { 35 | y <- 10 * y 36 | eval (substitute (x)) 37 | } 38 | inject_tracer (eval_x_late_NSE) 39 | eval_x_late_NSE (y + 1, 2:3) 40 | res <- load_traces () 41 | res$par_name 42 | res$uneval 43 | res$eval 44 | ``` 45 | 46 | The parameter `x` is evaluated at the point of function entry as `y + 1` which, 47 | with a value of `y = 2:3`, gives the expected evaluated result of `x = 3:4`, 48 | while the function ultimately returns the expected values of `(10 * 2:3) + 1`, 49 | or `21 31`, because the first line of `y <- 10 * y` is evaluated prior to 50 | substituting the value passed for `x` of `y + 1`. 51 | 52 | The second example specifies a default value of `x = y + 1`, with the actual 53 | call passing no value, and thus having `"NULL"` in the unevaluated version, 54 | while evaluated versions remain identical. 55 | 56 | ```{r nse2} 57 | clear_traces () # clear all preceding traces 58 | eval_x_late_standard <- function (x = y + 1, y, z = y ~ x) { 59 | y <- 10 * y 60 | x 61 | } 62 | inject_tracer (eval_x_late_standard) 63 | eval_x_late_standard (, 2:3) 64 | res <- load_traces () 65 | res$par_name 66 | res$uneval 67 | res$eval 68 | ``` 69 | 70 | The traces produced by `typetracer` also include a column, `formal`, which 71 | contains the default values specified in the definition of 72 | `eval_x_late_standard()`: 73 | 74 | ```{r} 75 | res$formal 76 | ``` 77 | 78 | Those three columns of `formal`, `uneval`, and `eval` thus contain 79 | all definitions for all parameters passed to the function environment, in the three possible states of: 80 | 81 | 1. Formal or default values (by definition, in an unevaluated state); 82 | 2. The unevaluated state of any specified parameters; and 83 | 3. The equivalent versions evaluated within the function environmental. 84 | -------------------------------------------------------------------------------- /.pre-commit-config.yaml: -------------------------------------------------------------------------------- 1 | # All available hooks: https://pre-commit.com/hooks.html 2 | # R specific hooks: https://github.com/lorenzwalthert/precommit 3 | repos: 4 | - repo: https://github.com/lorenzwalthert/precommit 5 | rev: v0.4.3.9017 6 | hooks: 7 | - id: style-files 8 | args: [--style_pkg=spaceout, --style_fun=spaceout_style] 9 | additional_dependencies: 10 | - ropensci-review-tools/spaceout 11 | # - id: roxygenize 12 | # codemeta must be above use-tidy-description when both are used 13 | # - id: codemeta-description-updated 14 | - id: use-tidy-description 15 | - id: spell-check 16 | exclude: > 17 | (?x)^( 18 | .*\.[rR]| 19 | .*\.feather| 20 | .*\.jpeg| 21 | .*\.pdf| 22 | .*\.png| 23 | .*\.py| 24 | .*\.RData| 25 | .*\.rds| 26 | .*\.Rds| 27 | .*\.Rproj| 28 | .*\.sh| 29 | (.*/|)\.gitignore| 30 | (.*/|)\.gitlab-ci\.yml| 31 | (.*/|)\.lintr| 32 | (.*/|)\.pre-commit-.*| 33 | (.*/|)\.Rbuildignore| 34 | (.*/|)\.Renviron| 35 | (.*/|)\.Rprofile| 36 | (.*/|)\.travis\.yml| 37 | (.*/|)appveyor\.yml| 38 | (.*/|)NAMESPACE| 39 | (.*/|)renv/settings\.dcf| 40 | (.*/|)renv\.lock| 41 | (.*/|)WORDLIST| 42 | \.github/workflows/.*| 43 | data/.*| 44 | )$ 45 | # - id: lintr 46 | - id: readme-rmd-rendered 47 | - id: parsable-R 48 | - id: no-browser-statement 49 | - id: no-debug-statement 50 | - id: deps-in-desc 51 | - repo: https://github.com/pre-commit/pre-commit-hooks 52 | rev: v6.0.0 53 | hooks: 54 | - id: check-added-large-files 55 | args: ['--maxkb=200'] 56 | - id: file-contents-sorter 57 | files: '^\.Rbuildignore$' 58 | - id: end-of-file-fixer 59 | exclude: '\.Rd' 60 | - repo: https://github.com/pre-commit-ci/pre-commit-ci-config 61 | rev: v1.6.1 62 | hooks: 63 | # Only reuiqred when https://pre-commit.ci is used for config validation 64 | - id: check-pre-commit-ci-config 65 | - repo: local 66 | hooks: 67 | - id: forbid-to-commit 68 | name: Don't commit common R artifacts 69 | entry: Cannot commit .Rhistory, .RData, .Rds or .rds. 70 | language: fail 71 | files: '\.(Rhistory|RData|Rds|rds)$' 72 | # `exclude: ` to allow committing specific files 73 | - id: description version 74 | name: Version has been incremeneted in DESCRIPTION 75 | entry: .hooks/description 76 | language: script 77 | 78 | ci: 79 | autoupdate_schedule: monthly 80 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/trace-fns.md: -------------------------------------------------------------------------------- 1 | # tracer body 2 | 3 | Code 4 | body 5 | Output 6 | { 7 | typetracer_env <- new.env(parent = emptyenv()) 8 | typetracer_env$td <- options("typetracedir") 9 | typetracer_env$nm <- paste0(sample(c(letters, LETTERS), 8), 10 | collapse = "") 11 | typetracer_env$fname <- file.path(typetracer_env$td, paste0("typetrace_", 12 | typetracer_env$nm, ".Rds")) 13 | typetracer_env$trace_dir <- options("typetracedir")$typetracedir 14 | typetracer_env$num_traces <- length(list.files(typetracer_env$trace_dir, 15 | pattern = "^typetrace\\_")) 16 | typetracer_env$fn_call <- match.call(expand.dots = TRUE) 17 | typetracer_env$fn_name <- typetracer_env$fn_call[[1]] 18 | typetracer_env$pars <- as.list(typetracer_env$fn_call[-1L]) 19 | fn_env <- environment() 20 | typetracer_env$fn <- match.fun(typetracer_env$fn_name) 21 | typetracer_env$par_names <- methods::formalArgs(typetracer_env$fn) 22 | typetracer_env$par_formals <- formals(typetracer_env$fn) 23 | typetracer_env$add_dotdotdot_params <- utils::getFromNamespace("add_dotdotdot_params", 24 | "typetracer") 25 | typetracer_env <- typetracer_env$add_dotdotdot_params(typetracer_env) 26 | typetracer_env$get_str <- utils::getFromNamespace("get_param_str", 27 | "typetracer") 28 | typetracer_env$trace_one_param <- utils::getFromNamespace("trace_one_param", 29 | "typetracer") 30 | typetracer_env$trace_one_list <- utils::getFromNamespace("trace_one_list", 31 | "typetracer") 32 | typetracer_env$get_trace_lists_param <- utils::getFromNamespace("get_trace_lists_param", 33 | "typetracer") 34 | typetracer_env$data <- lapply(typetracer_env$par_names, function(p) { 35 | dat_i <- typetracer_env$trace_one_param(typetracer_env, 36 | p, fn_env) 37 | trace_lists <- typetracer_env$get_trace_lists_param() 38 | if (dat_i$typeof == "list" && trace_lists) { 39 | dat_i$list_data <- typetracer_env$trace_one_list(typetracer_env, 40 | p, fn_env) 41 | } 42 | return(dat_i) 43 | }) 44 | typetracer_env$process_back_trace <- utils::getFromNamespace("process_back_trace", 45 | "typetracer") 46 | trace_dat <- rlang::trace_back(bottom = fn_env) 47 | typetracer_env$data$call_envs <- typetracer_env$process_back_trace(trace_dat, 48 | typetracer_env$fn_name) 49 | typetracer_env$data$fn_name <- as.character(typetracer_env$fn_name) 50 | typetracer_env$data$par_formals <- typetracer_env$par_formals 51 | typetracer_env$data$num_traces <- typetracer_env$num_traces 52 | saveRDS(typetracer_env$data, typetracer_env$fname) 53 | rm(typetracer_env) 54 | } 55 | 56 | -------------------------------------------------------------------------------- /tests/testthat/test-trace-fns.R: -------------------------------------------------------------------------------- 1 | is_gh_cov <- identical (Sys.getenv ("GITHUB_WORKFLOW"), "test-coverage.yaml") 2 | 3 | 4 | test_that ("tracer body", { 5 | 6 | body <- body (typetracer_header) 7 | if (!is_gh_cov) { 8 | # covr injects other symbols into code on workflow, so snapshot differs 9 | testthat::expect_snapshot (body) 10 | } 11 | }) 12 | 13 | test_that ("injected tracer body", { 14 | 15 | f <- function (x, y) { 16 | x * x + y * y 17 | } 18 | body0 <- body (f) 19 | 20 | inject_tracer (f) 21 | body1 <- body (f) 22 | 23 | expect_false (identical (body0, body1)) 24 | expect_true (length (body1) > length (body0)) 25 | 26 | expect_equal (body1 [[2]], body (typetracer_header)) 27 | expect_true (uninject_tracer (f)) 28 | }) 29 | 30 | test_that ("No traces", { 31 | 32 | clear_traces () 33 | expect_message ( 34 | x <- load_traces (), 35 | "No traces found; first run 'inject_tracer'" 36 | ) 37 | expect_null (x) 38 | }) 39 | 40 | test_that ("trace call", { 41 | 42 | f <- function (x, y) { 43 | x * x + y * y 44 | } 45 | 46 | clear_traces () 47 | inject_tracer (f) 48 | 49 | val <- f (x = 1:2, y = 3:4 + 0.) 50 | flist <- list.files (tempdir (), 51 | pattern = "^typetrace\\_", 52 | full.names = TRUE 53 | ) 54 | expect_true (length (flist) > 0L) 55 | 56 | x <- load_traces (files = TRUE) 57 | expect_true (uninject_tracer (f)) 58 | 59 | expect_s3_class (x, "tbl_df") 60 | expect_equal (nrow (x), 2L) # x and y 61 | expect_equal (ncol (x), 14L) 62 | expect_identical ( 63 | names (x), 64 | c ( 65 | "trace_name", "trace_number", 66 | "fn_name", "fn_call_hash", "call_env", 67 | "par_name", "class", "typeof", "mode", "storage_mode", 68 | "length", "formal", "uneval", "eval" 69 | ) 70 | ) 71 | }) 72 | 73 | test_that ("untrace call", { 74 | 75 | f <- function (x, y) { 76 | x * x + y * y 77 | } 78 | body0 <- body (f) 79 | 80 | inject_tracer (f) 81 | body1 <- body (f) 82 | 83 | expect_true (uninject_tracer (f)) 84 | body2 <- body (f) 85 | 86 | e0 <- as.character (as.expression (body0)) 87 | e1 <- as.character (as.expression (body1)) 88 | e2 <- as.character (as.expression (body2)) 89 | 90 | expect_false (identical (e0, e1)) 91 | 92 | expect_identical (e0, e2) 93 | expect_false (uninject_tracer (f)) 94 | }) 95 | 96 | test_that ("trace lists", { 97 | 98 | f <- function (x, y, a) { 99 | stopifnot (is.list (a)) 100 | stopifnot ("x" %in% names (a)) 101 | x * x + y * y + a$x 102 | } 103 | 104 | clear_traces () 105 | inject_tracer (f, trace_lists = FALSE) 106 | val <- f (x = 1:2, y = 3:4 + 0., a = list (x = 4)) 107 | x0 <- load_traces () 108 | expect_true (uninject_tracer (f)) 109 | 110 | clear_traces () 111 | inject_tracer (f, trace_lists = TRUE) 112 | val <- f (x = 1:2, y = 3:4 + 0., a = list (x = 4)) 113 | x1 <- load_traces () 114 | expect_true (uninject_tracer (f)) 115 | 116 | expect_true (nrow (x1) > nrow (x0)) 117 | expect_false (any (grepl ("\\$", x0$par_name))) 118 | expect_true (any (grepl ("\\$", x1$par_name))) 119 | }) 120 | -------------------------------------------------------------------------------- /R/tracer-inject.R: -------------------------------------------------------------------------------- 1 | #' Inject parameter tracer into one function 2 | #' 3 | #' @param f A function (that is, an object of class "function", and not a 4 | #' character string). 5 | #' @inheritParams trace_package 6 | #' @return Nothing (will error on fail). 7 | #' 8 | #' @note The tracer is defined in the internal `typetracer_header()` function. 9 | #' This uses an `options` variable defined on package load for the current 10 | #' `tempdir`, defining a single location where all traced values are dumped. 11 | #' This is done via `options` to allow both multi-threaded function calls and 12 | #' calls via \pkg{callr} to be traced. 13 | #' @export 14 | #' @examples 15 | #' f <- function (x, y, z, ...) { 16 | #' x * x + y * y 17 | #' } 18 | #' inject_tracer (f) 19 | #' val <- f (1:2, 3:4 + 0., a = "blah") 20 | #' x <- load_traces () 21 | #' 22 | #' # Traces should always be "uninjected": 23 | #' uninject_tracer (f) 24 | #' # Traces may also be removed: 25 | #' clear_traces () 26 | inject_tracer <- function (f, trace_lists = FALSE) { 27 | 28 | checkmate::assert_function (f) 29 | set_trace_list_option (trace_lists) 30 | 31 | # save body for re-injection: 32 | f_name <- deparse (substitute (f)) 33 | f_name <- cache_file_name (f, f_name) 34 | saveRDS (object = body (f), file = f_name) 35 | 36 | typetracer_header <- 37 | utils::getFromNamespace ("typetracer_header", "typetracer") 38 | code <- body (typetracer_header) 39 | 40 | fun_body <- body (f) 41 | 42 | new_body <- prepend_code (fun_body, code) 43 | 44 | invisible (reassign_function_body (f, new_body)) 45 | } 46 | 47 | cache_file_name <- function (f, f_name) { 48 | 49 | cache_dir <- file.path (get_typetrace_dir (), "fn_bodies") 50 | if (!dir.exists (cache_dir)) { 51 | dir.create (cache_dir, recursive = TRUE) 52 | } 53 | 54 | file.path ( 55 | cache_dir, 56 | paste0 ( 57 | "typetrace--", 58 | f_name, 59 | ".Rds" 60 | ) 61 | ) 62 | } 63 | 64 | reassign_function_body <- function (fun, body) { 65 | new_fn <- as.function ( 66 | c (as.list (formals (fun)), body), 67 | envir = environment (fun) 68 | ) 69 | attrs <- attributes (fun) [which (!names (attributes (fun)) == "srcref")] 70 | if (length (attrs) > 0L) { 71 | attributes (new_fn) <- attributes (fun) 72 | } 73 | 74 | invisible (.Call (reassign_function_body_, fun, new_fn)) 75 | } 76 | 77 | 78 | #' Remove parameter tracer from one function 79 | #' 80 | #' This function removes traces previous injected into functions with the 81 | #' \link{inject_tracer} function. 82 | #' 83 | #' @inheritParams inject_tracer 84 | #' @return Logical value indicating whether or not tracer was able to be removed 85 | #' ("uninjected"). 86 | #' @export 87 | #' @examples 88 | #' f <- function (x, y, z, ...) { 89 | #' x * x + y * y 90 | #' } 91 | #' inject_tracer (f) 92 | #' val <- f (1:2, 3:4 + 0., a = "blah") 93 | #' x <- load_traces () 94 | #' 95 | #' # Traces should always be "uninjected": 96 | #' uninject_tracer (f) 97 | #' # Traces may also be removed: 98 | #' clear_traces () 99 | uninject_tracer <- function (f) { 100 | 101 | checkmate::assert_function (f) 102 | 103 | f_name <- deparse (substitute (f)) 104 | f_name <- cache_file_name (f, f_name) 105 | if (!file.exists (f_name)) { 106 | return (FALSE) 107 | } 108 | 109 | body <- readRDS (f_name) 110 | reassign_function_body (f, body) 111 | file.remove (f_name) 112 | } 113 | -------------------------------------------------------------------------------- /tests/testthat/test-trace-package.R: -------------------------------------------------------------------------------- 1 | # CRAN: "Please do not install packages ... This can make the functions, 2 | # examples, and cran-check very slow. 3 | # skip_on_cran () 4 | 5 | is_gh_cov <- identical (Sys.getenv ("GITHUB_WORKFLOW"), "test-coverage") 6 | 7 | test_that ("errors", { 8 | package <- "rematch" 9 | pkg_dir <- file.path (tempdir (), "does_not_exist") 10 | expect_error ( 11 | trace_package (package, pkg_dir = pkg_dir), 12 | "Assertion on 'pkg_dir' failed" 13 | ) 14 | }) 15 | 16 | skip_on_os ("windows") # sometimes fails to install 'rematch' package 17 | 18 | test_that ("trace installed package", { 19 | 20 | # test pkg selected based on smallest installed size plus latest update > 21 | # 2015 or so. "praise" is also an option 22 | package <- "rematch" 23 | 24 | expect_s3_class (x0 <- trace_package (package), "tbl_df") 25 | 26 | expect_true (nrow (x0) > 5) # arbitrarily low number 27 | expect_identical ( 28 | names (x0), 29 | c ( 30 | "trace_number", "source_file_name", 31 | "fn_name", "fn_call_hash", "call_env", 32 | "par_name", "class", "typeof", 33 | "mode", "storage_mode", "length", 34 | "formal", "uneval", "eval" 35 | ) 36 | ) 37 | expect_true (all (grepl ("\\.Rd$", x0$source_file_name))) 38 | 39 | expect_s3_class ( 40 | x1 <- trace_package (package, 41 | types = c ("examples", "tests") 42 | ), 43 | "tbl_df" 44 | ) 45 | expect_true (nrow (x1) > 5) 46 | expect_identical ( 47 | names (x1), 48 | c ( 49 | "trace_number", "source_file_name", 50 | "fn_name", "fn_call_hash", "call_env", 51 | "par_name", "class", "typeof", 52 | "mode", "storage_mode", "length", 53 | "formal", "uneval", "eval" 54 | ) 55 | ) 56 | # still only Rd sources because no test files 57 | expect_true (all (grepl ("\\.Rd$", x0$source_file_name))) 58 | 59 | # installed packages have no tests, so traces are examples only: 60 | expect_identical (nrow (x0), nrow (x1)) 61 | }) 62 | 63 | test_that ("trace source package", { 64 | 65 | # note that this is from the source 66 | # https://github.com/MangoTheCat/rematch 67 | # which is different from the CRAN version, and includes `re_match_all()`. 68 | # Running tests only works with the version installed via devtools. 69 | # It's not worth adding that huge pkg to 'Suggests' just to increase test 70 | # coverage by a couple of lines. 71 | tarball <- testthat::test_path ("..", "rematch_1.0.1.tar.gz") 72 | tarball <- normalizePath (tarball) 73 | skip_if (!file.exists (tarball)) 74 | 75 | if (utils::untar (tarball, exdir = tempdir (), tar = "internal") != 0) { 76 | stop ("Unable to extract tarball to 'tempdir'") 77 | } 78 | 79 | package <- "rematch" 80 | path <- normalizePath (file.path (tempdir (), package)) 81 | 82 | expect_s3_class ( 83 | x0 <- trace_package ( 84 | package, 85 | pkg_dir = path, 86 | types = c ("examples", "tests") 87 | ), 88 | "tbl_df" 89 | ) 90 | 91 | expect_true (nrow (x0) > 5) # arbitrarily low number 92 | expect_identical ( 93 | names (x0), 94 | c ( 95 | "trace_number", "source_file_name", 96 | "fn_name", "fn_call_hash", "call_env", 97 | "par_name", "class", "typeof", 98 | "mode", "storage_mode", "length", 99 | "formal", "uneval", "eval" 100 | ) 101 | ) 102 | expect_false (all (grepl ("^rd_", x0$source_file_name))) 103 | 104 | source_rd <- grep ("\\.Rd$", x0$source_file_name, value = TRUE) 105 | # The testthat::test_path in `trace_package_tests` returns blank in some 106 | # test environments, giving source_file_names of "./test-name.R/..." rather 107 | # than full paths: 108 | source_test <- grep ("(^|\\.\\/)test", x0$source_file_name, value = TRUE) 109 | expect_true (length (source_rd) > 1L) 110 | expect_true (length (source_test) > 1L) 111 | 112 | # rematch has 2 fns: re_match + re_match_all 113 | expect_s3_class ( 114 | x1 <- trace_package ( 115 | package, 116 | pkg_dir = path, 117 | types = c ("examples", "tests"), 118 | functions = "re_match" 119 | ), 120 | "tbl_df" 121 | ) 122 | expect_true (nrow (x1) < nrow (x0)) 123 | }) 124 | -------------------------------------------------------------------------------- /src/utils.c: -------------------------------------------------------------------------------- 1 | #define USE_RINTERNALS 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include // for NULL 9 | #include // for uint64_t 10 | 11 | // See https://github.com/r-lib/covr/pull/587 12 | 13 | inline static 14 | void CheckBody(SEXP x) { 15 | switch (TYPEOF(x)) { 16 | case NILSXP: 17 | case SYMSXP: 18 | case LISTSXP: 19 | // case CLOSXP: 20 | case ENVSXP: 21 | case PROMSXP: 22 | case LANGSXP: 23 | // case SPECIALSXP: 24 | // case BUILTINSXP: 25 | case CHARSXP: 26 | case LGLSXP: 27 | case INTSXP: 28 | case REALSXP: 29 | case CPLXSXP: 30 | case STRSXP: 31 | // case DOTSXP: 32 | // case ANYSXP: 33 | case VECSXP: 34 | case EXPRSXP: 35 | case BCODESXP: 36 | case EXTPTRSXP: 37 | case WEAKREFSXP: 38 | case RAWSXP: 39 | case S4SXP: // renamed to OBJSXP 40 | return; 41 | 42 | default: 43 | error("Unexpected closure body type"); 44 | } 45 | } 46 | 47 | inline static 48 | void CheckEnvironment(SEXP x) { 49 | if(TYPEOF(x) != ENVSXP) 50 | error("Unexpected closure env type"); 51 | } 52 | 53 | inline static 54 | void CheckFormals(SEXP ls) { 55 | // copied from R: 56 | // https://github.com/wch/r-source/blob/tags/R-4-4-2/src/main/eval.c#L3842-L3852 57 | if (isList(ls)) { 58 | for (; ls != R_NilValue; ls = CDR(ls)) 59 | if (TYPEOF(TAG(ls)) != SYMSXP) 60 | goto err; 61 | return; 62 | } 63 | err: 64 | error("Unexpected closure formals"); 65 | } 66 | 67 | SEXP reassign_function_body(SEXP old_fun, SEXP new_fun) { 68 | if (TYPEOF(old_fun) != CLOSXP) Rf_error("old_fun must be a function"); 69 | if (TYPEOF(new_fun) != CLOSXP) Rf_error("new_fun must be a function"); 70 | 71 | // The goal is to modify `old_fun` in place, so that all existing references 72 | // to `old_fun` call the tracing `new_fun` instead. 73 | // This used to be simply: 74 | // SET_FORMALS(old_fun, FORMALS(new_fun)); 75 | // SET_BODY(old_fun, BODY(new_fun)); 76 | // SET_CLOENV(old_fun, CLOENV(new_fun)); 77 | // But those functions are now "non-API". So we comply with the letter of the 78 | // law and swap the fields manually, making some hard assumptions about the 79 | // underlying memory layout in the process. 80 | // Rather than using memcpy() with a hard-coded byte offset, we mirror the R 81 | // internals SEXPREC struct defs here, to hopefully match the alignment 82 | // behavior of R (e.g., on windows). 83 | 84 | // Mirror the exact structures of SEXPREC from R internals 85 | struct proxy_sxpinfo_struct { 86 | uint64_t bits; // guaranteed to be 64 bits 87 | }; 88 | 89 | struct proxy_closxp_struct { 90 | struct SEXPREC *formals; 91 | struct SEXPREC *body; 92 | struct SEXPREC *env; 93 | }; 94 | 95 | struct proxy_sexprec { 96 | struct proxy_sxpinfo_struct sxpinfo; 97 | struct SEXPREC *attrib; 98 | struct SEXPREC *gengc_next_node, *gengc_prev_node; 99 | union { 100 | struct proxy_closxp_struct closxp; 101 | // We could add other union members if needed 102 | } u; 103 | }; 104 | 105 | typedef struct proxy_sexprec* proxy_sexp; 106 | 107 | proxy_sexp old = (proxy_sexp) old_fun; 108 | proxy_sexp new = (proxy_sexp) new_fun; 109 | 110 | // Sanity checks. If the closxp struct is not what we expect, then the 111 | // underlying internal memory layout of a CLOSXP has probably changed and we 112 | // need to update this code. 113 | // https://github.com/wch/r-source/blob/tags/R-4-4-2/src/include/Defn.h#L170-L174 114 | CheckFormals(old->u.closxp.formals); 115 | CheckFormals(new->u.closxp.formals); 116 | CheckBody(old->u.closxp.body); 117 | CheckBody(new->u.closxp.body); 118 | CheckEnvironment(old->u.closxp.env); 119 | CheckEnvironment(new->u.closxp.env); 120 | 121 | MARK_NOT_MUTABLE(old_fun); 122 | MARK_NOT_MUTABLE(old->u.closxp.body); 123 | MARK_NOT_MUTABLE(old->u.closxp.env); 124 | MARK_NOT_MUTABLE(old->u.closxp.formals); 125 | 126 | MARK_NOT_MUTABLE(new_fun); 127 | MARK_NOT_MUTABLE(new->u.closxp.body); 128 | MARK_NOT_MUTABLE(new->u.closxp.env); 129 | MARK_NOT_MUTABLE(new->u.closxp.formals); 130 | 131 | old->u.closxp = new->u.closxp; 132 | 133 | // Duplicate attributes is still not "non-API", thankfully. 134 | DUPLICATE_ATTRIB(old_fun, new_fun); 135 | 136 | return R_NilValue; 137 | } 138 | 139 | 140 | extern SEXP reassign_function_body(SEXP, SEXP); 141 | 142 | static const R_CallMethodDef CallEntries[] = { 143 | {"reassign_function_body_", (DL_FUNC)&reassign_function_body, 2}, 144 | {NULL, NULL, 0}}; 145 | 146 | void R_init_typetracer(DllInfo *dll) { 147 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 148 | R_useDynamicSymbols(dll, FALSE); 149 | } 150 | -------------------------------------------------------------------------------- /codemeta.json: -------------------------------------------------------------------------------- 1 | { 2 | "@context": "https://doi.org/10.5063/schema/codemeta-2.0", 3 | "@type": "SoftwareSourceCode", 4 | "identifier": "typetracer", 5 | "description": "The 'R' language includes a set of defined types, but the language itself is \"absurdly dynamic\" (Turcotte & Vitek (2019) ), and lacks any way to specify which types are expected by any expression. The 'typetracer' package enables code to be traced to extract detailed information on the properties of parameters passed to 'R' functions. 'typetracer' can trace individual functions or entire packages.", 6 | "name": "typetracer: Trace Function Parameter Types", 7 | "relatedLink": [ 8 | "https://mpadge.github.io/typetracer/", 9 | "https://CRAN.R-project.org/package=typetracer" 10 | ], 11 | "codeRepository": "https://github.com/mpadge/typetracer", 12 | "issueTracker": "https://github.com/mpadge/typetracer/issues", 13 | "license": "https://spdx.org/licenses/MIT", 14 | "version": "0.2.2.016", 15 | "programmingLanguage": { 16 | "@type": "ComputerLanguage", 17 | "name": "R", 18 | "url": "https://r-project.org" 19 | }, 20 | "runtimePlatform": "R version 4.3.0 (2023-04-21)", 21 | "provider": { 22 | "@id": "https://cran.r-project.org", 23 | "@type": "Organization", 24 | "name": "Comprehensive R Archive Network (CRAN)", 25 | "url": "https://cran.r-project.org" 26 | }, 27 | "author": [ 28 | { 29 | "@type": "Person", 30 | "givenName": "Mark", 31 | "familyName": "Padgham", 32 | "email": "mark.padgham@email.com", 33 | "@id": "https://orcid.org/0000-0003-2172-5265" 34 | } 35 | ], 36 | "contributor": [ 37 | { 38 | "@type": "Person", 39 | "givenName": "Filip", 40 | "familyName": "Krikava" 41 | } 42 | ], 43 | "copyrightHolder": [ 44 | { 45 | "@type": "Organization", 46 | "name": "covr authors" 47 | } 48 | ], 49 | "maintainer": [ 50 | { 51 | "@type": "Person", 52 | "givenName": "Mark", 53 | "familyName": "Padgham", 54 | "email": "mark.padgham@email.com", 55 | "@id": "https://orcid.org/0000-0003-2172-5265" 56 | } 57 | ], 58 | "softwareSuggestions": [ 59 | { 60 | "@type": "SoftwareApplication", 61 | "identifier": "knitr", 62 | "name": "knitr", 63 | "provider": { 64 | "@id": "https://cran.r-project.org", 65 | "@type": "Organization", 66 | "name": "Comprehensive R Archive Network (CRAN)", 67 | "url": "https://cran.r-project.org" 68 | }, 69 | "sameAs": "https://CRAN.R-project.org/package=knitr" 70 | }, 71 | { 72 | "@type": "SoftwareApplication", 73 | "identifier": "rematch", 74 | "name": "rematch", 75 | "provider": { 76 | "@id": "https://cran.r-project.org", 77 | "@type": "Organization", 78 | "name": "Comprehensive R Archive Network (CRAN)", 79 | "url": "https://cran.r-project.org" 80 | }, 81 | "sameAs": "https://CRAN.R-project.org/package=rematch" 82 | }, 83 | { 84 | "@type": "SoftwareApplication", 85 | "identifier": "rmarkdown", 86 | "name": "rmarkdown", 87 | "provider": { 88 | "@id": "https://cran.r-project.org", 89 | "@type": "Organization", 90 | "name": "Comprehensive R Archive Network (CRAN)", 91 | "url": "https://cran.r-project.org" 92 | }, 93 | "sameAs": "https://CRAN.R-project.org/package=rmarkdown" 94 | }, 95 | { 96 | "@type": "SoftwareApplication", 97 | "identifier": "testthat", 98 | "name": "testthat", 99 | "version": ">= 3.0.0", 100 | "provider": { 101 | "@id": "https://cran.r-project.org", 102 | "@type": "Organization", 103 | "name": "Comprehensive R Archive Network (CRAN)", 104 | "url": "https://cran.r-project.org" 105 | }, 106 | "sameAs": "https://CRAN.R-project.org/package=testthat" 107 | } 108 | ], 109 | "softwareRequirements": { 110 | "1": { 111 | "@type": "SoftwareApplication", 112 | "identifier": "brio", 113 | "name": "brio", 114 | "provider": { 115 | "@id": "https://cran.r-project.org", 116 | "@type": "Organization", 117 | "name": "Comprehensive R Archive Network (CRAN)", 118 | "url": "https://cran.r-project.org" 119 | }, 120 | "sameAs": "https://CRAN.R-project.org/package=brio" 121 | }, 122 | "2": { 123 | "@type": "SoftwareApplication", 124 | "identifier": "checkmate", 125 | "name": "checkmate", 126 | "provider": { 127 | "@id": "https://cran.r-project.org", 128 | "@type": "Organization", 129 | "name": "Comprehensive R Archive Network (CRAN)", 130 | "url": "https://cran.r-project.org" 131 | }, 132 | "sameAs": "https://CRAN.R-project.org/package=checkmate" 133 | }, 134 | "3": { 135 | "@type": "SoftwareApplication", 136 | "identifier": "methods", 137 | "name": "methods" 138 | }, 139 | "4": { 140 | "@type": "SoftwareApplication", 141 | "identifier": "rlang", 142 | "name": "rlang", 143 | "provider": { 144 | "@id": "https://cran.r-project.org", 145 | "@type": "Organization", 146 | "name": "Comprehensive R Archive Network (CRAN)", 147 | "url": "https://cran.r-project.org" 148 | }, 149 | "sameAs": "https://CRAN.R-project.org/package=rlang" 150 | }, 151 | "5": { 152 | "@type": "SoftwareApplication", 153 | "identifier": "tibble", 154 | "name": "tibble", 155 | "provider": { 156 | "@id": "https://cran.r-project.org", 157 | "@type": "Organization", 158 | "name": "Comprehensive R Archive Network (CRAN)", 159 | "url": "https://cran.r-project.org" 160 | }, 161 | "sameAs": "https://CRAN.R-project.org/package=tibble" 162 | }, 163 | "6": { 164 | "@type": "SoftwareApplication", 165 | "identifier": "withr", 166 | "name": "withr", 167 | "provider": { 168 | "@id": "https://cran.r-project.org", 169 | "@type": "Organization", 170 | "name": "Comprehensive R Archive Network (CRAN)", 171 | "url": "https://cran.r-project.org" 172 | }, 173 | "sameAs": "https://CRAN.R-project.org/package=withr" 174 | }, 175 | "SystemRequirements": {} 176 | }, 177 | "fileSize": "106.259KB", 178 | "releaseNotes": "https://github.com/mpadge/typetracer/blob/master/NEWS.md", 179 | "contIntegration": [ 180 | "https://github.com/mpadge/typetracer/actions", 181 | "https://app.codecov.io/gh/mpadge/typetracer" 182 | ] 183 | } 184 | -------------------------------------------------------------------------------- /R/install.R: -------------------------------------------------------------------------------- 1 | #' Pre-install package in temporary `libPath` 2 | #' 3 | #' @param path Local path to package source. 4 | #' @param quiet If `FALSE`, display progress information on screen. 5 | #' @return Path to temporary location where package is installed from. 6 | #' @note Some of this code is slightly adapted from 'covr' code, from the 7 | #' `covr.R` file in that package. This original code is distributed under MIT 8 | #' License, with copyright held by 'covr authors' 9 | #' @noRd 10 | pre_install <- function (package, path = NULL, quiet = FALSE) { 11 | 12 | libs <- .libPaths () 13 | 14 | if (is.null (path)) { 15 | # installed packages without local source. If packages are not 16 | # installed, `find.package()` errors with, 17 | # "there is no package called '...'". 18 | path <- find.package (package, lib.loc = libs) 19 | } 20 | 21 | p <- paste0 ("package:", package) 22 | pkg_attached <- p %in% search () 23 | if (pkg_attached) { 24 | tryCatch ( 25 | unloadNamespace (package), 26 | error = function (e) NULL 27 | ) 28 | } 29 | 30 | 31 | # ----- BEGIN covr code 32 | 33 | flag_types <- c ( 34 | "CFLAGS", 35 | "CXXFLAGS", 36 | "CXX1XFLAGS", 37 | "CXX11FLAGS", 38 | "CXX14FLAGS", 39 | "CXX17FLAGS", 40 | "CXX20FLAGS" 41 | ) 42 | flags <- "-O0" # No compiler optimsation; strict code correctness only 43 | flags <- rep (flags, length (flag_types)) 44 | names (flags) <- flag_types 45 | 46 | install_path <- tempfile (pattern = "R_LIBS") 47 | dir.create (install_path) 48 | 49 | withr::with_makevars (flags, 50 | assignment = "+=", 51 | utils::install.packages ( 52 | repos = NULL, 53 | lib = install_path, 54 | path, 55 | type = "source", 56 | INSTALL_opts = c ( 57 | "--example", 58 | "--install-tests", 59 | "--with-keep.source", 60 | "--with-keep.parse.data", 61 | "--no-staged-install", 62 | "--no-multiarch" 63 | ), 64 | quiet = quiet 65 | ) 66 | ) 67 | 68 | # ----- END covr code 69 | 70 | 71 | lib_path <- get_pkg_lib_path (package, install_path) 72 | if (!lib_path %in% libs) { 73 | libs <- c (lib_path, libs) 74 | } 75 | 76 | loadNamespace (package, lib.loc = lib_path, keep.source = TRUE) 77 | attachNamespace (package) 78 | 79 | return (lib_path) 80 | } 81 | 82 | insert_counters_in_tests <- function (pkg_dir) { 83 | 84 | test_path <- file.path (pkg_dir, "tests", "testthat") 85 | if (!dir.exists (test_path)) { 86 | return (NULL) 87 | } 88 | 89 | test_files <- list.files ( 90 | test_path, 91 | pattern = "^test", 92 | recursive = TRUE, 93 | full.names = TRUE 94 | ) 95 | 96 | trace_dir <- options ("typetracedir")$typetracedir 97 | 98 | for (f in test_files) { 99 | 100 | p <- parse (f, keep.source = TRUE) 101 | p_injected <- lapply (seq_along (p), function (i) { 102 | pp_i <- parse (text = deparse (p [[i]]), keep.source = TRUE) 103 | pd_i <- utils::getParseData (pp_i, includeText = TRUE) 104 | testthat_start <- which ( 105 | pd_i$token == "SYMBOL_FUNCTION_CALL" & 106 | pd_i$text == "test_that" 107 | ) 108 | if (length (testthat_start) == 0L) { 109 | return (deparse (p [[i]])) 110 | } 111 | str_const_i <- which (pd_i$token == "STR_CONST") 112 | str_const_i <- 113 | str_const_i [which (str_const_i > testthat_start) [1]] 114 | test_name <- gsub ("\\\"|\\\'", "", pd_i$text [str_const_i]) 115 | 116 | pd_i <- deparse (p [[i]]) 117 | index1 <- grep (test_name, pd_i) 118 | index2 <- grep ("\\{", pd_i) 119 | index <- index2 [which (index2 >= index1 [1])] [1] 120 | test_name <- gsub ("\\s+", "_", test_name) 121 | pd_i <- c ( 122 | pd_i [seq (index)], 123 | "", 124 | paste0 ( 125 | "traces <- list.files (\"", 126 | trace_dir, 127 | "\", pattern = \"^typetrace_\", full.names = TRUE)" 128 | ), 129 | "ntraces <- length (traces)", 130 | paste0 ( 131 | "ftmp <- file.path (\"", 132 | pkg_dir, 133 | "\", \"tracetest_", 134 | test_name, 135 | ".txt\")" 136 | ), 137 | "writeLines (as.character (ntraces), ftmp)", 138 | "", 139 | pd_i [-seq (index)] 140 | ) 141 | 142 | return (pd_i) 143 | }) 144 | writeLines (unlist (p_injected), f) 145 | } 146 | } 147 | 148 | #' Reload package from default library location 149 | #' 150 | #' @param pkg_name Name of package to be re-loaded 151 | #' @param lib_path Path to temporary library location from which package was 152 | #' installed. 153 | #' 154 | #' @note This is directly modified from covr:::run_commands. Here, it just 155 | #' re-loads the package from the default library location, ensuring that the 156 | #' modified version is removed. 157 | #' 158 | #' @noRd 159 | reload_pkg <- function (pkg_name, lib_path) { 160 | 161 | # If package was not initially installed, don't do anything: 162 | install_path <- tryCatch ( 163 | find.package (pkg_name, lib.loc = .libPaths ()), 164 | error = function (e) NULL 165 | ) 166 | if (is.null (install_path)) { 167 | return (FALSE) 168 | } 169 | 170 | fpath <- ifelse ( 171 | grepl (tempdir (), lib_path), 172 | lib_path, 173 | tempdir () 174 | ) 175 | infile <- file.path (fpath, paste0 (pkg_name, "-reload.Rout")) 176 | outfile <- file.path (fpath, paste0 (pkg_name, "-reload-out.Rout")) 177 | cat ( 178 | "library ('", pkg_name, "')\n", 179 | file = infile, sep = "" 180 | ) 181 | cmd <- paste ( 182 | shQuote (file.path (R.home ("bin"), "R")), 183 | "CMD BATCH --vanilla --no-timing", 184 | shQuote (infile), shQuote (outfile) 185 | ) 186 | res <- system (cmd) 187 | if (res != 0L) { 188 | stop ("Command failed", call. = FALSE) 189 | } 190 | 191 | if (!identical (fpath, tempdir ())) { 192 | tryCatch ( 193 | unlink (fpath, recursive = TRUE), 194 | error = function (e) NULL 195 | ) 196 | } 197 | 198 | return (res == 0L) 199 | } 200 | -------------------------------------------------------------------------------- /R/load-and-clear-traces.R: -------------------------------------------------------------------------------- 1 | #' Load traces of parameter types 2 | #' 3 | #' @param files If `TRUE`, return paths to all temporary files holding trace 4 | #' data. 5 | #' @param quiet If `FALSE`, issue message when no traces found. 6 | #' @return A 'data.frame' of traces, including names of functions and 7 | #' parameters, and values of each parameter traced in both unevaluated and 8 | #' evaluated forms. 9 | #' @export 10 | #' @examples 11 | #' f <- function (x, y, z, ...) { 12 | #' x * x + y * y 13 | #' } 14 | #' inject_tracer (f) 15 | #' val <- f (1:2, 3:4 + 0., a = "blah") 16 | #' x <- load_traces () 17 | #' print (x) 18 | #' 19 | #' # Traces should always be "uninjected": 20 | #' uninject_tracer (f) 21 | #' # Traces may also be removed: 22 | #' clear_traces () 23 | load_traces <- function (files = FALSE, quiet = FALSE) { 24 | 25 | td <- get_typetrace_dir () 26 | traces <- list.files (td, pattern = "^typetrace\\_", full.names = TRUE) 27 | 28 | if (length (traces) == 0L) { 29 | if (!quiet) { 30 | message ("No traces found; first run 'inject_tracer'") 31 | } 32 | return (NULL) 33 | } 34 | 35 | # These are 'meta'-level trace objects, which are moved into the main 36 | # function environment here, and removed from traces. Traces from that point 37 | # on may be analysed by iterating over sequences of parameter traces. 38 | fn_name <- par_formals <- num_traces <- 39 | trace_source <- call_envs <- NULL # nolint 40 | trace_objs <- c ( 41 | "fn_name", "par_formals", "num_traces", 42 | "trace_source", "call_envs" 43 | ) 44 | 45 | out <- lapply (traces, function (i) { 46 | 47 | tr_i <- readRDS (i) 48 | 49 | for (to in trace_objs) { 50 | assign (to, tr_i [[to]]) 51 | } 52 | 53 | tr_i <- tr_i [which (!names (tr_i) %in% trace_objs)] 54 | fn_call_hash <- gsub ("^.*typetrace\\_|\\.Rds$", "", i) 55 | 56 | # simple vector columns: 57 | par_name <- vapply (tr_i, function (i) i$par, character (1L)) 58 | types <- vapply (tr_i, function (i) i$type, character (1L)) 59 | modes <- vapply (tr_i, function (i) i$mode, character (1L)) 60 | storage_mode <- vapply ( 61 | tr_i, function (i) i$storage_mode, 62 | character (1) 63 | ) 64 | len <- vapply (tr_i, function (i) i$length, integer (1L)) 65 | fmls <- par_formals [match (par_name, names (par_formals))] 66 | # list-columns: 67 | classes <- I (lapply (tr_i, function (i) i$class)) 68 | par_uneval <- I (lapply (tr_i, function (i) i$par_uneval)) 69 | par_eval <- I (lapply (tr_i, function (i) i$par_eval)) 70 | 71 | if (nrow (call_envs) == 0L) { 72 | call_envs <- call_envs [1, ] # auto-fills with NA 73 | } 74 | call_envs$call_env <- paste0 (call_envs$namespace, "::", call_envs$name) 75 | call_envs$call_env [which (is.na (call_envs$name))] <- NA_character_ 76 | 77 | out_i <- tibble::tibble ( 78 | trace_name = i, 79 | trace_number = num_traces, 80 | trace_source = trace_source, 81 | fn_name = fn_name, 82 | fn_call_hash = fn_call_hash, 83 | call_env = call_envs$call_env, 84 | par_name = par_name, 85 | class = classes, 86 | typeof = types, 87 | mode = modes, 88 | storage_mode = storage_mode, 89 | length = len, 90 | formal = fmls, 91 | uneval = par_uneval, 92 | eval = par_eval 93 | ) 94 | 95 | has_list <- integer (0L) 96 | if (get_trace_lists_param ()) { 97 | has_list <- which (vapply ( 98 | tr_i, 99 | function (i) "list_data" %in% names (i), 100 | logical (1L) 101 | )) 102 | } 103 | 104 | if (length (has_list) > 0L) { 105 | 106 | out_list_i <- lapply (tr_i [has_list], function (j) { 107 | j_out <- do.call (rbind, lapply (j$list_data, as.data.frame)) 108 | j_out$par <- paste0 (j$par, "$", j_out$par) 109 | return (j_out) 110 | }) 111 | out_list_i <- do.call (rbind, out_list_i) 112 | names (out_list_i) [names (out_list_i) == "par"] <- "par_name" 113 | names (out_list_i) [names (out_list_i) == "par_uneval"] <- "uneval" 114 | names (out_list_i) [names (out_list_i) == "par_eval"] <- "eval" 115 | 116 | out_list <- out_i [integer (0L), ] 117 | out_list <- out_list [seq_len (nrow (out_list_i)), ] 118 | index <- match (names (out_list_i), names (out_list)) 119 | out_list [, index] <- out_list_i 120 | index1 <- which (!names (out_list) %in% names (out_list_i)) 121 | index2 <- match (names (out_list) [index1], names (out_i)) 122 | out_list [, index1] <- out_i [seq_len (nrow (out_list_i)), index2] 123 | 124 | out_i <- rbind (out_i, out_list) 125 | } 126 | 127 | return (out_i) 128 | }) 129 | 130 | out <- do.call (rbind, out) 131 | 132 | if (!files) { 133 | out$trace_name <- out$call_env <- NULL 134 | } 135 | 136 | out <- out [order (out$trace_number), ] 137 | rownames (out) <- NULL 138 | 139 | names (out$par_name) <- NULL 140 | names (out$formal) <- names (out$uneval) <- names (out$eval) <- out$par_name 141 | 142 | return (out) 143 | } 144 | 145 | #' Clear previous traces 146 | #' 147 | #' Traces are by default appended to previous traces. This function can be used 148 | #' to clean those previous ones, to enable subsequent calls to generate new 149 | #' traces that are not appended to previous ones. 150 | #' 151 | #' @return (Invisibly) A single logical value indicating whether or not traces 152 | #' were successfully cleared. 153 | #' @export 154 | #' @examples 155 | #' f <- function (x, y, z, ...) { 156 | #' x * x + y * y 157 | #' } 158 | #' inject_tracer (f) 159 | #' val <- f (1:2, 3:4 + 0., a = "blah") 160 | #' x <- load_traces () 161 | #' print (x) 162 | #' 163 | #' # Then call 'clear_traces' to remove them: 164 | #' clear_traces () 165 | #' # Trying to load again wil then indicate 'No traces found': 166 | #' x <- load_traces () 167 | #' # Traces should also always be "uninjected": 168 | #' uninject_tracer (f) 169 | clear_traces <- function () { 170 | 171 | td <- get_typetrace_dir () 172 | traces <- list.files (td, pattern = "^typetrace\\_", full.names = TRUE) 173 | 174 | clear_fn_bodies_dir () 175 | 176 | invisible (file.remove (traces)) 177 | } 178 | 179 | #' Read numbers of traces at start of each test 180 | #' 181 | #' These numbers are created by the code injected by the 182 | #' `insert_counters_in_tests()` function in install.R. 183 | #' 184 | #' @param install_path file.path (typetracedir, package), passed here as single 185 | #' string. 186 | #' @return A `data.frame` of test names and number of traces at the start of 187 | #' that test. These numbers can then be used to associate traces with the 188 | #' specified test names in the "source" column from `load_traces()`. 189 | #' @noRd 190 | read_test_trace_numbers <- function (install_path) { 191 | 192 | flist <- list.files ( 193 | install_path, 194 | pattern = "^tracetest\\_", 195 | full.names = TRUE 196 | ) 197 | num_traces <- data.frame (trace_number = vapply ( 198 | flist, 199 | function (i) as.integer (readLines (i) [1]), 200 | integer (1L) 201 | )) 202 | num_traces$test <- gsub ( 203 | "^tracetest\\_|\\.txt$|\\.txt$", 204 | "", 205 | basename (rownames (num_traces)) 206 | ) 207 | num_traces <- 208 | num_traces [order (num_traces$trace_number), c ("test", "trace_number")] 209 | rownames (num_traces) <- NULL 210 | 211 | return (num_traces) 212 | } 213 | -------------------------------------------------------------------------------- /R/tracer-define.R: -------------------------------------------------------------------------------- 1 | #' Code injected in function heads that gets the types of all parameters 2 | #' 3 | #' All variables and functions are defined within a new environment, to avoid 4 | #' any confusion with variables or functions defined within functions in which 5 | #' this code in injected, and to enable all of the local variables and functions 6 | #' defined here to be easily deleted once types have been traced. This 7 | #' environment also has to have an unambiguous and unique name. 8 | #' @noRd 9 | typetracer_header <- function () { 10 | 11 | typetracer_env <- new.env (parent = emptyenv ()) 12 | 13 | # temp file to dump trace: 14 | typetracer_env$td <- options ("typetracedir") 15 | typetracer_env$nm <- paste0 (sample (c (letters, LETTERS), 8), 16 | collapse = "" 17 | ) 18 | typetracer_env$fname <- file.path ( 19 | typetracer_env$td, 20 | paste0 ("typetrace_", typetracer_env$nm, ".Rds") 21 | ) 22 | 23 | typetracer_env$trace_dir <- options ("typetracedir")$typetracedir 24 | typetracer_env$num_traces <- length (list.files ( 25 | typetracer_env$trace_dir, 26 | pattern = "^typetrace\\_" 27 | )) 28 | 29 | # Extract values. `match.call` returns the *expressions* submitted to the 30 | # call, while the evaluated versions of formalArgs are stored in the 31 | # environment. `get` is used for the latter to avoid re-`eval`-ing, but 32 | # `...` args are not eval'd on function entry. 33 | typetracer_env$fn_call <- match.call (expand.dots = TRUE) 34 | typetracer_env$fn_name <- typetracer_env$fn_call [[1]] 35 | typetracer_env$pars <- as.list (typetracer_env$fn_call [-1L]) 36 | 37 | fn_env <- environment () 38 | 39 | typetracer_env$fn <- match.fun (typetracer_env$fn_name) 40 | typetracer_env$par_names <- methods::formalArgs (typetracer_env$fn) 41 | typetracer_env$par_formals <- formals (typetracer_env$fn) 42 | 43 | # Bring in and run typetracer internal functions: 44 | typetracer_env$add_dotdotdot_params <- 45 | utils::getFromNamespace ("add_dotdotdot_params", "typetracer") 46 | typetracer_env <- typetracer_env$add_dotdotdot_params (typetracer_env) 47 | 48 | # 'get_str' is used in 'trace_one_param': 49 | typetracer_env$get_str <- 50 | utils::getFromNamespace ("get_param_str", "typetracer") 51 | typetracer_env$trace_one_param <- 52 | utils::getFromNamespace ("trace_one_param", "typetracer") 53 | typetracer_env$trace_one_list <- 54 | utils::getFromNamespace ("trace_one_list", "typetracer") 55 | typetracer_env$get_trace_lists_param <- 56 | utils::getFromNamespace ("get_trace_lists_param", "typetracer") 57 | 58 | typetracer_env$data <- lapply (typetracer_env$par_names, function (p) { 59 | dat_i <- typetracer_env$trace_one_param (typetracer_env, p, fn_env) 60 | trace_lists <- typetracer_env$get_trace_lists_param () 61 | if (dat_i$typeof == "list" && trace_lists) { 62 | dat_i$list_data <- 63 | typetracer_env$trace_one_list (typetracer_env, p, fn_env) 64 | } 65 | return (dat_i) 66 | }) 67 | 68 | typetracer_env$process_back_trace <- 69 | utils::getFromNamespace ("process_back_trace", "typetracer") 70 | # Initial trace has to be called in this environment: 71 | trace_dat <- rlang::trace_back (bottom = fn_env) 72 | 73 | # Uncomment this for debugging, and add "trace_dat" to "trace_objs" at start 74 | # of "load_traces" fn: 75 | # typetracer_env$data$trace_dat <- trace_dat 76 | 77 | typetracer_env$data$call_envs <- 78 | typetracer_env$process_back_trace (trace_dat, typetracer_env$fn_name) 79 | 80 | typetracer_env$data$fn_name <- as.character (typetracer_env$fn_name) 81 | typetracer_env$data$par_formals <- typetracer_env$par_formals 82 | typetracer_env$data$num_traces <- typetracer_env$num_traces 83 | 84 | saveRDS (typetracer_env$data, typetracer_env$fname) 85 | 86 | rm (typetracer_env) 87 | } 88 | 89 | #' Add information on any additional parameters passed via '...' 90 | #' @noRd 91 | add_dotdotdot_params <- function (typetracer_env) { 92 | 93 | if ("..." %in% typetracer_env$par_names) { 94 | 95 | typetracer_env$dot_names <- names (typetracer_env$fn_call) 96 | 97 | index <- which (nzchar (typetracer_env$dot_names) & 98 | !typetracer_env$dot_names %in% typetracer_env$par_names) 99 | typetracer_env$dot_names <- typetracer_env$dot_names [index] 100 | 101 | typetracer_env$par_names <- c ( 102 | typetracer_env$par_names, 103 | typetracer_env$dot_names 104 | ) 105 | } 106 | 107 | return (typetracer_env) 108 | } 109 | 110 | #' Return structure of parameters as character strings 111 | #' 112 | #' See https://rpubs.com/maechler/R_language_objs 113 | #' @noRd 114 | get_param_str <- function (x, max.length = 1000L) { # nolint 115 | 116 | r <- tryCatch (format (x), error = function (e) e) 117 | r <- if (inherits (r, "error")) { 118 | tryCatch (as.character (x), error = function (e) e) 119 | } else { 120 | paste (r, collapse = " ") 121 | } 122 | r <- if (inherits (r, "error")) { 123 | tryCatch (utils::capture.output (x), error = function (e) e) 124 | } else { 125 | paste (r, collapse = " ") 126 | } 127 | substr (r, 1L, max.length) 128 | } 129 | 130 | #' Extract information on one parameter 131 | #' @noRd 132 | trace_one_param <- function (typetracer_env, p, fn_env) { 133 | 134 | res <- NULL 135 | 136 | # standard evalation for named parameters which exist in fn_env: 137 | if (p %in% ls (fn_env)) { 138 | res <- tryCatch ( 139 | get (p, envir = fn_env, inherits = FALSE), 140 | error = function (e) NULL 141 | ) 142 | } 143 | 144 | # non-standard evaluation: 145 | if (is.null (res)) { 146 | res <- tryCatch ( 147 | eval (typetracer_env$pars [[p]], envir = fn_env), 148 | error = function (e) NULL 149 | ) 150 | } 151 | 152 | s <- "NULL" 153 | if (!is.null (res)) { 154 | s <- typetracer_env$get_str (typetracer_env$pars [[p]]) 155 | if (length (s) > 1L) { 156 | s <- paste0 (s, collapse = "; ") 157 | } 158 | if (is.null (s)) { 159 | s <- "NULL" 160 | } 161 | } 162 | 163 | list ( 164 | par = p, 165 | class = class (res), 166 | typeof = typeof (res), 167 | storage_mode = storage.mode (res), 168 | mode = mode (res), 169 | length = length (res), 170 | par_uneval = s, 171 | par_eval = res 172 | ) 173 | } 174 | 175 | #' Recurse into one list-type parameter to extract internal structure. 176 | #' 177 | #' Standard evaluation only! 178 | #' @noRd 179 | trace_one_list <- function (typetracer_env, p, fn_env) { 180 | 181 | res <- tryCatch ( 182 | get (p, envir = fn_env, inherits = FALSE), 183 | error = function (e) NULL 184 | ) 185 | 186 | # non-standard evaluation, which is also necessary for lists passed as 187 | # `...`: 188 | if (is.null (res)) { 189 | res <- tryCatch ( 190 | eval (typetracer_env$pars [[p]], envir = fn_env), 191 | error = function (e) NULL 192 | ) 193 | } 194 | if (is.null (res)) { 195 | return (res) 196 | } 197 | 198 | list_str <- lapply (seq_along (res), function (i) { 199 | list ( 200 | par = names (res) [i], 201 | class = class (res [[i]]), 202 | typeof = typeof (res [[i]]), 203 | storage_mode = storage.mode (res [[i]]), 204 | mode = mode (res [[i]]), 205 | length = length (res [[i]]), 206 | par_uneval = NA_character_, 207 | par_eval = NA_character_ 208 | ) 209 | }) 210 | 211 | return (list_str) 212 | } 213 | 214 | #' Extract environments of function calls 215 | #' 216 | #' Note that rlang enumerates envs from "0" for the calling environment. For 217 | #' srcref structure, see: 218 | #' https://journal.r-project.org/archive/2010-2/RJournal_2010-2_Murdoch.pdf 219 | #' Note that line numbers in srcref are from parsed versions, so will generally 220 | #' not exactly match. 221 | #' 222 | #' @param trace_dat A back-traced syntax tree returned from 223 | #' 'rlang::trace_back()'. 224 | #' @noRd 225 | process_back_trace <- function (trace_dat, fn_name) { 226 | 227 | call_envs <- data.frame ( 228 | name = NA_character_, 229 | file = NA_character_, 230 | linestart = NA_integer_, 231 | lineend = NA_integer_, 232 | namespace = NA_character_ 233 | ) 234 | if (length (fn_name) == 0L) { 235 | return (call_envs [-1, ]) 236 | } 237 | 238 | # Reduce to only calls at same level as the actual function, which then 239 | # includes any embedded environments of those, such as testthat expectations 240 | # or 'tryCatch' calls. Those will then be first on the call_env list in the 241 | # final reduction to one row, below. 242 | has_fn_name <- vapply (trace_dat$call, function (i) { 243 | index <- seq_along (i) 244 | p <- NULL 245 | while (is.null (p) && length (index) > 0L) { 246 | p <- tryCatch ( 247 | parse (text = i [index], encoding = "UTF-8"), 248 | error = function (e) NULL 249 | ) 250 | index <- index [-length (index)] 251 | } 252 | pd <- tryCatch ( 253 | utils::getParseData (p), 254 | error = function (e) NULL 255 | ) 256 | if (is.null (pd)) { 257 | return (FALSE) 258 | } 259 | index <- which (pd$token %in% c ("SYMBOL", "SYMBOL_FUNCTION_CALL")) 260 | fns <- pd$text [index] 261 | return (any (fns == fn_name)) 262 | }, logical (1L)) 263 | 264 | trace_dat <- trace_dat [which (has_fn_name), ] 265 | 266 | if (nrow (trace_dat) == 0L) { 267 | return (call_envs) 268 | } 269 | 270 | call_envs <- lapply (trace_dat$call, function (i) { 271 | call_i <- data.frame ( 272 | name = as.character (as.name (as.list (i) [[1]])), 273 | file = NA_character_, 274 | linestart = NA_integer_, 275 | lineend = NA_integer_ 276 | ) 277 | if (!is.null (attributes (i)$srcref)) { 278 | call_i$file <- attr (attributes (i)$srcref, "srcfile")$filename 279 | call_i$linestart <- attr (i, "srcref") [1] 280 | call_i$lineend <- attr (i, "srcref") [3] 281 | } 282 | return (call_i) 283 | }) 284 | call_envs <- do.call (rbind, call_envs) 285 | call_envs$namespace <- trace_dat$namespace 286 | index <- which (is.na (call_envs$namespaces)) 287 | if (length (index) > 0L) { 288 | call_envs$namespace [index] <- trace_dat$scope [index] 289 | } 290 | 291 | if (nrow (call_envs) > 0L) { 292 | # assume first branch of trace_back is desired env 293 | call_envs <- call_envs [1, ] 294 | } 295 | 296 | return (call_envs) 297 | } 298 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: typetracer 3 | output: md_document 4 | --- 5 | 6 | 7 | [![R-CMD-check](https://github.com/mpadge/typetracer/workflows/R-CMD-check/badge.svg)](https://github.com/mpadge/typetracer/actions) 8 | [![codecov](https://codecov.io/gh/mpadge/typetracer/branch/main/graph/badge.svg)](https://app.codecov.io/gh/mpadge/typetracer) 9 | [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/typetracer)](https://cran.r-project.org/package=typetracer/) 10 | [![CRAN Downloads](https://cranlogs.r-pkg.org/badges/grand-total/typetracer?color=orange)](https://cran.r-project.org/package=typetracer) 11 | 12 | 13 | ```{r setup, include=FALSE} 14 | knitr::opts_chunk$set (echo = TRUE) 15 | ``` 16 | 17 | # typetracer 18 | 19 | `typetracer` is an R package to trace function parameter types. The R language 20 | includes [a set of defined 21 | types](https://cran.r-project.org/doc/manuals/r-release/R-lang.html#Basic-types), 22 | but the language itself is ["absurdly 23 | dynamic"](https://doi.org/10.1145/3340670.3342426)[^1], and lacks 24 | any way to specify which types are expected by any expression. The `typetracer` 25 | package enables code to be traced to extract detailed information on the 26 | properties of parameters passed to R functions. `typetracer` can trace 27 | individual functions or entire packages, as demonstrated below. 28 | 29 | [^1]: Alexi Turcotte & Jan Vitek (2019), *Towards a Type System for R*, 30 | ICOOOLPS '19: Proceedings of the 14th Workshop on Implementation, Compilation, Optimization of Object-Oriented Languages, Programs and Systems. 31 | Article No. 4, Pages 1–5, https://doi.org/10.1145/3340670.3342426 32 | 33 | ## Installation 34 | 35 | The stable version of the package can be installed with one of the following commands: 36 | 37 | ```{r remotes, eval = FALSE} 38 | # Stable version from CRAN: 39 | install.packages ("typetracer") 40 | # Current development version from r-universe: 41 | install.packages ( 42 | "typetracer", 43 | repos = c ("https://mpadge.r-universe.dev", "https://cloud.r-project.org") 44 | ) 45 | ``` 46 | 47 | Alternatively, for those who prefer to use other source code platforms, the 48 | package can also be installed by running any one of the following lines: 49 | 50 | ```{r remotes-alt, eval = FALSE} 51 | remotes::install_git ("https://git.sr.ht/~mpadge/typetracer") 52 | remotes::install_git ("https://codeberg.org/mpadge/typetracer") 53 | remotes::install_bitbucket ("mpadge/typetracer") 54 | remotes::install_gitlab ("mpadge/typetracer") 55 | ``` 56 | 57 | 58 | The package can then loaded for use by calling `library`: 59 | 60 | ```{r} 61 | library (typetracer) 62 | ``` 63 | 64 | 65 | ## Example #1 - A Single Function 66 | 67 | `typetracer` works by "injecting" tracing code into the body of a function 68 | using [the `inject_tracer()` 69 | function](https://mpadge.github.io/typetracer/reference/inject_tracer.html). 70 | Locally-defined functions can be traced by simply passing the functions 71 | directly to `inject_tracer()`. The following example includes four parameters, 72 | including `...` to allow passing of additional and entirely arbitrary parameter 73 | types and values. 74 | 75 | ```{r inject} 76 | f <- function (x, y, z, ...) { 77 | x * x + y * y 78 | } 79 | inject_tracer (f) 80 | ``` 81 | 82 | After injecting the `typetracer` code, calls to the function, `f`, will "trace" 83 | each parameter of the function, by capturing both unevaluated and evaluated 84 | representations at the point at which the function is first called. These 85 | values can be accessed with [the `load_traces` 86 | function](https://mpadge.github.io/typetracer/reference/load_traces.html), 87 | which returns a `data.frame` object (in [`tibble` 88 | format](https://tibble.tidyverse.org)) with one row for each parameter from 89 | each function call. 90 | 91 | ```{r trace1} 92 | val <- f ( 93 | x = 1:2, 94 | y = 3:4 + 0., 95 | a = "blah", 96 | b = list (a = 1, b = "b"), 97 | f = a ~ b 98 | ) 99 | x <- load_traces () 100 | x 101 | ``` 102 | 103 | Each row of the result returned by `load_traces()` represents one parameter 104 | passed to one function call. Each function call itself represents a single 105 | "trace" as enumerated by the `trace_number` column, and also uniquely 106 | identified by an arbitrary function call hash (`fn_call_hash`). The remaining 107 | columns of the trace data define the properties of each parameter, `p`, as: 108 | 109 | 1. `par_name`: Name of parameter. 110 | 2. `class`: List of classes of parameter. 111 | 3. `typeof`: Result of `typeof(p)`. 112 | 4. `mode`: Result of `mode(p)`. 113 | 5. `storage_mode`: Result of `storage.mode(p)`. 114 | 6. `length`: Result of `length(p)`. 115 | 7. `formal`: Result of `formals(f)[["p"]]`, as named list item with default 116 | value where specified. 117 | 8. `uneval`: Parameters as passed to the function call prior to evaluation 118 | within function environment. 119 | 9. `eval`: Evaluated version of parameter. 120 | 121 | The results above show that all parameters of the function, `f()`, were 122 | successfully traced, including the additional parameters, `a`, `b`, and `f`, 123 | passed as part of the `...` argument. Such additional parameters can be 124 | identified through having a `"formal"` entry of `NULL`, indicating that they 125 | are not part of the formal arguments to the function. 126 | 127 | That result can also be used to demonstrate the difference between the 128 | unevaluated and evaluated forms of parameters: 129 | 130 | ```{r uneval-eval} 131 | x$uneval [x$par_name %in% c ("b", "f")] 132 | x$eval [x$par_name %in% c ("b", "f")] 133 | ``` 134 | 135 | Unevaluated parameters are generally converted to equivalent character 136 | expressions. 137 | 138 | The `typeof`, `mode`, and `storage_mode` columns are similar, yet may hold 139 | distinct information for certain types of parameters. The conditions under 140 | which these values differ are complex, and depend among other things on the 141 | version of R itself. `typeof` alone should generally provide sufficient 142 | information, although [this list of 143 | differences](https://stackoverflow.com/a/37469255) may provide further insight 144 | into whether the other columns may provide useful additional information. 145 | 146 | Traces themselves are saved in the temporary directory of the current R 147 | session, and [the `load_traces()` 148 | function](https://mpadge.github.io/typetracer/reference/load_traces.html) 149 | simply loads all traces created in that session. [The function 150 | `clear_traces()`](https://mpadge.github.io/typetracer/reference/clear_traces.html) 151 | removes all traces, so that 152 | [`load_traces()`](https://mpadge.github.io/typetracer/reference/load_traces.html) 153 | will only load new traces produced after that time. 154 | 155 | ### Uninjecting Traces 156 | 157 | It is important after applying [the `inject_tracer()` 158 | function](https://mpadge.github.io/typetracer/reference/inject_tracer.html) to 159 | restore the functions back to their original form through calling [the obverse 160 | `uninject_tracer()` 161 | function](https://mpadge.github.io/typetracer/reference/uninject_tracer.html). 162 | For the function, `r`, above, this simply requires, 163 | 164 | ```{r} 165 | uninject_tracer (f) 166 | ``` 167 | 168 | All traces can also be removed with this functions: 169 | 170 | ```{r} 171 | clear_traces () 172 | ``` 173 | 174 | 175 | Because `typetracer` modifies the internal code of functions as defined within 176 | a current R session, we strongly recommend restarting your R session after 177 | using `typetracer`, to ensure expected function behaviour is restored. 178 | 179 | 180 | ## Example #2 - Recursion into lists 181 | 182 | R has extensive support for list structures, notably including all 183 | `data.frame`-like objects in which each column is actually a list item. 184 | `typetracer` also offers the ability to recurse into the list structures of 185 | individual parameters, to recursively trace the properties of each list item. 186 | To do this, the traces themselves have to be injected with the additional 187 | parameter, `trace_lists = TRUE`. 188 | 189 | 190 | The final call above included an additional parameter passed as a list. The 191 | following code re-injects a tracer with the ability to traverse into list 192 | structures: 193 | 194 | ```{r} 195 | inject_tracer (f, trace_lists = TRUE) 196 | val <- f ( 197 | x = 1:2, 198 | y = 3:4 + 0., 199 | a = "blah", 200 | b = list (a = 1, b = "b"), 201 | f = a ~ b 202 | ) 203 | x_lists <- load_traces () 204 | print (x_lists) 205 | ``` 206 | 207 | And that result now has `r nrow(x_lists)` rows, or 208 | `r nrow(x_lists) - nrow(x)` more than the previous example, reflecting the two 209 | items passed as a `list` to the parameter, `b`. List-parameter items are 210 | identifiable in typetracer output through the "dollar-notation" in the 211 | `par_name` field. The final two values in the above table are `b$a` and `b$b`, 212 | representing the two elements of the list passed as the parameter, `b`. 213 | 214 | 215 | ## Example #3 - Tracing a Package 216 | 217 | This section presents a more complex example tracing all function calls from 218 | [the `rematch` package](https://github.com/MangoTheCat/rematch), chosen because 219 | it has less code than almost any other package on CRAN. The following single 220 | line traces function calls in all examples for the nominated package. [The 221 | `trace_package()` 222 | function](https://mpadge.github.io/typetracer/reference/trace_package.html) 223 | automatically injects tracing code into every 224 | function within the package, so there is no need to explicitly call [the 225 | `inject_tracer()` 226 | function](https://mpadge.github.io/typetracer/reference/inject_tracer). 227 | 228 | (This function also includes a `trace_lists` parameter, as demonstrated above, 229 | with a default of `FALSE` to not recurse into tracing list structures.) 230 | 231 | ```{r trace-rematch, message = FALSE} 232 | res <- trace_package ("rematch") 233 | res 234 | ``` 235 | 236 | The `data.frame` returned by the `trace_package()` function includes three 237 | more columns than the result directly returned by `load_traces()`. These 238 | columns identify the sources and calling environments of each function call 239 | being traces. The "call_env" column identifies the calling environment which 240 | generated each trace, while "source_file_name" identifies the file. 241 | 242 | ```{r call_env} 243 | unique (res$call_env) 244 | unique (res$source_file_name) 245 | ``` 246 | 247 | Although the "call_env" columns contains no useful information for that 248 | package, it includes information on the full environment in which each function 249 | was called. These "environments" include such things as `tryCatch` calls 250 | expected to generate errors, or the various `expect_` functions of the 251 | ["testthat" package](https://testthat.r-lib.org/). The above case of racing an 252 | installed package generally only extracts traces from example code, as 253 | documented in help, or `.Rd`, files. These are identified by the "rd_" prefix 254 | on the "source_file_name", with the `rematch` package including only one `.Rd` 255 | file. 256 | 257 | [The `trace_package()` 258 | function](https://mpadge.github.io/typetracer/reference/trace_package.html) 259 | also includes an additional parameter, `types`, which defaults to `c 260 | ("examples", "tests")`, so that traces are also by default generated for all 261 | tests included with local source packages (or for packages installed to include 262 | test files). The "source" column for test files identifies the names of each 263 | test, prefixed with "test_". 264 | 265 | The other two additional columns of "trace_file" and "call_env" respectively 266 | specify the source file and calling environment of each trace. These will 267 | generally only retain information from test files, in which case the source 268 | file will generally be the file name identified in the "source" column, and 269 | "call_env" will specify the environment from which that function call 270 | originated. Environments may, for example, include various types of expectation 271 | from the ["testthat" package](https://testthat.r-lib.org). These calling 272 | environments are useful to discern whether, for example, a call was made with 273 | an expectation that it should error. 274 | 275 | ### Example #3(a) - Specifying Functions to Trace 276 | 277 | [The `trace_package()` 278 | function](https://mpadge.github.io/typetracer/reference/trace_package.html) 279 | also accepts an argument, `functions`, specifying which functions from a 280 | package should be traced. For example, 281 | 282 | ```{r trace-stats, eval = FALSE} 283 | x <- trace_package ("stats", functions = "sd") 284 | ``` 285 | ```{r stats-output, echo = FALSE} 286 | # Create an empty list for formal params. "empty" means an empty name or symbol 287 | # object, which can be conveniently constructed with 'substitute()': 288 | formal <- pairlist ( 289 | x = substitute (), 290 | na.rm = FALSE 291 | ) 292 | types <- c ("integer", "logical") 293 | 294 | x <- tibble::tibble ( 295 | trace_number = 0L, 296 | trace_source = "examples", 297 | fn_name = "sd", 298 | fn_call_hash = "EzasZOKV", 299 | trace_file = NA_character_, 300 | call_env = NA_character_, 301 | par_name = c ("x", "na.rm"), 302 | class = I (as.list (types)), 303 | typeof = types, 304 | mode = c ("numeric", "logical"), 305 | storage_mode = types, 306 | length = 2:1, 307 | formal = I (as.list (formal)), 308 | uneval = I (list (x = 1:2, na.rm = "NULL")), 309 | eval = I (list (x = 1:2, na.rm = FALSE)), 310 | source = "rd_sd" 311 | ) 312 | x 313 | ``` 314 | 315 | ## Prior Art 316 | 317 | This package extends on concepts previously developed in other R packages, 318 | notably including: 319 | 320 | - The [`typed` package](https://github.com/moodymudskipper/typed) by 321 | [@moodymudskipper](https://github.com/moodymudskipper) 322 | - The [`contractr` package](https://github.com/PRL-PRG/contractr) by 323 | [@aviralg](https://github.com/aviralg) & 324 | [@fikovnik](https://github.com/fikovnik) 325 | 326 | Plus work explained in detail in this footnote:
327 | -------------------------------------------------------------------------------- /R/trace-package.R: -------------------------------------------------------------------------------- 1 | #' Trace all parameters for all functions in a specified package 2 | #' 3 | #' @param package Name of package to be traced (as character value). 4 | #' @param pkg_dir For "types" including "tests", a local directory to the source 5 | #' code of the package. (This is needed because installed versions do not 6 | #' generally include tests.) 7 | #' @param functions Optional character vector of names of functions to trace. 8 | #' Defaults to tracing all functions. 9 | #' @param types The types of code to be run to generate traces: one or both 10 | #' values of "examples" or "tests" (as for `tools::testInstalledPackage`). Note 11 | #' that only tests run via the \pkg{testthat} package can be traced. 12 | #' @param trace_lists If `TRUE`, trace into any nested list parameters 13 | #' (including `data.frame`-type objects), and return type information on each 14 | #' list component. The parameter names for these list-components are then 15 | #' specified in "dollar-notation", for example 'Orange$age'. 16 | #' @return A `data.frame` of data on every parameter of every function as 17 | #' specified in code provided in package examples. 18 | #' @export 19 | #' @examples 20 | #' \dontrun{ 21 | #' res <- trace_package ("rematch") 22 | #' res <- trace_package (pkg_dir = "////") 23 | #' } 24 | trace_package <- function (package = NULL, 25 | pkg_dir = NULL, 26 | functions = NULL, 27 | types = c ("examples", "tests"), 28 | trace_lists = FALSE) { 29 | 30 | types <- match.arg (types, c ("examples", "tests"), 31 | several.ok = TRUE 32 | ) 33 | set_trace_list_option (trace_lists) 34 | 35 | package <- assert_trace_package_inputs (package, types, pkg_dir) 36 | pkg_was_attached <- any (grepl (paste0 ("package:", package), search ())) 37 | if (pkg_was_attached) { 38 | on.exit (tryCatch ( 39 | attachNamespace (package), 40 | error = function (e) NULL 41 | )) 42 | } 43 | 44 | # -------- PRE_INSTALLATION 45 | lib_paths <- .libPaths () 46 | lib_path <- pre_install (package, pkg_dir, quiet = FALSE) 47 | # Flag whether package was able to be pre-installed to local tempdir: 48 | pre_installed <- !lib_path %in% lib_paths 49 | if (pre_installed || is.null (pkg_dir)) { 50 | pkg_dir <- file.path (lib_path, package) 51 | } 52 | 53 | # -------- TRACING 54 | trace_fns <- 55 | inject_pkg_trace_fns (functions, package, trace_lists = trace_lists) 56 | 57 | traces_ex <- NULL 58 | 59 | if ("examples" %in% types) { 60 | trace_names <- trace_package_exs (package, functions) 61 | traces_ex <- list_traces () 62 | add_trace_source (traces_ex, "examples") 63 | } 64 | if ("tests" %in% types) { 65 | if (testthat_is_parallel (pkg_dir) && !pre_installed) { 66 | message ( 67 | "Tests run with testthat v3 in parallel can ", 68 | "not be traced, and will not be run." 69 | ) 70 | test_traces <- NULL 71 | } else { 72 | test_traces <- trace_package_tests (package, pkg_dir, pre_installed) 73 | traces_test <- list_traces () 74 | if (!is.null (traces_ex)) { 75 | traces_test <- traces_test [which (!traces_test %in% traces_ex)] 76 | } 77 | add_trace_source (traces_test, "tests") 78 | } 79 | } 80 | 81 | traces <- load_traces (files = TRUE, quiet = TRUE) 82 | 83 | if (!is.null (traces)) { 84 | 85 | traces <- add_pkg_trace_sources ( 86 | traces, 87 | trace_names, 88 | test_traces, 89 | types 90 | ) 91 | } 92 | 93 | uninject_pkg_trace_fns (trace_fns, package) 94 | 95 | tryCatch ( 96 | unloadNamespace (package), 97 | error = function (e) NULL 98 | ) 99 | check <- reload_pkg (package, lib_path) 100 | 101 | return (traces) 102 | } 103 | 104 | assert_trace_package_inputs <- function (package = NULL, 105 | types = c ("examples", "tests"), 106 | pkg_dir = NULL) { 107 | 108 | if (!is.null (pkg_dir)) { 109 | 110 | checkmate::assert_character (pkg_dir) 111 | checkmate::assert_scalar (pkg_dir) 112 | checkmate::assert_directory_exists (pkg_dir) 113 | 114 | if (is.null (package)) { 115 | package <- pkg_name_from_desc (pkg_dir) 116 | } 117 | } 118 | 119 | checkmate::assert_character (package) 120 | checkmate::assert_scalar (package) 121 | 122 | return (package) 123 | } 124 | 125 | inject_pkg_trace_fns <- function (functions, package, trace_lists = FALSE) { 126 | 127 | clear_traces () 128 | 129 | trace_fns <- functions 130 | p <- paste0 ("package:", package) 131 | if (is.null (trace_fns)) { 132 | trace_fns <- ls (p, all.names = TRUE) 133 | } 134 | 135 | pkg_env <- as.environment (p) 136 | for (fnm in trace_fns) { 137 | f <- get (fnm, envir = pkg_env) 138 | if (is.function (f)) { 139 | inject_tracer (f, trace_lists = trace_lists) 140 | } 141 | } 142 | 143 | return (trace_fns) 144 | } 145 | 146 | uninject_pkg_trace_fns <- function (trace_fns, package) { 147 | 148 | p <- paste0 ("package:", package) 149 | pkg_env <- as.environment (p) 150 | 151 | for (f in trace_fns) { 152 | f <- get (f, envir = pkg_env) 153 | if (is.function (f)) { 154 | uninject_tracer (f) 155 | } 156 | } 157 | 158 | # Envvar to enable traces to remain so that package can be used by 159 | # 'autotest', through loading traces after calling 'trace_package()' 160 | if (!Sys.getenv ("TYPETRACER_LEAVE_TRACES") == "true") { 161 | clear_traces () 162 | } 163 | } 164 | 165 | #' Trace all examples from a package 166 | #' 167 | #' @param package Name of package to be traced. 168 | #' @param functions Optional list of names of functions to be traced. 169 | #' @return 'data.frame' of '.Rd' file names and trace names. 170 | #' @noRd 171 | trace_package_exs <- function (package, functions = NULL) { 172 | 173 | exs <- get_pkg_examples (package) 174 | 175 | if (is.null (exs)) { 176 | return () 177 | } 178 | 179 | if (!is.null (functions)) { 180 | 181 | # Reduce examples down to only those which call specified functions 182 | has_functions <- vapply (exs, function (i) { 183 | p <- utils::getParseData (parse (text = i, keep.source = TRUE)) 184 | fn_names <- p$text [p$token == "SYMBOL_FUNCTION_CALL"] 185 | any (functions %in% fn_names) 186 | }, logical (1L)) 187 | 188 | exs <- exs [which (has_functions)] 189 | } 190 | 191 | if (length (exs) == 0L) { 192 | return (TRUE) 193 | } 194 | 195 | # suppress any plot output 196 | dev <- options ()$"device" 197 | options (device = NULL) 198 | 199 | # get current traces 200 | td <- get_typetrace_dir () 201 | trace_list_old <- list.files ( 202 | td, 203 | pattern = "^typetrace\\_", 204 | full.names = TRUE 205 | ) 206 | 207 | # Evaluate each example separately, to avoid aborting evaluation process 208 | # when only one example errors 209 | traces <- lapply (exs, function (ex) { 210 | 211 | suppressWarnings ( # nolint - variable assigned but not used 212 | tryCatch ( # nolint - variable assigned but not used 213 | eval (parse (text = ex, keep.source = TRUE)), 214 | error = function (e) NULL 215 | ) 216 | ) 217 | trace_list_new <- list.files ( 218 | td, 219 | pattern = "^typetrace\\_", 220 | full.names = TRUE 221 | ) 222 | trace_list_added <- 223 | trace_list_new [which (!trace_list_new %in% trace_list_old)] 224 | trace_list_old <- trace_list_new 225 | 226 | return (trace_list_added) 227 | }) 228 | 229 | options (device = dev) 230 | 231 | traces <- lapply (traces, function (i) data.frame (trace_name = i)) 232 | traces <- do.call (rbind, traces) # inherits .Rd name as row name 233 | traces$rd_name <- gsub ("\\.[0-9]+$", "", rownames (traces)) 234 | rownames (traces) <- NULL 235 | traces <- traces [, c ("rd_name", "trace_name")] 236 | 237 | return (traces) 238 | } 239 | 240 | # adapted from tools::testInstalledPackages 241 | trace_package_tests <- function (package, pkg_dir = NULL, 242 | pre_installed = FALSE) { 243 | 244 | requireNamespace ("testthat") 245 | 246 | if (is.null (pkg_dir)) { 247 | return (list ()) # nocov 248 | } 249 | if (pre_installed) { 250 | insert_counters_in_tests (pkg_dir) 251 | if (testthat_is_parallel (pkg_dir)) { 252 | rm_testthat_parallel (pkg_dir) 253 | } 254 | } 255 | test_dir <- file.path (pkg_dir, "tests") 256 | 257 | if (!dir.exists (test_dir)) { 258 | return (list ()) # test_check returns list 259 | } 260 | 261 | out <- withr::with_dir ( 262 | test_dir, 263 | testthat::test_package (package, reporter = testthat::ListReporter) 264 | ) 265 | 266 | # `read_test_trace_numbers()` in @/load-traces.R 267 | test_trace_numbers <- read_test_trace_numbers (pkg_dir) 268 | 269 | if (nrow (test_trace_numbers) > 0L) { 270 | 271 | test_str <- lapply (out, function (i) c (i$file, i$test)) 272 | test_str <- data.frame (do.call (rbind, test_str)) 273 | names (test_str) <- c ("file", "test_name") 274 | test_str$file <- file.path ( 275 | testthat::test_path (), 276 | test_str$file 277 | ) 278 | test_str$test <- gsub ("\\s+", "_", test_str$test_name) 279 | index <- match (test_trace_numbers$test, test_str$test) 280 | test_trace_numbers$test_name <- test_str$test_name [index] 281 | test_trace_numbers$test_file <- test_str$file [index] 282 | test_trace_numbers$test <- NULL 283 | test_trace_numbers <- 284 | test_trace_numbers [, c ("test_file", "test_name", "trace_number")] 285 | rownames (test_trace_numbers) <- NULL 286 | } 287 | 288 | return (test_trace_numbers) 289 | } 290 | 291 | get_pkg_examples <- function (package) { 292 | 293 | rd <- tools::Rd_db (package) 294 | 295 | if (length (rd) == 0L && any (grepl (package, search ()))) { 296 | # local load via devtools 297 | # This can't be tested because 'package' is in Suggests, which means it 298 | # has `Rd_db` entries. 299 | # nocov start 300 | e <- as.environment (paste0 ("package:", package)) 301 | path <- attr (e, "path") 302 | 303 | if (is.null (path)) { 304 | return (NULL) 305 | } 306 | if (!dir.exists (path)) { 307 | return (NULL) 308 | } 309 | 310 | man_files <- list.files ( 311 | file.path (path, "man"), 312 | full.names = TRUE, 313 | pattern = "\\.Rd$" 314 | ) 315 | rd <- lapply (man_files, tools::parse_Rd) 316 | # nocov end 317 | } 318 | 319 | has_exs <- vapply (rd, function (i) { 320 | out <- vapply ( 321 | i, function (j) { 322 | any (attr (j, "Rd_tag") == "\\examples") 323 | }, 324 | logical (1) 325 | ) 326 | any (out) 327 | }, logical (1)) 328 | 329 | exs <- lapply (rd [which (has_exs)], function (i) { 330 | f <- tempfile () 331 | tools::Rd2ex (i, out = f) 332 | out <- brio::read_lines (f) 333 | file.remove (f) 334 | return (out) 335 | }) 336 | 337 | nm_ptn <- "^\\#\\#\\#\\sName\\:\\s" 338 | nms <- vapply ( 339 | exs, function (i) { 340 | gsub ( 341 | nm_ptn, "", 342 | grep (nm_ptn, i, value = TRUE) [1] 343 | ) 344 | }, 345 | character (1) 346 | ) 347 | names (exs) <- nms 348 | 349 | return (exs) 350 | } 351 | 352 | add_pkg_trace_sources <- function (traces, trace_names, test_traces, types) { 353 | 354 | traces <- tibble::add_column ( 355 | traces, 356 | source_file_name = NA, 357 | .after = "trace_source" 358 | ) 359 | 360 | if ("examples" %in% types) { 361 | # join rd_name from trace_names: 362 | trace_names$rd_name <- paste0 ("man/", trace_names$rd_name, ".Rd") 363 | index <- match (traces$trace_name, trace_names$trace) 364 | traces$source_file_name <- trace_names$rd_name [index] 365 | } 366 | if ("tests" %in% types && length (test_traces) > 0L) { 367 | traces <- join_test_trace_data (traces, test_traces) 368 | } 369 | traces$trace_name <- traces$trace_source <- NULL 370 | 371 | return (traces) 372 | } 373 | 374 | join_test_trace_data <- function (traces, test_traces) { 375 | 376 | if (!"trace_number" %in% names (test_traces) || nrow (test_traces) == 0L) { 377 | return (traces) 378 | } 379 | 380 | test_tr_start <- test_traces$trace_number 381 | test_tr_end <- c ( 382 | test_traces$trace_number [-1] - 1, 383 | max (traces$trace_number, na.rm = TRUE) 384 | ) 385 | if (any (is.na (test_tr_start)) || any (is.na (test_tr_end))) { 386 | return (traces) 387 | } 388 | 389 | tr_start1 <- min (test_tr_start, na.rm = TRUE) 390 | tr_end1 <- max (test_tr_end, na.rm = TRUE) 391 | if (length (tr_start1) == 0L || length (tr_end1) == 0L) { 392 | return (traces) 393 | } 394 | if (is.na (tr_start1) || is.na (tr_end1)) { 395 | return (traces) 396 | } 397 | 398 | test_names <- rep ( 399 | test_traces$test_name, 400 | times = test_tr_end - test_tr_start + 1 401 | ) 402 | test_files <- rep ( 403 | test_traces$test_file, 404 | times = test_tr_end - test_tr_start + 1 405 | ) 406 | test_tr_index <- seq (tr_start1, tr_end1) 407 | traces_index <- which (traces$trace_number %in% test_tr_index) 408 | index <- match (traces$trace_number [traces_index], test_tr_index) 409 | traces$source_file_name [traces_index] <- 410 | paste0 (test_files, "/", test_names) [index] 411 | 412 | return (traces) 413 | } 414 | 415 | add_trace_source <- function (traces, trace_source) { 416 | 417 | checkmate::assert_character (trace_source) 418 | 419 | for (i in traces) { 420 | tr <- readRDS (i) 421 | tr$trace_source <- trace_source 422 | saveRDS (tr, i) 423 | } 424 | } 425 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | [![R-CMD-check](https://github.com/mpadge/typetracer/workflows/R-CMD-check/badge.svg)](https://github.com/mpadge/typetracer/actions) 4 | [![codecov](https://codecov.io/gh/mpadge/typetracer/branch/main/graph/badge.svg)](https://app.codecov.io/gh/mpadge/typetracer) 5 | [![CRAN\_Status\_Badge](https://www.r-pkg.org/badges/version/typetracer)](https://cran.r-project.org/package=typetracer/) 6 | [![CRAN 7 | Downloads](https://cranlogs.r-pkg.org/badges/grand-total/typetracer?color=orange)](https://cran.r-project.org/package=typetracer) 8 | 9 | 10 | # typetracer 11 | 12 | `typetracer` is an R package to trace function parameter types. The R 13 | language includes [a set of defined 14 | types](https://cran.r-project.org/doc/manuals/r-release/R-lang.html#Basic-types), 15 | but the language itself is [“absurdly 16 | dynamic”](https://doi.org/10.1145/3340670.3342426)[1], and lacks any way 17 | to specify which types are expected by any expression. The `typetracer` 18 | package enables code to be traced to extract detailed information on the 19 | properties of parameters passed to R functions. `typetracer` can trace 20 | individual functions or entire packages, as demonstrated below. 21 | 22 | ## Installation 23 | 24 | The stable version of the package can be installed with one of the 25 | following commands: 26 | 27 | # Stable version from CRAN: 28 | install.packages ("typetracer") 29 | # Current development version from r-universe: 30 | install.packages ( 31 | "typetracer", 32 | repos = c ("https://mpadge.r-universe.dev", "https://cloud.r-project.org") 33 | ) 34 | 35 | Alternatively, for those who prefer to use other source code platforms, 36 | the package can also be installed by running any one of the following 37 | lines: 38 | 39 | remotes::install_git ("https://git.sr.ht/~mpadge/typetracer") 40 | remotes::install_git ("https://codeberg.org/mpadge/typetracer") 41 | remotes::install_bitbucket ("mpadge/typetracer") 42 | remotes::install_gitlab ("mpadge/typetracer") 43 | 44 | The package can then loaded for use by calling `library`: 45 | 46 | library (typetracer) 47 | 48 | ## Example \#1 - A Single Function 49 | 50 | `typetracer` works by “injecting” tracing code into the body of a 51 | function using [the `inject_tracer()` 52 | function](https://mpadge.github.io/typetracer/reference/inject_tracer.html). 53 | Locally-defined functions can be traced by simply passing the functions 54 | directly to `inject_tracer()`. The following example includes four 55 | parameters, including `...` to allow passing of additional and entirely 56 | arbitrary parameter types and values. 57 | 58 | f <- function (x, y, z, ...) { 59 | x * x + y * y 60 | } 61 | inject_tracer (f) 62 | 63 | After injecting the `typetracer` code, calls to the function, `f`, will 64 | “trace” each parameter of the function, by capturing both unevaluated 65 | and evaluated representations at the point at which the function is 66 | first called. These values can be accessed with [the `load_traces` 67 | function](https://mpadge.github.io/typetracer/reference/load_traces.html), 68 | which returns a `data.frame` object (in [`tibble` 69 | format](https://tibble.tidyverse.org)) with one row for each parameter 70 | from each function call. 71 | 72 | val <- f ( 73 | x = 1:2, 74 | y = 3:4 + 0., 75 | a = "blah", 76 | b = list (a = 1, b = "b"), 77 | f = a ~ b 78 | ) 79 | x <- load_traces () 80 | x 81 | 82 | ## # A tibble: 7 × 12 83 | ## trace_number fn_name fn_call_hash par_name class typeof mode storage_mode 84 | ## > 85 | ## 1 0 f yXYbicZQ x integ… nume… integer 86 | ## 2 0 f yXYbicZQ y double nume… double 87 | ## 3 0 f yXYbicZQ z NULL NULL NULL 88 | ## 4 0 f yXYbicZQ ... NULL NULL NULL 89 | ## 5 0 f yXYbicZQ a chara… char… character 90 | ## 6 0 f yXYbicZQ b list list list 91 | ## 7 0 f yXYbicZQ f langu… call language 92 | ## # ℹ 4 more variables: length , formal , uneval >, 93 | ## # eval > 94 | 95 | Each row of the result returned by `load_traces()` represents one 96 | parameter passed to one function call. Each function call itself 97 | represents a single “trace” as enumerated by the `trace_number` column, 98 | and also uniquely identified by an arbitrary function call hash 99 | (`fn_call_hash`). The remaining columns of the trace data define the 100 | properties of each parameter, `p`, as: 101 | 102 | 1. `par_name`: Name of parameter. 103 | 2. `class`: List of classes of parameter. 104 | 3. `typeof`: Result of `typeof(p)`. 105 | 4. `mode`: Result of `mode(p)`. 106 | 5. `storage_mode`: Result of `storage.mode(p)`. 107 | 6. `length`: Result of `length(p)`. 108 | 7. `formal`: Result of `formals(f)[["p"]]`, as named list item with 109 | default value where specified. 110 | 8. `uneval`: Parameters as passed to the function call prior to 111 | evaluation within function environment. 112 | 9. `eval`: Evaluated version of parameter. 113 | 114 | The results above show that all parameters of the function, `f()`, were 115 | successfully traced, including the additional parameters, `a`, `b`, and 116 | `f`, passed as part of the `...` argument. Such additional parameters 117 | can be identified through having a `"formal"` entry of `NULL`, 118 | indicating that they are not part of the formal arguments to the 119 | function. 120 | 121 | That result can also be used to demonstrate the difference between the 122 | unevaluated and evaluated forms of parameters: 123 | 124 | x$uneval [x$par_name %in% c ("b", "f")] 125 | 126 | ## $b 127 | ## [1] "list(a = 1, b = \"b\")" 128 | ## 129 | ## $f 130 | ## [1] "a ~ b" 131 | 132 | x$eval [x$par_name %in% c ("b", "f")] 133 | 134 | ## $b 135 | ## $b$a 136 | ## [1] 1 137 | ## 138 | ## $b$b 139 | ## [1] "b" 140 | ## 141 | ## 142 | ## $f 143 | ## a ~ b 144 | ## 145 | 146 | Unevaluated parameters are generally converted to equivalent character 147 | expressions. 148 | 149 | The `typeof`, `mode`, and `storage_mode` columns are similar, yet may 150 | hold distinct information for certain types of parameters. The 151 | conditions under which these values differ are complex, and depend among 152 | other things on the version of R itself. `typeof` alone should generally 153 | provide sufficient information, although [this list of 154 | differences](https://stackoverflow.com/a/37469255) may provide further 155 | insight into whether the other columns may provide useful additional 156 | information. 157 | 158 | Traces themselves are saved in the temporary directory of the current R 159 | session, and [the `load_traces()` 160 | function](https://mpadge.github.io/typetracer/reference/load_traces.html) 161 | simply loads all traces created in that session. [The function 162 | `clear_traces()`](https://mpadge.github.io/typetracer/reference/clear_traces.html) 163 | removes all traces, so that 164 | [`load_traces()`](https://mpadge.github.io/typetracer/reference/load_traces.html) 165 | will only load new traces produced after that time. 166 | 167 | ### Uninjecting Traces 168 | 169 | It is important after applying [the `inject_tracer()` 170 | function](https://mpadge.github.io/typetracer/reference/inject_tracer.html) 171 | to restore the functions back to their original form through calling 172 | [the obverse `uninject_tracer()` 173 | function](https://mpadge.github.io/typetracer/reference/uninject_tracer.html). 174 | For the function, `r`, above, this simply requires, 175 | 176 | uninject_tracer (f) 177 | 178 | ## [1] TRUE 179 | 180 | All traces can also be removed with this functions: 181 | 182 | clear_traces () 183 | 184 | Because `typetracer` modifies the internal code of functions as defined 185 | within a current R session, we strongly recommend restarting your R 186 | session after using `typetracer`, to ensure expected function behaviour 187 | is restored. 188 | 189 | ## Example \#2 - Recursion into lists 190 | 191 | R has extensive support for list structures, notably including all 192 | `data.frame`-like objects in which each column is actually a list item. 193 | `typetracer` also offers the ability to recurse into the list structures 194 | of individual parameters, to recursively trace the properties of each 195 | list item. To do this, the traces themselves have to be injected with 196 | the additional parameter, `trace_lists = TRUE`. 197 | 198 | The final call above included an additional parameter passed as a list. 199 | The following code re-injects a tracer with the ability to traverse into 200 | list structures: 201 | 202 | inject_tracer (f, trace_lists = TRUE) 203 | val <- f ( 204 | x = 1:2, 205 | y = 3:4 + 0., 206 | a = "blah", 207 | b = list (a = 1, b = "b"), 208 | f = a ~ b 209 | ) 210 | x_lists <- load_traces () 211 | print (x_lists) 212 | 213 | ## # A tibble: 9 × 12 214 | ## trace_number fn_name fn_call_hash par_name class typeof mode storage_mode 215 | ## > 216 | ## 1 0 f DPfsArXY x integ… nume… integer 217 | ## 2 0 f DPfsArXY y double nume… double 218 | ## 3 0 f DPfsArXY z NULL NULL NULL 219 | ## 4 0 f DPfsArXY ... NULL NULL NULL 220 | ## 5 0 f DPfsArXY a chara… char… character 221 | ## 6 0 f DPfsArXY b list list list 222 | ## 7 0 f DPfsArXY f langu… call language 223 | ## 8 0 f DPfsArXY b$a double nume… double 224 | ## 9 0 f DPfsArXY b$b chara… char… character 225 | ## # ℹ 4 more variables: length , formal , uneval >, 226 | ## # eval > 227 | 228 | And that result now has 9 rows, or 2 more than the previous example, 229 | reflecting the two items passed as a `list` to the parameter, `b`. 230 | List-parameter items are identifiable in typetracer output through the 231 | “dollar-notation” in the `par_name` field. The final two values in the 232 | above table are `b$a` and `b$b`, representing the two elements of the 233 | list passed as the parameter, `b`. 234 | 235 | ## Example \#3 - Tracing a Package 236 | 237 | This section presents a more complex example tracing all function calls 238 | from [the `rematch` package](https://github.com/MangoTheCat/rematch), 239 | chosen because it has less code than almost any other package on CRAN. 240 | The following single line traces function calls in all examples for the 241 | nominated package. [The `trace_package()` 242 | function](https://mpadge.github.io/typetracer/reference/trace_package.html) 243 | automatically injects tracing code into every function within the 244 | package, so there is no need to explicitly call [the `inject_tracer()` 245 | function](https://mpadge.github.io/typetracer/reference/inject_tracer). 246 | 247 | (This function also includes a `trace_lists` parameter, as demonstrated 248 | above, with a default of `FALSE` to not recurse into tracing list 249 | structures.) 250 | 251 | res <- trace_package ("rematch") 252 | res 253 | 254 | ## # A tibble: 6 × 14 255 | ## trace_number source_file_name fn_name fn_call_hash call_env par_name class 256 | ## 257 | ## 1 0 man/re_match.Rd re_match wNDFeOta pattern 258 | ## 2 0 man/re_match.Rd re_match wNDFeOta text 259 | ## 3 0 man/re_match.Rd re_match wNDFeOta ... 260 | ## 4 1 man/re_match.Rd re_match oEujlJYt pattern 261 | ## 5 1 man/re_match.Rd re_match oEujlJYt text 262 | ## 6 1 man/re_match.Rd re_match oEujlJYt ... 263 | ## # ℹ 7 more variables: typeof , mode , storage_mode , 264 | ## # length , formal , uneval >, eval > 265 | 266 | The `data.frame` returned by the `trace_package()` function includes 267 | three more columns than the result directly returned by `load_traces()`. 268 | These columns identify the sources and calling environments of each 269 | function call being traces. The “call\_env” column identifies the 270 | calling environment which generated each trace, while 271 | “source\_file\_name” identifies the file. 272 | 273 | unique (res$call_env) 274 | 275 | ## [1] NA 276 | 277 | unique (res$source_file_name) 278 | 279 | ## [1] "man/re_match.Rd" 280 | 281 | Although the “call\_env” columns contains no useful information for that 282 | package, it includes information on the full environment in which each 283 | function was called. These “environments” include such things as 284 | `tryCatch` calls expected to generate errors, or the various `expect_` 285 | functions of the [“testthat” package](https://testthat.r-lib.org/). The 286 | above case of racing an installed package generally only extracts traces 287 | from example code, as documented in help, or `.Rd`, files. These are 288 | identified by the “rd\_” prefix on the “source\_file\_name”, with the 289 | `rematch` package including only one `.Rd` file. 290 | 291 | [The `trace_package()` 292 | function](https://mpadge.github.io/typetracer/reference/trace_package.html) 293 | also includes an additional parameter, `types`, which defaults to 294 | `c ("examples", "tests")`, so that traces are also by default generated 295 | for all tests included with local source packages (or for packages 296 | installed to include test files). The “source” column for test files 297 | identifies the names of each test, prefixed with “test\_”. 298 | 299 | The other two additional columns of “trace\_file” and “call\_env” 300 | respectively specify the source file and calling environment of each 301 | trace. These will generally only retain information from test files, in 302 | which case the source file will generally be the file name identified in 303 | the “source” column, and “call\_env” will specify the environment from 304 | which that function call originated. Environments may, for example, 305 | include various types of expectation from the [“testthat” 306 | package](https://testthat.r-lib.org). These calling environments are 307 | useful to discern whether, for example, a call was made with an 308 | expectation that it should error. 309 | 310 | ### Example \#3(a) - Specifying Functions to Trace 311 | 312 | [The `trace_package()` 313 | function](https://mpadge.github.io/typetracer/reference/trace_package.html) 314 | also accepts an argument, `functions`, specifying which functions from a 315 | package should be traced. For example, 316 | 317 | x <- trace_package ("stats", functions = "sd") 318 | 319 | ## # A tibble: 2 × 16 320 | ## trace_number trace_source fn_name fn_call_hash trace_file call_env par_name 321 | ## 322 | ## 1 0 examples sd EzasZOKV x 323 | ## 2 0 examples sd EzasZOKV na.rm 324 | ## # ℹ 9 more variables: class >, typeof , mode , 325 | ## # storage_mode , length , formal >, uneval >, 326 | ## # eval >, source 327 | 328 | ## Prior Art 329 | 330 | This package extends on concepts previously developed in other R 331 | packages, notably including: 332 | 333 | - The [`typed` package](https://github.com/moodymudskipper/typed) by 334 | [@moodymudskipper](https://github.com/moodymudskipper) 335 | - The [`contractr` package](https://github.com/PRL-PRG/contractr) by 336 | [@aviralg](https://github.com/aviralg) & 337 | [@fikovnik](https://github.com/fikovnik) 338 | 339 | Plus work explained in detail in this footnote:
340 | 341 | [1] Alexi Turcotte & Jan Vitek (2019), *Towards a Type System for R*, 342 | ICOOOLPS ’19: Proceedings of the 14th Workshop on Implementation, 343 | Compilation, Optimization of Object-Oriented Languages, Programs and 344 | Systems. Article No. 4, Pages 1–5, 345 | 346 | --------------------------------------------------------------------------------