diff --git a/DESCRIPTION b/DESCRIPTION index 6c9e580..08153f0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,6 +37,7 @@ BugReports: Imports: cli, desc, + evaluate, options, S7, tools, @@ -48,6 +49,7 @@ Imports: Suggests: covr, rcmdcheck, + htmltools, igraph, knitr, rmarkdown, @@ -98,6 +100,7 @@ Collate: 'options.R' 'package.R' 'utils_backports.R' + 'utils_evaluate.R' 'utils_rand.R' 'utils_rstudio.R' 'utils_tmp.R' diff --git a/NAMESPACE b/NAMESPACE index 4318c54..1189d36 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ S3method(".DollarNames","val.meter::pkg") S3method("[","val.meter::pkg") S3method("[[","val.meter::pkg") S3method(as.data.frame,list_of_pkg) +S3method(format,evaluate_evaluation) S3method(format,val_meter_error) S3method(print,val_meter_error) export(class_metric_data_frame) @@ -56,6 +57,7 @@ importFrom(tools,getVignetteInfo) importFrom(tools,toRd) importFrom(utils,.DollarNames) importFrom(utils,available.packages) +importFrom(utils,capture.output) importFrom(utils,download.packages) importFrom(utils,getCRANmirrors) importFrom(utils,head) diff --git a/R/class_pkg.R b/R/class_pkg.R index f5d7658..09a9546 100644 --- a/R/class_pkg.R +++ b/R/class_pkg.R @@ -16,6 +16,11 @@ pkg <- class_pkg <- new_class( # necessary data dependencies to be evaluated. data = class_environment, + # logs (not user-facing) + # A mutable environment, stores output logs captured using the `evaluate` + # package. Should contain an entry for each value in `@data`. + logs = class_environment, + #' @param resource [`resource`] (often a [`multi_resource`]), providing the #' resources to be used for deriving packages data. If a #' [`multi_resource`], the order of resources determines the precedence of @@ -62,6 +67,7 @@ pkg <- class_pkg <- new_class( new_object( .parent = S7::S7_object(), data = new.env(parent = emptyenv()), + logs = new.env(parent = emptyenv()), metrics = list(), resource = resource, permissions = policy@permissions @@ -69,6 +75,17 @@ pkg <- class_pkg <- new_class( } ) +method(convert, list(class_character, class_pkg)) <- + function(from, to, ...) { + if (endsWith(tolower(from), ".rds")) { + convert(readRDS(from), class_pkg) + } else if (grepl("\\bPackage:", from[[1L]])) { + pkg_from_dcf(from, ...) + } else { + pkg(from, ...) + } + } + #' Generate Random Package(s) #' #' Create a package object to simulate metric derivation. When generating a @@ -179,6 +196,8 @@ random_repo <- function(..., path = tempfile("repo")) { #' @param x [`pkg`] object to derive data for #' @param name `character(1L)` field name for the data to derive #' @param ... Additional arguments unused +#' @param logs `logical(1L)` flag indicating whether console output should be +#' captured during execution. #' @param .raise `logical(1L)` flag indicating whether errors should be raised #' or captured. This flag is not intended to be set directly, it is exposed #' so that recursive calls can raise lower-level errors while capturing them @@ -189,7 +208,13 @@ random_repo <- function(..., path = tempfile("repo")) { #' #' @keywords internal #' @include utils_err.R -get_pkg_data <- function(x, name, ..., .raise = .state$raise) { +get_pkg_data <- function( + x, + name, + ..., + logs = opt("logs"), + .raise = .state$raise +) { # RStudio, when trying to produce completions,will try to evaluate our lazy # list elements. Intercept those calls and return only the existing values. if (is_rs_rpc_get_completions_call()) { @@ -213,7 +238,19 @@ get_pkg_data <- function(x, name, ..., .raise = .state$raise) { assert_permissions(required_permissions, x@permissions) assert_suggests(required_suggests) - data <- pkg_data_derive(pkg = x, field = name, ...) + if (logs) { + capture <- capture_pkg_data_derive(pkg = x, field = name, ...) + data <- capture$data + x@logs[[name]] <- capture$logs + + # re-throw error after storing logs if one was produced + if (inherits(data, "error")) { + stop(data) + } + } else { + data <- pkg_data_derive(pkg = x, field = name, ...) + } + if (!identical(info@data_class, class_any)) { data <- convert(data, info@data_class) } @@ -382,31 +419,59 @@ as.data.frame.list_of_pkg <- function(x, ...) { } #' @include utils_dcf.R -method(from_dcf, list(class_character, class_pkg)) <- - function(x, to, ...) { - dcf <- from_dcf(x, class_any) +method(convert, list(class_list, class_pkg)) <- + function(from, to, ...) { resource <- unknown_resource( - package = dcf[[1, "Package"]], - version = dcf[[1, "Version"]], - md5 = if ("MD5sum" %in% colnames(dcf)) { - dcf[[1, "MD5sum"]] - } else { - NA_character_ - } + package = from$name %||% from$Package, + version = from$version %||% from$Version, + md5 = from$MD5sum %||% NA_character_ ) data <- new.env(parent = emptyenv()) + for (name in names(from)) { + # recover gracefully from unknown fieldnames + info <- tryCatch(pkg_data_info(name), error = function(e) NULL) + if (is.null(info)) { + next + } + + data[[name]] <- metric_coerce(from[[name]], info@data_class) + } + + pkg <- pkg(resource) + pkg@data <- data + + pkg + } + +#' @include utils_dcf.R +method(from_dcf, list(class_character, class_pkg)) <- + function(x, to, ...) { + dcf <- from_dcf(x, class_any) + + data <- list() + data$name <- dcf[[1, "Package"]] + data$version <- dcf[[1, "Version"]] + data$md5 <- if ("MD5sum" %in% colnames(dcf)) { + dcf[[1, "MD5sum"]] + } else { + NA_character_ + } + prefix <- "Metric/" for (name in colnames(dcf)[startsWith(colnames(dcf), prefix)]) { field <- sub(prefix, "", name) - info <- pkg_data_info(field) + + # recover gracefully from unknown fieldnames + info <- tryCatch(pkg_data_info(field), error = function(e) NULL) + if (is.null(info)) { + next + } + val <- dcf[[1, name]] val <- metric_coerce(val, info@data_class) data[[field]] <- val } - pkg <- pkg(resource) - pkg@data <- data - - pkg + convert(data, class_pkg) } diff --git a/R/class_resource.R b/R/class_resource.R index 55effd7..c6333d2 100644 --- a/R/class_resource.R +++ b/R/class_resource.R @@ -284,9 +284,11 @@ method(convert, list(class_character, class_resource)) <- add_resource <- function(resource) { resource_type_name <- class_desc(S7::S7_class(resource)) idx <- match(resource_type_name, all_resource_type_names) + if (is.na(idx) || !is.null(resources[[idx]])) { return() } + resources[[idx]] <<- resource idx } @@ -317,8 +319,8 @@ method(convert, list(class_character, class_resource)) <- # iterate over other allowed resource types for (to_idx in seq_along(all_resource_types)) { # that are not yet populated with a known resource - to_resource <- resources[[to_idx]] - if (!is.null(to_resource)) { + existing_resource <- resources[[to_idx]] + if (!is.null(existing_resource)) { next } @@ -336,7 +338,7 @@ method(convert, list(class_character, class_resource)) <- # special handling for error conditions used to test discovery in tests if (inherits(result, "test_suite_signal")) { stop(result) - } else if (inherits(result, "error")) { + } else if (is.null(result) || inherits(result, "error")) { next } @@ -589,7 +591,9 @@ method(convert, list(class_local_source_resource, class_install_resource)) <- method(convert, list(class_resource, class_unknown_resource)) <- function(from, to, ...) { - set_props(to(), props(from, names(class_unknown_resource@properties))) + out <- to() + props(out) <- props(from, prop_names(out)) + out } method(to_dcf, class_resource) <- function(x, ...) { diff --git a/R/data_coverage.R b/R/data_coverage.R index 9911525..09baa48 100644 --- a/R/data_coverage.R +++ b/R/data_coverage.R @@ -9,8 +9,10 @@ impl_data( impl_data( "covr_coverage", for_resource = local_source_resource, - function(pkg, resource, field, ..., quiet = opt("quiet")) { - covr::package_coverage(resource@path, type = "tests", quiet = quiet) + function(pkg, resource, field, ...) { + # package installs use `system2()` whose output cannot be captured by sink() + # so we just execute quietly + covr::package_coverage(resource@path, type = "tests", quiet = TRUE) } ) @@ -23,7 +25,7 @@ impl_data( "The fraction of expressions of package code that are evaluated by any ", "test" ), - function(pkg, resource, field, ..., quiet = opt("quiet")) { + function(pkg, resource, field, ...) { tally <- covr::tally_coverage(pkg$covr_coverage, by = "expression") mean(tally$value > 0) } @@ -45,7 +47,7 @@ impl_data( description = paste0( "The fraction of lines of package code that are evaluated by any test" ), - function(pkg, resource, field, ..., quiet = opt("quiet")) { + function(pkg, resource, field, ...) { tally <- covr::tally_coverage(pkg$covr_coverage, by = "line") mean(tally$value > 0) } diff --git a/R/data_desc.R b/R/data_desc.R index d060a7f..874c175 100644 --- a/R/data_desc.R +++ b/R/data_desc.R @@ -14,6 +14,7 @@ impl_data( "name", title = "Package name", class = class_character, + for_resource = new_union(source_code_resource, install_resource), function(pkg, resource, field, ...) { pkg$desc$get_field("Package") } @@ -21,7 +22,7 @@ impl_data( impl_data( "name", - for_resource = repo_resource, + for_resource = class_resource, function(pkg, resource, field, ...) { resource@package } @@ -30,6 +31,7 @@ impl_data( impl_data( "version", class = class_character, + for_resource = new_union(source_code_resource, install_resource), function(pkg, resource, field, ...) { pkg$desc$get_field("Version") } @@ -37,12 +39,29 @@ impl_data( impl_data( "version", - for_resource = repo_resource, + for_resource = class_resource, function(pkg, resource, field, ...) { resource@version } ) +impl_data( + "md5", + class = class_character, + for_resource = new_union(source_code_resource, install_resource), + function(pkg, resource, field, ...) { + pkg$desc$get_field("MD5sum") + } +) + +impl_data( + "md5", + for_resource = class_resource, + function(pkg, resource, field, ...) { + resource@md5 + } +) + impl_data( "dependency_count", class = class_integer, diff --git a/R/data_r_cmd_check.R b/R/data_r_cmd_check.R index 748b7cf..8a799ee 100644 --- a/R/data_r_cmd_check.R +++ b/R/data_r_cmd_check.R @@ -14,26 +14,12 @@ impl_data( local_source_resource, source_archive_resource ), - function(pkg, resource, field, ..., quiet = opt("quiet")) { - # suppress messages to avoid stdout output from subprocess - # (eg warnings about latex availability not suppressed by rcmdcheck) - - wrapper <- if (quiet) { - function(...) capture.output(..., type = "message") - } else { - identity - } - - wrapper({ - result <- rcmdcheck::rcmdcheck( - resource@path, - quiet = quiet, - error_on = "never", - build_args = "--no-manual" - ) - }) - - result + function(pkg, resource, field, ...) { + rcmdcheck::rcmdcheck( + resource@path, + error_on = "never", + build_args = "--no-manual" + ) } ) diff --git a/R/data_vignettes.R b/R/data_vignettes.R index 967401e..45f26ec 100644 --- a/R/data_vignettes.R +++ b/R/data_vignettes.R @@ -31,12 +31,11 @@ impl_data( return(0) } - nodes |> - xml2::xml_attr("href") |> - basename() |> - tools::file_path_sans_ext() |> - unique() |> - length() + paths <- xml2::xml_attr(nodes, "href") + filenames <- basename(paths) + filestems <- tools::file_path_sans_ext(filenames) + + length(unique(filestems)) } ) diff --git a/R/data_web_html.R b/R/data_web_html.R index 9ce4249..fd378c8 100644 --- a/R/data_web_html.R +++ b/R/data_web_html.R @@ -20,9 +20,8 @@ impl_data( for_resource = cran_repo_resource, permissions = "network", function(pkg, resource, field, ...) { - pkg$web_url |> - httr2::request() |> - httr2::req_perform() |> - httr2::resp_body_html() + req <- httr2::request(pkg$web_url) + resp <- httr2::req_perform(req) + httr2::resp_body_html(resp) } ) diff --git a/R/generic_pkg_data_derive.R b/R/generic_pkg_data_derive.R index 1440ad2..0452848 100644 --- a/R/generic_pkg_data_derive.R +++ b/R/generic_pkg_data_derive.R @@ -24,6 +24,53 @@ #' @export pkg_data_derive <- new_generic("pkg_data_derive", c("pkg", "resource", "field")) +#' Derive data and capture output +#' +#' Uses `evaluate::evaluate` to capture execution logs. +#' +#' @inheritParams pkg_data_derive +#' +#' @keywords internal +capture_pkg_data_derive <- function( + pkg, + resource, + field, + ..., + quiet = opt("quiet") +) { + # build a prettier call that will be output by evaluate() when not quiet + x <- pkg + pkg <- list(function() pkg_data_derive(pkg = x, field = field, ...)) + names(pkg) <- field + evaluate_fn <- function() {} + body(evaluate_fn) <- as.call(list(call("$", as.symbol("pkg"), field))) + + # format output for a standard console width; force capture of ansi + original_opts <- options( + width = 80L, + crayon.enabled = TRUE, + cli.ansi = TRUE, + cli.dynamic = FALSE, + cli.num_colors = 256L + ) + + on.exit(options(original_opts)) + + capture <- evaluate::evaluate( + evaluate_fn, + stop_on_error = 1L, + debug = !isTRUE(quiet), + output_handler = evaluate::new_output_handler(value = identity) + ) + + list( + # omit code echo and return value + logs = capture[-c(1, length(capture))], + # just the return value + data = capture[[length(capture)]] + ) +} + #' Derive by Field Name #' #' When a field is provided by name, create an empty S3 object using the field diff --git a/R/options.R b/R/options.R index c59bbd4..df59b3c 100644 --- a/R/options.R +++ b/R/options.R @@ -9,19 +9,28 @@ NULL #' @include utils_cli.R define_options( - fmt("Set the default `{packageName()}` policies, specifying how package + fmt( + "Set the default `{packageName()}` policies, specifying how package resources will be discovered and what permissions are granted when - calculating metrics."), + calculating metrics." + ), policy = policy(), - fmt("Set the default `{packageName()}` tags policy. Tags characterize the + fmt( + "Set the default `{packageName()}` tags policy. Tags characterize the types of information various metrics contain. For more details, see - [`tags()`]."), + [`tags()`]." + ), tags = tags(TRUE), - fmt("Logging directory where artifacts will be stored. Defaults to a temporary - directory."), - logs = ns_tmp_root(), + fmt("Whether output should be captured during the evaluation of metrics."), + logs = FALSE, + + fmt( + "Directory where artifacts will be stored. This includes installation logs, + package source code and temporary libraries used while evaluating packages." + ), + artifacts = ns_tmp_root(), "Silences console output during evaluation. This applies when pulling package resources (such as download and installation output) and executing code diff --git a/R/utils_dcf.R b/R/utils_dcf.R index f53eab3..f9a9428 100644 --- a/R/utils_dcf.R +++ b/R/utils_dcf.R @@ -42,13 +42,15 @@ method(from_dcf, list(class_character, S7::new_S3_class("S7_class"))) <- method(from_dcf, list(class_character, class_any)) <- function( - x, - to, - ..., - eval = TRUE, - fragment = c("key-values", "key-value", "value")) { + x, + to, + ..., + eval = TRUE, + fragment = c("key-values", "key-value", "value") + ) { fragment <- match.arg(fragment) - switch(fragment, + switch( + fragment, "key-values" = { con <- textConnection(x) x <- as.data.frame(read.dcf(con, all = TRUE)) diff --git a/R/utils_evaluate.R b/R/utils_evaluate.R new file mode 100644 index 0000000..16410fc --- /dev/null +++ b/R/utils_evaluate.R @@ -0,0 +1,32 @@ +#' @importFrom utils capture.output +#' @export +format.evaluate_evaluation <- function( + x, + ..., + style = c("text", "ansi", "html") +) { + style <- match.arg(style) + + if ( + identical(style, "html") && !requireNamespace("htmltools", quietly = TRUE) + ) { + stop( + "html formatting of evaluation logs requires suggested package ", + "`htmltools`" + ) + } + + out <- utils::capture.output(evaluate::replay(x)) + switch( + style, + text = paste(cli::ansi_strip(out), collapse = "\n"), + ansi = paste(out, collapse = "\n"), + html = { + html <- cli::ansi_html(paste(out, collapse = "\n")) + htmltools::tags$div( + style = cli::ansi_html_style(colors = 8L), + htmltools::tags$pre(htmltools::HTML(html)) + ) + } + ) +} diff --git a/R/utils_tmp.R b/R/utils_tmp.R index f66cfcd..7f51b50 100644 --- a/R/utils_tmp.R +++ b/R/utils_tmp.R @@ -9,15 +9,17 @@ ns_tmp_root <- function() { dir_create(file.path(tempdir(), packageName())) } -pkg_dir <- function(pkg, ..., .root = opt("logs")) { +pkg_dir <- function(pkg, ..., .root = opt("artifacts")) { dir_create(file.path(.root, "pkg", pkg$name, ...)) } -resource_dir <- function(x, ..., .id = x@id, .root = opt("logs")) { +resource_dir <- function(x, ..., .id = x@id, .root = opt("artifacts")) { dir_create(file.path(.root, "rsrc", .id, ...)) } dir_create <- function(path) { - if (!dir.exists(path)) dir.create(path, recursive = TRUE) + if (!dir.exists(path)) { + dir.create(path, recursive = TRUE) + } path } diff --git a/man/capture_pkg_data_derive.Rd b/man/capture_pkg_data_derive.Rd new file mode 100644 index 0000000..fc8c503 --- /dev/null +++ b/man/capture_pkg_data_derive.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/generic_pkg_data_derive.R +\name{capture_pkg_data_derive} +\alias{capture_pkg_data_derive} +\title{Derive data and capture output} +\usage{ +capture_pkg_data_derive(pkg, resource, field, ..., quiet = opt("quiet")) +} +\arguments{ +\item{pkg}{A \code{\link[=pkg]{pkg()}}} + +\item{resource}{A \code{\link[=resource]{resource()}}, or if not provided, the \code{\link{resource}} +extracted from \code{pkg@resource}.} + +\item{field}{Used for dispatching on which field to derive. Methods are +provided such that a simple \code{character} field name can be passed and +used to build a class for dispatching to the right derivation function.} + +\item{...}{Used by specific methods.} +} +\description{ +Uses \code{evaluate::evaluate} to capture execution logs. +} +\keyword{internal} diff --git a/man/get_pkg_data.Rd b/man/get_pkg_data.Rd index 82fcc0c..fba3040 100644 --- a/man/get_pkg_data.Rd +++ b/man/get_pkg_data.Rd @@ -4,7 +4,7 @@ \alias{get_pkg_data} \title{Get \code{\link{pkg}} object data} \usage{ -get_pkg_data(x, name, ..., .raise = .state$raise) +get_pkg_data(x, name, ..., logs = opt("logs"), .raise = .state$raise) } \arguments{ \item{x}{\code{\link{pkg}} object to derive data for} @@ -13,6 +13,9 @@ get_pkg_data(x, name, ..., .raise = .state$raise) \item{...}{Additional arguments unused} +\item{logs}{\code{logical(1L)} flag indicating whether console output should be +captured during execution.} + \item{.raise}{\code{logical(1L)} flag indicating whether errors should be raised or captured. This flag is not intended to be set directly, it is exposed so that recursive calls can raise lower-level errors while capturing them diff --git a/man/options.Rd b/man/options.Rd index b861199..9588fd2 100644 --- a/man/options.Rd +++ b/man/options.Rd @@ -37,12 +37,18 @@ types of information various metrics contain. For more details, see }} \item{logs}{\describe{ -Logging directory where artifacts will be stored. Defaults to a temporary -directory.\item{default: }{\preformatted{ns_tmp_root()}} +Whether output should be captured during the evaluation of metrics.\item{default: }{\preformatted{FALSE}} \item{option: }{val.meter.logs} \item{envvar: }{R_VAL_METER_LOGS (evaluated if possible, raw string otherwise)} }} +\item{artifacts}{\describe{ +Directory where artifacts will be stored. This includes installation logs, +package source code and temporary libraries used while evaluating packages.\item{default: }{\preformatted{ns_tmp_root()}} +\item{option: }{val.meter.artifacts} +\item{envvar: }{R_VAL_METER_ARTIFACTS (evaluated if possible, raw string otherwise)} +}} + \item{quiet}{\describe{ Silences console output during evaluation. This applies when pulling package resources (such as download and installation output) and executing code diff --git a/man/options_params.Rd b/man/options_params.Rd index 5e588b2..124fe6b 100644 --- a/man/options_params.Rd +++ b/man/options_params.Rd @@ -8,6 +8,9 @@ types of information various metrics contain. For more details, see \code{\link[=tags]{tags()}}. (Defaults to \code{tags(TRUE)}, overwritable using option 'val.meter.tags' or environment variable 'R_VAL_METER_TAGS')} +\item{artifacts}{Directory where artifacts will be stored. This includes installation logs, +package source code and temporary libraries used while evaluating packages. (Defaults to \code{ns_tmp_root()}, overwritable using option 'val.meter.artifacts' or environment variable 'R_VAL_METER_ARTIFACTS')} + \item{quiet}{Silences console output during evaluation. This applies when pulling package resources (such as download and installation output) and executing code (for example, running \verb{R CMD check}) (Defaults to \code{TRUE}, overwritable using option 'val.meter.quiet' or environment variable 'R_VAL_METER_QUIET')} @@ -16,8 +19,7 @@ resources (such as download and installation output) and executing code resources will be discovered and what permissions are granted when calculating metrics. (Defaults to \code{policy()}, overwritable using option 'val.meter.policy' or environment variable 'R_VAL_METER_POLICY')} -\item{logs}{Logging directory where artifacts will be stored. Defaults to a temporary -directory. (Defaults to \code{ns_tmp_root()}, overwritable using option 'val.meter.logs' or environment variable 'R_VAL_METER_LOGS')} +\item{logs}{Whether output should be captured during the evaluation of metrics. (Defaults to \code{FALSE}, overwritable using option 'val.meter.logs' or environment variable 'R_VAL_METER_LOGS')} \item{source_control_domains}{Recognized source control hosting domains used when inferring whether a package has a source code repository on a recognized hosting platform. diff --git a/tests/fixtures/pkg.local.source/DESCRIPTION b/tests/fixtures/pkg.local.source/DESCRIPTION new file mode 100644 index 0000000..c7d0b14 --- /dev/null +++ b/tests/fixtures/pkg.local.source/DESCRIPTION @@ -0,0 +1,11 @@ +Package: pkg.local.source +Title: What the Package Does (One Line, Title Case) +Version: 0.0.0.9000 +Authors@R: + person("First", "Last", , "first.last@example.com", role = c("aut", "cre")) +Description: What the package does (one paragraph). +License: `use_mit_license()`, `use_gpl3_license()` or friends to pick a + license +Encoding: UTF-8 +Roxygen: list(markdown = TRUE) +RoxygenNote: 7.3.3 diff --git a/tests/fixtures/pkg.local.source/NAMESPACE b/tests/fixtures/pkg.local.source/NAMESPACE new file mode 100644 index 0000000..6ae9268 --- /dev/null +++ b/tests/fixtures/pkg.local.source/NAMESPACE @@ -0,0 +1,2 @@ +# Generated by roxygen2: do not edit by hand + diff --git a/tests/testthat/test-convert-to-pkg.R b/tests/testthat/test-convert-to-pkg.R index e1ecbd7..c631651 100644 --- a/tests/testthat/test-convert-to-pkg.R +++ b/tests/testthat/test-convert-to-pkg.R @@ -1,4 +1,4 @@ -test_that("convert from character to pkg can discover resources", { +test_that("convert(from = character, to = class_pkg) can discover resources", { expected <- simpleError("downloading ...") class(expected) <- c("test_suite_signal", class(expected)) @@ -31,3 +31,48 @@ test_that("convert from character to pkg can discover resources", { } ) }) + +test_that("convert(from = class_pkg, to = class_pkg)", { + p <- random_pkg() + expect_identical(p, convert(p, class_pkg)) +}) + +test_that("convert(from = class_list, to = class_pkg)", { + pkg_data <- list( + name = "test", + version = "1.2.3", + r_cmd_check_error_count = 3L + ) + + expect_no_error(p <- convert(pkg_data, class_pkg)) + expect_identical(pkg_data$name, p$name) + expect_identical(pkg_data$version, p$version) + expect_identical( + pkg_data$r_cmd_check_error_count, + p$r_cmd_check_error_count + ) +}) + +test_that("convert(from = class_character [DCF], to = class_pkg)", { + desc <- " +Package: test +Version: 1.2.3 +Metric/r_cmd_check_error_count@R: 3L + " + + expect_no_error(p <- convert(desc, class_pkg)) + expect_identical(p$name, "test") + expect_identical(p$version, "1.2.3") + expect_identical(p$r_cmd_check_error_count, 3L) +}) + +test_that("convert(from = class_character [*.Rds], to = class_pkg)", { + orig_p <- random_pkg() + f <- tempfile("test-pkg-", fileext = ".Rds") + on.exit(file.remove(f)) + saveRDS(orig_p, f) + + expect_no_error(p <- convert(f, class_pkg)) + expect_identical(p$name, orig_p$name) + expect_identical(p$version, orig_p$version) +}) diff --git a/tests/testthat/test-derive-logs.R b/tests/testthat/test-derive-logs.R new file mode 100644 index 0000000..9164ff9 --- /dev/null +++ b/tests/testthat/test-derive-logs.R @@ -0,0 +1,112 @@ +test_that("logs are captured during package data evaluation", { + old <- options(val.meter.logs = TRUE) + on.exit(options(old)) + + impl_data( + "logs_test_name_character_count", + metric = TRUE, + class = class_integer, + overwrite = TRUE, + quiet = TRUE, + function(pkg, resource, field, ...) { + cat("text\n") + message("message") + warning("warning") + cli::cat_line(cli::col_blue("blue")) + nchar(pkg$name) + } + ) + + # expect that we have produced some logs + p <- pkg(mock_resource(package = "test", version = "1.2.3")) + expect_no_error(p$logs_test_name_character_count) + expect_true(!is.null(logs <- p@logs[["logs_test_name_character_count"]])) + + # expect to find our output in our logs + expect_true(is.character(text_logs <- format(logs, style = "text"))) + expect_match(text_logs, "text") + expect_match(text_logs, "\\bmessage\\b") + expect_match(text_logs, "\\bWarning in") + expect_match(text_logs, "\\bwarning\\b") + + # expect that we can format our logs as ansi strings + expect_true(is.character(ansi_logs <<- format(logs, style = "ansi"))) + expect_true(nchar(ansi_logs) > nchar(text_logs)) + + # expect that we can produce an html div from our logs + expect_s3_class(html_logs <- format(logs, style = "html"), "shiny.tag") +}) + +test_that("logging disabled does not intercept error messages", { + old <- options(val.meter.logs = FALSE) + on.exit(options(old)) + + impl_data( + "logs_test_name_character_count", + metric = TRUE, + class = class_integer, + overwrite = TRUE, + quiet = TRUE, + function(pkg, resource, field, ...) { + stop("error!!") + cli::cat_line(cli::col_blue("blue")) + nchar(pkg$name) + } + ) + + p <- pkg(test_path("..", "fixtures", "pkg.local.source")) + expect_s3_class(p$logs_test_name_character_count, "error") + expect_equal(p$logs_test_name_character_count$body, "error!!") +}) + +test_that("logging enabled does not intercept error messages", { + old <- options(val.meter.logs = TRUE) + on.exit(options(old)) + + impl_data( + "logs_test_name_character_count", + metric = TRUE, + class = class_integer, + overwrite = TRUE, + quiet = TRUE, + function(pkg, resource, field, ...) { + stop("error!!") + cli::cat_line(cli::col_blue("blue")) + nchar(pkg$name) + } + ) + + p <- pkg(test_path("..", "fixtures", "pkg.local.source")) + expect_s3_class(p$logs_test_name_character_count, "error") + expect_equal(p$logs_test_name_character_count$body, "error!!") +}) + +test_that("logging can be disabled by global option", { + old <- options(val.meter.logs = FALSE) + on.exit(options(old)) + + impl_data( + "logs_test_name_character_count", + metric = TRUE, + class = class_integer, + overwrite = TRUE, + quiet = TRUE, + function(pkg, resource, field, ...) { + cat("text\n") + message("message") + warning("warning") + cli::cat_line(cli::col_blue("blue")) + nchar(pkg$name) + } + ) + + # expect that we have produced some logs + p <- pkg(mock_resource(package = "test", version = "1.2.3")) + expect_message({ + expect_warning({ + expect_output(p$logs_test_name_character_count) + }) + }) + + expect_true(is.null(logs <- p@logs[["logs_test_name_character_count"]])) +})