diff --git a/NEWS.md b/NEWS.md index 00cff7c..97f2d75 100644 --- a/NEWS.md +++ b/NEWS.md @@ -19,7 +19,7 @@ # evaluate 0.24.0 -* The `source` output handler can now take two arguments (the unparsed `src` +* The `source` output handler can now take two arguments (the unparsed `src` and the parsed `call`) and choose to affect the displayed source. * The package now depends on R 4.0.0 in order to decrease our maintenance burden. @@ -36,7 +36,7 @@ # Version 0.21 - `evaluate()` gains `log_echo` and `log_warning` arguments. When set to `TRUE` - these cause code and warnings (respectively) to be immediately emitted to + these cause code and warnings (respectively) to be immediately emitted to `stderr()`. This is useful for logging in unattended environments (#118). - Improved the error message when users accidentally called `closeAllConnections()` (thanks, @guslipkin, quarto-dev/quarto-cli#5214). diff --git a/R/conditions.R b/R/conditions.R index f747609..00e5b63 100644 --- a/R/conditions.R +++ b/R/conditions.R @@ -2,7 +2,7 @@ condition_handlers <- function(watcher, on_error, on_warning, on_message) { list( message = function(cnd) { watcher$capture_plot_and_output() - + if (on_message$capture) { watcher$push(cnd) } @@ -10,11 +10,11 @@ condition_handlers <- function(watcher, on_error, on_warning, on_message) { invokeRestart("muffleMessage") } }, - warning = function(cnd) { + warning = function(cnd) { # do not handle warnings that shortly become errors or have been silenced if (getOption("warn") >= 2 || getOption("warn") < 0) { return() - } + } watcher$capture_plot_and_output() if (on_warning$capture) { @@ -27,10 +27,10 @@ condition_handlers <- function(watcher, on_error, on_warning, on_message) { }, error = function(cnd) { watcher$capture_plot_and_output() - + cnd <- sanitize_call(cnd) watcher$push(cnd) - + switch(on_error, continue = invokeRestart("eval_continue"), stop = invokeRestart("eval_stop"), @@ -57,6 +57,6 @@ sanitize_call <- function(cnd) { if (identical(cnd$call, quote(eval(as.call(list(context)), envir)))) { cnd$call <- NULL } - + cnd } diff --git a/R/evaluate.R b/R/evaluate.R index faa42c1..5287b10 100644 --- a/R/evaluate.R +++ b/R/evaluate.R @@ -17,28 +17,28 @@ #' including all output that evaluate captures. #' @param stop_on_error A number between 0 and 2 that controls what happens #' when the code errors: -#' +#' #' * If `0`, the default, will continue running all code, just as if you'd #' pasted the code into the command line. -#' * If `1`, evaluation will stop on first error without signaling the error, -#' and you will get back all results up to that point. -#' * If `2`, evaluation will halt on first error and you will get back no +#' * If `1`, evaluation will stop on first error without signaling the error, +#' and you will get back all results up to that point. +#' * If `2`, evaluation will halt on first error and you will get back no #' results. #' @param keep_warning,keep_message A single logical value that controls what #' happens to warnings and messages. -#' +#' #' * If `TRUE`, the default, warnings and messages will be captured in the #' output. #' * If `NA`, warnings and messages will not be captured and bubble up to #' the calling environment of `evaluate()`. #' * If `FALSE`, warnings and messages will be completed supressed and #' not shown anywhere. -#' -#' Note that setting the envvar `R_EVALUATE_BYPASS_MESSAGES` to `true` will +#' +#' Note that setting the envvar `R_EVALUATE_BYPASS_MESSAGES` to `true` will #' force these arguments to be set to `NA`. #' @param log_echo,log_warning If `TRUE`, will immediately log code and #' warnings (respectively) to `stderr`. -#' +#' #' This will be force to `TRUE` if env var `ACTIONS_STEP_DEBUG` is #' `true`, as when debugging a failing GitHub Actions workflow. #' @param new_device if `TRUE`, will open a new graphics device and @@ -48,19 +48,19 @@ #' processes the output from the evaluation. The default simply prints the #' visible return values. #' @param filename string overrriding the [base::srcfile()] filename. -#' @param include_timing Deprecated. +#' @param include_timing Deprecated. #' @import graphics grDevices utils #' @examples #' evaluate(c( -#' "1 + 1", +#' "1 + 1", #' "2 + 2" #' )) -#' -#' # Not that's there's a difference in output between putting multiple +#' +#' # Not that's there's a difference in output between putting multiple #' # expressions on one line vs spreading them across multiple lines #' evaluate("1;2;3") #' evaluate(c("1", "2", "3")) -#' +#' #' # This also affects how errors propagate, matching the behaviour #' # of the R console #' evaluate("1;stop(2);3") @@ -78,12 +78,12 @@ evaluate <- function(input, output_handler = NULL, filename = NULL, include_timing = FALSE) { - + on_error <- check_stop_on_error(stop_on_error) # if this env var is set to true, always bypass messages if (env_var_is_true('R_EVALUATE_BYPASS_MESSAGES')) { - keep_message <- NA + keep_message <- NA keep_warning <- NA } if (env_var_is_true("ACTIONS_STEP_DEBUG")) { @@ -104,12 +104,12 @@ evaluate <- function(input, watcher <- watchout(output_handler, new_device = new_device, debug = debug) if (on_error != "error" && !can_parse(input)) { - err <- tryCatch(parse(text = input), error = function(cnd) cnd) + err <- tryCatch(parse(text = input), error = function(cnd) cnd) watcher$push_source(input, expression()) watcher$push(err) return(watcher$get()) } - + parsed <- parse_all(input, filename = filename) # "Transpose" parsed so we get a list that's easier to iterate over tles <- Map( @@ -121,7 +121,7 @@ evaluate <- function(input, envir <- list2env(envir, parent = enclos %||% parent.frame()) } local_inject_funs(envir) - + # Handlers for warnings, errors and messages user_handlers <- output_handler$calling_handlers evaluate_handlers <- condition_handlers( @@ -132,7 +132,7 @@ evaluate <- function(input, ) # The user's condition handlers have priority over ours handlers <- c(user_handlers, evaluate_handlers) - + context <- function() { do <- NULL # silence R CMD check note @@ -141,7 +141,7 @@ evaluate <- function(input, if (debug || log_echo) { cat_line(tle$src, file = stderr()) } - + continue <- withRestarts( with_handlers( { @@ -150,7 +150,7 @@ evaluate <- function(input, # `Rf_eval()`. Unlike the R-level `eval()`, this doesn't create # an unwinding scope. eval(bquote(delayedAssign("do", .(expr), eval.env = envir))) - + ev <- withVisible(do) watcher$capture_plot_and_output() watcher$print_value(ev$value, ev$visible, envir) @@ -164,7 +164,7 @@ evaluate <- function(input, eval_error = function(cnd) stop(cnd) ) watcher$check_devices() - + if (!continue) { break } @@ -172,7 +172,7 @@ evaluate <- function(input, } # Here we use `eval()` to create an unwinding scope for `envir`. - # We call ourselves back immediately once the scope is created. + # We call ourselves back immediately once the scope is created. eval(as.call(list(context)), envir) watcher$capture_output() diff --git a/R/flush-console.R b/R/flush-console.R index 2ca3d01..0d44e29 100644 --- a/R/flush-console.R +++ b/R/flush-console.R @@ -8,7 +8,7 @@ #' (specified in the `output_handler` argument of `evaluate()`) will #' be called, which makes it possible for users to know it when the code #' produces text output using the handler. -#' +#' #' This function is supposed to be called inside `evaluate()` (e.g. #' either a direct `evaluate()` call or in \pkg{knitr} code chunks). #' @export @@ -31,4 +31,4 @@ set_console_flusher <- function(flusher) { old <- the$console_flusher the$console_flusher <- flusher invisible(old) -} +} diff --git a/R/graphics.R b/R/graphics.R index ae6fed1..a8d4fa1 100644 --- a/R/graphics.R +++ b/R/graphics.R @@ -20,7 +20,7 @@ looks_different <- function(old_dl, new_dl) { if (length(new_dl) < length(old_dl)) { return(TRUE) } - + # If the initial calls are different, it must be a visual change if (!identical(old_dl[], new_dl[seq_along(old_dl)])) { return(TRUE) @@ -49,21 +49,21 @@ makes_visual_change <- function(plot) { } non_visual_calls <- c( - "C_clip", - "C_layout", - "C_par", - "C_plot_window", - "C_strHeight", "C_strWidth", + "C_clip", + "C_layout", + "C_par", + "C_plot_window", + "C_strHeight", "C_strWidth", "palette", "palette2" ) # plot trimming ---------------------------------------------------------- #' Trim away intermediate plots -#' +#' #' Trim off plots that are modified by subsequent lines to only show #' the "final" plot. -#' +#' #' @param x An evaluation object produced by [evaluate()]. #' @return A modified evaluation object. #' @export @@ -73,7 +73,7 @@ non_visual_calls <- c( #' "text(1, 1, 'x')", #' "text(1, 1, 'y')" #' )) -#' +#' #' # All intermediate plots are captured #' ev #' # Only the final plot is shown diff --git a/R/inject-funs.R b/R/inject-funs.R index 9c8af57..7c3a5f3 100644 --- a/R/inject-funs.R +++ b/R/inject-funs.R @@ -22,7 +22,7 @@ #' evaluate("system('R --version')") #' #' # restore previously injected functions -#' inject_funs(old) +#' inject_funs(old) #' @export inject_funs <- function(...) { funs <- list(...) @@ -43,12 +43,12 @@ local_inject_funs <- function(envir, frame = parent.frame()) { funs_new <- !vapply(funs_names, exists, logical(1), envir, inherits = FALSE) funs_names <- funs_names[funs_new] funs <- funs[funs_new] - + defer(rm(list = funs_names, envir = envir), frame = frame) - + for (i in seq_along(funs_names)) { assign(funs_names[i], funs[[i]], envir) } - + invisible() } diff --git a/R/output-handler.R b/R/output-handler.R index 1c1ad45..860221e 100644 --- a/R/output-handler.R +++ b/R/output-handler.R @@ -18,11 +18,11 @@ #' @param source Function to handle the echoed source code under evaluation. #' This function should take two arguments (`src` and `expr`), and return #' an object that will be inserted into the evaluate outputs. `src` is the -#' unparsed text of the source code, and `expr` is the complete input +#' unparsed text of the source code, and `expr` is the complete input #' expression (which may have 0, 1, 2, or more components; see [parse_all()] #' for details). -#' -#' Return `src` for the default evaluate behaviour. Return `NULL` to +#' +#' Return `src` for the default evaluate behaviour. Return `NULL` to #' drop the source from the output. #' @param text Function to handle any textual console output. #' @param graphics Function to handle graphics, as returned by @@ -30,7 +30,7 @@ #' @param message Function to handle [message()] output. #' @param warning Function to handle [warning()] output. #' @param error Function to handle [stop()] output. -#' @param value Function to handle the values returned from evaluation. +#' @param value Function to handle the values returned from evaluation. #' * If it has one argument, it called on visible values. #' * If it has two arguments, it handles all values, with the second #' argument indicating whether or not the value is visible. @@ -44,9 +44,12 @@ #' @aliases output_handler #' @export new_output_handler <- function(source = identity, - text = identity, graphics = identity, - message = identity, warning = identity, - error = identity, value = render, + text = identity, + graphics = identity, + message = identity, + warning = identity, + error = identity, + value = render, calling_handlers = list()) { source <- match.fun(source) stopifnot(length(formals(source)) >= 1) @@ -65,10 +68,19 @@ new_output_handler <- function(source = identity, check_handlers(calling_handlers) - structure(list(source = source, text = text, graphics = graphics, - message = message, warning = warning, error = error, - value = value, calling_handlers = calling_handlers), - class = "output_handler") + structure( + list( + source = source, + text = text, + graphics = graphics, + message = message, + warning = warning, + error = error, + value = value, + calling_handlers = calling_handlers + ), + class = "output_handler" + ) } check_handlers <- function(x) { diff --git a/R/output.R b/R/output.R index 7a65f8c..0a50a29 100644 --- a/R/output.R +++ b/R/output.R @@ -3,7 +3,7 @@ new_source <- function(src, call, handler = NULL) { if (is.null(handler)) { return(src) } - + n_args <- length(formals(handler)) if (n_args == 1) { # Old format only called for side effects @@ -44,9 +44,9 @@ render <- function(value, visible, envir) { if (isS4(value)) { methods::show(value) } else { - # We need to evaluate the print() generic in a child environment of the + # We need to evaluate the print() generic in a child environment of the # evaluation frame in order to find any methods registered there - print_env <- new.env(parent = envir) + print_env <- new.env(parent = envir) print_env$value <- value evalq(print(value), envir = print_env) } diff --git a/R/parse_all.R b/R/parse_all.R index b187cf4..4ef5f9d 100644 --- a/R/parse_all.R +++ b/R/parse_all.R @@ -7,34 +7,34 @@ #' If a connection, will be opened and closed only if it was closed initially. #' @param filename string overriding the file name #' @param allow_error whether to allow syntax errors in `x` -#' @return +#' @return #' A data frame two columns, `src` and `expr`, and one row for each complete -#' input in `x`. A complete input is R code that would trigger execution when -#' typed at the console. This might consist of multiple expressions separated -#' by `;` or one expression spread over multiple lines (like a function +#' input in `x`. A complete input is R code that would trigger execution when +#' typed at the console. This might consist of multiple expressions separated +#' by `;` or one expression spread over multiple lines (like a function #' definition). -#' -#' `src` is a character vector of source code. Each element represents a -#' complete input expression (which might span multiple line) and always has a +#' +#' `src` is a character vector of source code. Each element represents a +#' complete input expression (which might span multiple line) and always has a #' terminal `\n`. -#' -#' `expr` is a list-column of [expression]s. The expressions can be of any +#' +#' `expr` is a list-column of [expression]s. The expressions can be of any #' length, depending on the structure of the complete input source: -#' +#' #' * If `src` consists of only only whitespace and/or comments, `expr` will #' be length 0. -#' * If `src` a single scalar (like `TRUE`, `1`, or `"x"`), name, or +#' * If `src` a single scalar (like `TRUE`, `1`, or `"x"`), name, or #' function call, `expr` will be length 1. -#' * If `src` contains multiple expressions separated by `;`, `expr` will +#' * If `src` contains multiple expressions separated by `;`, `expr` will #' have length two or more. -#' +#' #' The expressions have their srcrefs removed. -#' -#' If there are syntax errors in `x` and `allow_error = TRUE`, the data +#' +#' If there are syntax errors in `x` and `allow_error = TRUE`, the data #' frame will have an attribute `PARSE_ERROR` that stores the error object. #' @export #' @examples -#' # Each of these inputs are single line, but generate different numbers of +#' # Each of these inputs are single line, but generate different numbers of #' # expressions #' source <- c( #' "# a comment", @@ -45,7 +45,7 @@ #' parsed <- parse_all(source) #' lengths(parsed$expr) #' str(parsed$expr) -#' +#' #' # Each of these inputs are a single expression, but span different numbers #' # of lines #' source <- c( @@ -84,7 +84,7 @@ parse_all.character <- function(x, filename = NULL, allow_error = FALSE) { data.frame(src = paste(x, collapse = '\n'), expr = empty_expr()), PARSE_ERROR = exprs )) - } + } } else { exprs <- parse(text = x, srcfile = src) } @@ -96,7 +96,7 @@ parse_all.character <- function(x, filename = NULL, allow_error = FALSE) { ) pos$exprs <- exprs - # parse() splits TLEs that use ; into multiple expressions so we + # parse() splits TLEs that use ; into multiple expressions so we # join together expressions that overlaps on the same line(s) line_group <- cumsum(is_new_line(pos$start, pos$end)) tles <- lapply(split(pos, line_group), function(p) { @@ -108,14 +108,14 @@ parse_all.character <- function(x, filename = NULL, allow_error = FALSE) { ) }) tles <- do.call(rbind, tles) - + # parse() drops comments and whitespace so we add them back in gaps <- data.frame(start = c(1, pos$end + 1), end = c(pos$start - 1, n)) - gaps <- gaps[gaps$start <= gaps$end, ,] + gaps <- gaps[gaps$start <= gaps$end, , ] # some indexing magic in order to vectorise the extraction lengths <- gaps$end - gaps$start + 1 lines <- sequence(lengths) + rep(gaps$start, lengths) - 1 - + comments <- data.frame( src = x[lines], expr = empty_expr(length(lines)), @@ -124,14 +124,14 @@ parse_all.character <- function(x, filename = NULL, allow_error = FALSE) { res <- rbind(tles, comments) res <- res[order(res$line), c("src", "expr")] - + # Restore newlines stripped while converting to vector of lines if (length(res$src)) { res$src <- paste0(res$src, "\n") } else { res$src <- character() } - + res$expr <- lapply(res$expr, removeSource) rownames(res) <- NULL @@ -146,7 +146,7 @@ parse_all.connection <- function(x, filename = NULL, ...) { } text <- readLines(x) filename <- filename %||% summary(x)$description - + parse_all(text, filename, ...) } @@ -164,7 +164,7 @@ parse_all.call <- function(x, filename = NULL, ...) { # Helpers --------------------------------------------------------------------- - empty_expr <- function(n = 1) { +empty_expr <- function(n = 1) { I(rep(list(expression()), n)) } @@ -182,7 +182,7 @@ find_function_body <- function(f) { if (is_call(body(f), "{")) { lines <- deparse(f, control = "useSource") expr <- parse(text = lines, keep.source = TRUE) - + data <- getParseData(expr) token_start <- which(data$token == "'{'")[[1]] token_end <- last(which(data$token == "'}'")) @@ -191,7 +191,7 @@ find_function_body <- function(f) { line_end <- data$line2[token_end] - 1 lines <- lines[seq2(line_start, line_end)] - dedent <- min(data$col1[seq2(token_start + 1, token_end - 1)], 1e3) + dedent <- min(data$col1[seq2(token_start + 1, token_end - 1)], 1e3) substr(lines, dedent, nchar(lines)) } else { deparse(body(f)) diff --git a/R/replay.R b/R/replay.R index c797dd6..34f2df6 100644 --- a/R/replay.R +++ b/R/replay.R @@ -15,7 +15,7 @@ #' stop("6") #' } #' replay(evaluate("f1()")) -#' +#' #' f2 <- function() { #' message("Hello") #' plot(1:10) diff --git a/R/reproducible-output.R b/R/reproducible-output.R index d6757af..ff23528 100644 --- a/R/reproducible-output.R +++ b/R/reproducible-output.R @@ -1,15 +1,15 @@ #' Control common output options -#' +#' #' @description #' Often when using `evaluate()` you are running R code with a specific output -#' context in mind. But there are many options and env vars that packages +#' context in mind. But there are many options and env vars that packages #' will take from the current environment, meaning that output depends on -#' the current state in undesirable ways. -#' +#' the current state in undesirable ways. +#' #' This function allows you to describe the characteristics of the desired #' output and takes care of setting the options and environment variables #' for you. -#' +#' #' @export #' @param width Value of the `"width"` option. #' @param color Determines whether or not cli/crayon colour should be used. @@ -28,11 +28,11 @@ local_reproducible_output <- function(width = 80, local_options( # crayon crayon.enabled = color, - + # cli cli.width = width, cli.condition_width = width, - cli.num_colors = if (color) 8L else 1L, + cli.num_colors = if (color) 8L else 1L, cli.hyperlink = hyperlinks, cli.hyperlink_run = hyperlinks, cli.hyperlink_help = hyperlinks, @@ -41,7 +41,7 @@ local_reproducible_output <- function(width = 80, cli.dynamic = FALSE, # base R - width = width, + width = width, useFancyQuotes = unicode, # rlang diff --git a/R/utils.R b/R/utils.R index 6370be1..fdc9c67 100644 --- a/R/utils.R +++ b/R/utils.R @@ -51,6 +51,6 @@ can_parse <- function(x) { ) } -deparse1 <- function (expr, collapse = " ", width.cutoff = 500L, ...) { +deparse1 <- function(expr, collapse = " ", width.cutoff = 500L, ...) { paste(deparse(expr, width.cutoff, ...), collapse = collapse) } diff --git a/R/watchout.R b/R/watchout.R index abe46b4..94418c9 100644 --- a/R/watchout.R +++ b/R/watchout.R @@ -10,7 +10,7 @@ watchout <- function(handler = new_output_handler(), dev <- dev.cur() defer(dev.off(dev), frame) } - + # Maintain a list of outputs that we'll grow over time output <- list() i <- 1 @@ -57,7 +57,7 @@ watchout <- function(handler = new_output_handler(), if (!makes_visual_change(plot[[1]])) { return() } - + if (!looks_different(last_plot[[1]], plot[[1]])) { return() } @@ -81,9 +81,9 @@ watchout <- function(handler = new_output_handler(), } print_value <- function(value, visible, envir) { - if (!show_value(handler, visible)) + if (!show_value(handler, visible)) return() - + pv <- withVisible(handle_value(handler, value, visible, envir)) capture_plot_and_output() # If the return value is visible, save the value to the output @@ -93,7 +93,7 @@ watchout <- function(handler = new_output_handler(), } check_devices <- function() { - # if dev.off() was called, make sure to restore device to the one opened + # if dev.off() was called, make sure to restore device to the one opened # when watchout() was called if (length(dev.list()) < devn) { dev.set(dev) @@ -127,7 +127,7 @@ local_persistent_sink_connection <- function(debug = FALSE, # try() defaults to using stderr() so we need to explicitly override(#88) old <- options(try.outFile = con) defer(options(old), frame) - + sink(con, split = debug) sinkn <- sink.number() defer(if (sink.number() >= sinkn) sink(), frame) @@ -164,7 +164,7 @@ read_con <- function(con, buffer = 32 * 1024) { # isOpen doesn't work for two reasons: # 1. It errors if con has been closed, rather than returning FALSE # 2. If returns TRUE if con has been closed and a new connection opened -# +# # So instead we retrieve the connection from its number and compare to the # original connection. This works because connections have an undocumented # external pointer. diff --git a/man/evaluate.Rd b/man/evaluate.Rd index ebb7d62..9a37515 100644 --- a/man/evaluate.Rd +++ b/man/evaluate.Rd @@ -85,11 +85,11 @@ contents of the current graphics device. } \examples{ evaluate(c( - "1 + 1", + "1 + 1", "2 + 2" )) -# Not that's there's a difference in output between putting multiple +# Not that's there's a difference in output between putting multiple # expressions on one line vs spreading them across multiple lines evaluate("1;2;3") evaluate(c("1", "2", "3")) diff --git a/man/inject_funs.Rd b/man/inject_funs.Rd index 5f1c2ee..bca268f 100644 --- a/man/inject_funs.Rd +++ b/man/inject_funs.Rd @@ -36,6 +36,6 @@ old <- inject_funs(system = function(...) { evaluate("system('R --version')") # restore previously injected functions -inject_funs(old) +inject_funs(old) } \keyword{internal} diff --git a/man/parse_all.Rd b/man/parse_all.Rd index cb904ed..d82c09f 100644 --- a/man/parse_all.Rd +++ b/man/parse_all.Rd @@ -46,7 +46,7 @@ Works very similarly to parse, but also keeps original formatting and comments. } \examples{ -# Each of these inputs are single line, but generate different numbers of +# Each of these inputs are single line, but generate different numbers of # expressions source <- c( "# a comment", diff --git a/tests/testthat/test-conditions.R b/tests/testthat/test-conditions.R index abaf6d2..7bb7501 100644 --- a/tests/testthat/test-conditions.R +++ b/tests/testthat/test-conditions.R @@ -24,7 +24,7 @@ test_that("conditions get calls stripped", { test_that("envvar overrides keep_* arguments", { withr::local_envvar(R_EVALUATE_BYPASS_MESSAGES = "true") - + expect_message(ev <- evaluate("message('Hi!')", keep_message = FALSE), "Hi") expect_output_types(ev, "source") diff --git a/tests/testthat/test-evaluate.R b/tests/testthat/test-evaluate.R index 6bfbbe5..a64fbfc 100644 --- a/tests/testthat/test-evaluate.R +++ b/tests/testthat/test-evaluate.R @@ -1,4 +1,3 @@ - test_that("file with only comments runs", { ev <- evaluate(function() { # This test case contains no executable code @@ -108,7 +107,7 @@ test_that("on.exit is evaluated at end of code", { test_that("return causes an early return", { ev <- evaluate::evaluate(c( "1 + 1", - "return()", + "return()", "2 + 2" )) expect_output_types(ev, c("source", "text", "source")) @@ -127,7 +126,7 @@ test_that("check_keep converts to logical as expected", { expect_true(check_keep(TRUE)$capture) expect_false(check_keep(NA)$capture) expect_false(check_keep(FALSE)$capture) - + expect_true(check_keep(TRUE)$silence) expect_false(check_keep(NA)$silence) expect_true(check_keep(FALSE)$silence) diff --git a/tests/testthat/test-evaluation.R b/tests/testthat/test-evaluation.R index 166dabe..844decc 100644 --- a/tests/testthat/test-evaluation.R +++ b/tests/testthat/test-evaluation.R @@ -9,5 +9,5 @@ test_that("has a reasonable print method", { expect_snapshot({ evaluate("f()") evaluate("plot(1:3)") - }) + }) }) diff --git a/tests/testthat/test-flush-console.R b/tests/testthat/test-flush-console.R index efa6486..0282df8 100644 --- a/tests/testthat/test-flush-console.R +++ b/tests/testthat/test-flush-console.R @@ -1,5 +1,3 @@ - - test_that("flush_console() is a null op by default", { expect_no_error(flush_console()) }) diff --git a/tests/testthat/test-graphics.R b/tests/testthat/test-graphics.R index 2d12524..7629d64 100644 --- a/tests/testthat/test-graphics.R +++ b/tests/testthat/test-graphics.R @@ -67,7 +67,7 @@ test_that("erroring ggplots should not be recorded", { ggplot(iris, aes(XXXXXXXXXX, Sepal.Length)) + geom_boxplot() }) expect_output_types(ev, c("source", "error")) - + # error in geom ev <- evaluate(function() { ggplot(iris, aes(Species, Sepal.Length)) + geom_bar() @@ -164,7 +164,7 @@ test_that("clip() does not produce new plots", { test_that("perspective plots are captured", { x <- seq(-10, 10, length.out = 30) y <- x - ff <- function(x,y) { r <- sqrt(x^2 + y^2); 10 * sin(r) / r } + ff <- function(x, y) { r <- sqrt(x^2 + y^2); 10 * sin(r) / r } z <- outer(x, y, ff) z[is.na(z)] <- 1 @@ -187,7 +187,7 @@ test_that("evaluate() doesn't depend on device option", { path <- withr::local_tempfile() # This would error if used because recording is not enable withr::local_options(device = function() png(path)) - + ev <- evaluate("plot(1)") expect_output_types(ev, c("source", "plot")) }) diff --git a/tests/testthat/test-output-handler.R b/tests/testthat/test-output-handler.R index 1948cb6..a0819a9 100644 --- a/tests/testthat/test-output-handler.R +++ b/tests/testthat/test-output-handler.R @@ -75,7 +75,7 @@ test_that("return value of value handler inserted directly in output list", { test_that("invisible values can also be saved if value handler has two arguments", { handler <- new_output_handler(value = function(x, visible) { - x # always returns a visible value + x # always returns a visible value }) expect_true(show_value(handler, FALSE)) diff --git a/tests/testthat/test-output.R b/tests/testthat/test-output.R index 3025d39..c302744 100644 --- a/tests/testthat/test-output.R +++ b/tests/testthat/test-output.R @@ -1,10 +1,9 @@ - # new_source ------------------------------------------------------------------- test_that("handles various numbers of arguments", { signal_condition <- function(class) { signalCondition(structure(list(), class = c(class, "condition"))) - } + } expected <- structure(list(src = "x"), class = "source") # No handler diff --git a/tests/testthat/test-parse_all.R b/tests/testthat/test-parse_all.R index 449f79b..57013e9 100644 --- a/tests/testthat/test-parse_all.R +++ b/tests/testthat/test-parse_all.R @@ -16,18 +16,18 @@ test_that("every line gets nl", { # even empty lines expect_equal(parse_all("a\n\nb")$src, c("a\n", "\n", "b\n")) expect_equal(parse_all("a\n\nb\n")$src, c("a\n", "\n", "b\n")) - + expect_equal(parse_all("\n\n")$src, c("\n", "\n")) }) test_that("empty lines are never silently dropped", { - # It's not possible to simulate problem directly from code, but it can occur + # It's not possible to simulate problem directly from code, but it can occur # in knitr # ```{r, tidy = TRUE}` # for (i in 1) {} # # two blank lines below - # - # + # + # # 1 # ``` expect_equal(parse_all(c("\n", "", "1"))$src, c("\n", "\n", "1\n")) @@ -79,7 +79,7 @@ test_that("double quotes in Chinese characters not destroyed", { test_that("multibyte characters are parsed correctly", { skip_if_not(l10n_info()[['UTF-8']]) - + code <- c("ϱ <- 1# g / ml", "äöüßÄÖÜπ <- 7 + 3# nonsense") out <- parse_all(code) expect_equal(out$src, paste0(code, "\n")) @@ -149,7 +149,7 @@ test_that("isn't flumoxed by nested parens", { 1 + 1 } } - expect_equal(find_function_body(f), c("{", " 1 + 1", "}")) + expect_equal(find_function_body(f), c("{", " 1 + 1", "}")) }) test_that("works if no parens", { diff --git a/tests/testthat/test-reproducible-output.R b/tests/testthat/test-reproducible-output.R index cff142d..dabd19b 100644 --- a/tests/testthat/test-reproducible-output.R +++ b/tests/testthat/test-reproducible-output.R @@ -1,49 +1,49 @@ - test_that("local_reproducible_output() respects local context", { +test_that("local_reproducible_output() respects local context", { - local_reproducible_output(width = 105) - expect_equal(getOption("width"), 105) + local_reproducible_output(width = 105) + expect_equal(getOption("width"), 105) - local({ - local_reproducible_output(width = 110) - expect_equal(getOption("width"), 110) - }) - - expect_equal(getOption("width"), 105) + local({ + local_reproducible_output(width = 110) + expect_equal(getOption("width"), 110) }) - test_that("local_envvar respects local context", { - local_envvar(test = "a") - expect_equal(Sys.getenv("test"), "a") + expect_equal(getOption("width"), 105) +}) - local({ - local_envvar(test = "b") - expect_equal(Sys.getenv("test"), "b") - }) +test_that("local_envvar respects local context", { + local_envvar(test = "a") + expect_equal(Sys.getenv("test"), "a") - expect_equal(Sys.getenv("test"), "a") - local({ - local_envvar(test = NA) - expect_equal(Sys.getenv("test"), "") - }) + local({ + local_envvar(test = "b") + expect_equal(Sys.getenv("test"), "b") + }) - expect_equal(Sys.getenv("test"), "a") + expect_equal(Sys.getenv("test"), "a") + local({ + local_envvar(test = NA) + expect_equal(Sys.getenv("test"), "") }) - test_that("local_collate respects local context", { - locale <- switch(Sys.info()[["sysname"]], - Darwin = , - Linux = "en_US.UTF-8", - Windows = if (getRversion() >= "4.2") "en-US" - ) - skip_if(is.null(locale), "Don't know good locale to use for this platform") - - local_collate("C") - expect_equal(Sys.getlocale("LC_COLLATE"), "C") - - local({ - local_collate(locale) - expect_equal(Sys.getlocale("LC_COLLATE"), locale) - }) - - expect_equal(Sys.getlocale("LC_COLLATE"), "C") + expect_equal(Sys.getenv("test"), "a") +}) + +test_that("local_collate respects local context", { + locale <- switch(Sys.info()[["sysname"]], + Darwin = , + Linux = "en_US.UTF-8", + Windows = if (getRversion() >= "4.2") "en-US" + ) + skip_if(is.null(locale), "Don't know good locale to use for this platform") + + local_collate("C") + expect_equal(Sys.getlocale("LC_COLLATE"), "C") + + local({ + local_collate(locale) + expect_equal(Sys.getlocale("LC_COLLATE"), locale) }) + + expect_equal(Sys.getlocale("LC_COLLATE"), "C") +}) diff --git a/tests/testthat/test-watchout.R b/tests/testthat/test-watchout.R index b601abe..b9b1afa 100644 --- a/tests/testthat/test-watchout.R +++ b/tests/testthat/test-watchout.R @@ -1,4 +1,3 @@ - test_that("capture messages in try() (#88)", { f <- function(x) stop(paste0("Obscure ", x)) g <- function() f("error") @@ -12,7 +11,7 @@ test_that("code can use own sink", { f <- function() { con <- file("") defer(close(con)) - + sink(con) cat("One") sink() @@ -25,10 +24,10 @@ test_that("evaluate preserves externally created sinks", { sink(withr::local_tempfile()) defer(sink()) n <- sink.number() - + ev <- evaluate("1") expect_output_types(ev, c("source", "text")) - + expect_equal(sink.number(), n) }) @@ -57,7 +56,7 @@ test_that("isValid() works correctly", { expect_true(isValid(con1)) close(con1) expect_false(isValid(con1)) - + con2 <- file("") expect_false(isValid(con1)) # isOpen would return TRUE here expect_true(isValid(con2))