evaluate/0000755000176200001440000000000014631604472012067 5ustar liggesusersevaluate/tests/0000755000176200001440000000000014574121312013222 5ustar liggesusersevaluate/tests/testthat/0000755000176200001440000000000014630061442015062 5ustar liggesusersevaluate/tests/testthat/error-complex.R0000644000176200001440000000011314574121312017776 0ustar liggesusersf <- function() g() g <- function() h() h <- function() stop("Error") f() evaluate/tests/testthat/plot.R0000644000176200001440000000001314574121312016155 0ustar liggesusersplot(1:10) evaluate/tests/testthat/ggplot-empty-1.R0000644000176200001440000000017114574121312017772 0ustar liggesuserssuppressPackageStartupMessages(library(ggplot2)) ggplot(iris) + aes(x = Speciess, y = Sepal.Length) + geom_boxplot() evaluate/tests/testthat/test-replay.R0000644000176200001440000000070214620666451017467 0ustar liggesuserslibrary(evaluate) test_that("replay() should work when print() returns visible NULLs", { old <- options(prompt = "> ") on.exit(options(old), add = TRUE) # need to put S3 method in global namespace otherwise it isn't found assign("print.FOO_BAR", function(x, ...) NULL, envir = globalenv()) on.exit(rm(print.FOO_BAR, envir = globalenv()), add = TRUE) ret <- evaluate('structure(1, class = "FOO_BAR")') expect_snapshot(replay(ret)) }) evaluate/tests/testthat/plot-new.R0000644000176200001440000000006714574121312016755 0ustar liggesusersplot.new() plot(1:10) plot.new() plot(1:10) plot.new() evaluate/tests/testthat/parse.R0000644000176200001440000000012614574121312016316 0ustar liggesusersf <- function() { for (i in 1:3) { plot(rnorm(100)) lines(rnorm(100)) } } evaluate/tests/testthat/order.R0000644000176200001440000000026214574121312016320 0ustar liggesuserscat("1\n") print("2") warning("3") print("4") message("5") stop("6") stop("7", call. = FALSE) f <- function(x) { print("8") message("9") warning("10") stop("11") } f() evaluate/tests/testthat/plot-multi-missing.R0000644000176200001440000000005514574121312020762 0ustar liggesuserspar(mfrow = c(2, 2)) plot(1) plot(2) plot(3) evaluate/tests/testthat/plot-last-comment.R0000644000176200001440000000007714574121312020570 0ustar liggesuserspar(mfrow = c(3, 3)) for (i in 1:7) image(volcano) # comment evaluate/tests/testthat/try.R0000644000176200001440000000012214574121312016016 0ustar liggesusersg <- function() f("error") f <- function(x) stop(paste0("Obscure ", x)) try(g()) evaluate/tests/testthat/interleave-1.R0000644000176200001440000000004614574121312017501 0ustar liggesusersfor (i in 1:2) { cat(i) plot(i) } evaluate/tests/testthat/ggplot-loop.R0000644000176200001440000000030014574121312017441 0ustar liggesuserssuppressPackageStartupMessages(library(ggplot2)) for (j in 1:2) { # ggplot2 has been loaded previously print(ggplot(data.frame(x = rnorm(30), y = runif(30)), aes(x, y)) + geom_point()) } evaluate/tests/testthat/plot-clip.R0000644000176200001440000000013414574121312017106 0ustar liggesusersplot(rnorm(100), rnorm(100)) clip(-1, 1, -1, 1) points(rnorm(100), rnorm(100), col = 'red') evaluate/tests/testthat/test-output-handler.R0000644000176200001440000000070514574121312021137 0ustar liggesuserstest_that("text output handler is called with text", { text <- NULL oh <- new_output_handler(text = function(o) text <<- o) evaluate("print('abc')", output_handler = oh) expect_equal(text, "[1] \"abc\"\n") }) test_that("graphic output handler not called with no graphics", { graphics <- NULL oh <- new_output_handler(graphics = function(o) graphics <<- 1) evaluate("print('abc')", output_handler = oh) expect_equal(graphics, NULL) }) evaluate/tests/testthat/interleave-2.R0000644000176200001440000000004614574121312017502 0ustar liggesusersfor (i in 1:2) { plot(i) cat(i) } evaluate/tests/testthat/plot-par.R0000644000176200001440000000004514574121312016742 0ustar liggesusersplot(1) par(mar = rep(0, 4)) plot(2) evaluate/tests/testthat/plot-additions.R0000644000176200001440000000002714574121312020136 0ustar liggesusersplot(1:10) lines(1:10) evaluate/tests/testthat/test-errors.R0000644000176200001440000000210514574121312017474 0ustar liggesuserstest_that("all code run, even after error", { ev <- evaluate(file("error.R")) expect_length(ev, 4) }) test_that("code aborts on error if stop_on_error == 1L", { ev <- evaluate(file("error.R"), stop_on_error = 1L) expect_length(ev, 2) }) test_that("code errors if stop_on_error == 2L", { expect_error(evaluate(file("error.R"), stop_on_error = 2L), "1") }) test_that("traceback useful if stop_on_error == 2L", { expect_error(evaluate(file("error-complex.R"), stop_on_error = 2L), "Error") ## Doesn't work because .Traceback not create when code run ## inside try or tryCatch. Can't figure out how to work around. ## tryCatch(..., error = function(e) {}) doesn't have enough info ## in e, or in the call stack. options(error = function() {}) doesn't ## stop error propagation # expect_match(.Traceback[[2]], "h()") # expect_match(.Traceback[[3]], "g()") # expect_match(.Traceback[[4]], "f()") }) test_that("capture messages in try() (#88)", { skip_if(getRversion() < "3.4") ev <- evaluate(file("try.R")) expect_match(ev[[length(ev)]], "Obscure error") }) evaluate/tests/testthat/test-graphics.R0000644000176200001440000001056514623124116017771 0ustar liggesuserstest_that("single plot is captured", { ev <- evaluate(file("plot.R")) expect_length(ev, 2) expect_equal(classes(ev), c("source", "recordedplot")) }) test_that("ggplot is captured", { skip_if_not_installed("ggplot2") ev <- evaluate(file("ggplot.R")) expect_length(ev, 3) expect_equal(classes(ev), c("source", "source", "recordedplot")) }) test_that("plot additions are captured", { ev <- evaluate(file("plot-additions.R")) expect_length(ev, 4) expect_equal( classes(ev), c("source", "recordedplot", "source", "recordedplot") ) }) test_that("blank plots by plot.new() are preserved", { ev <- evaluate(file("plot-new.R")) expect_length(ev, 10) expect_equal( classes(ev), rep(c("source", "recordedplot"), 5) ) }) test_that("base plots in a single expression are captured", { ev <- evaluate(file("plot-loop.R")) expect_length(ev, 4) expect_equal(classes(ev), c("source", rep("recordedplot", 3))) }) test_that("ggplot2 plots in a single expression are captured", { skip_if_not_installed("ggplot2") ev <- evaluate(file("ggplot-loop.R")) expect_length(ev, 4) expect_equal(classes(ev), c(rep("source", 2), rep("recordedplot", 2))) }) test_that("Empty ggplot should not be recorded", { skip_if_not_installed("ggplot2") ev <- evaluate(file(test_path("ggplot-empty-1.R"))) expect_identical(classes(ev), c( "source", "source", if (packageVersion("ggplot2") > "3.3.6") "rlang_error" else "simpleError" )) ev <- evaluate(file(test_path("ggplot-empty-2.R"))) expect_identical(classes(ev), c("source", "source", "rlang_error")) }) test_that("multirow graphics are captured only when complete", { ev <- evaluate(file("plot-multi.R")) expect_equal(classes(ev), c(rep("source", 5), "recordedplot")) }) test_that("multirow graphics are captured on close", { ev <- evaluate(file("plot-multi-missing.R")) expect_equal(classes(ev), c(rep("source", 4), "recordedplot")) }) test_that("plots are captured in a non-rectangular layout", { ev <- evaluate(file("plot-multi-layout.R")) expect_equal(classes(ev), rep(c("source", "recordedplot"), c(1, 3))) ev <- evaluate(file("plot-multi-layout2.R")) expect_equal(classes(ev), rep(c("source", "recordedplot"), c(4, 2))) }) test_that("changes in parameters don't generate new plots", { ev <- evaluate(file("plot-par.R")) expect_equal( classes(ev), c("source", "recordedplot", "source", "source", "recordedplot") ) }) test_that("plots in a loop are captured even the changes seem to be from par only", { ev <- evaluate(file("plot-par2.R")) expect_equal(classes(ev), c("source", "recordedplot")[c(1, 2, 1, 1, 2, 2, 2)]) }) test_that("strwidth()/strheight() should not produce new plots", { ev <- evaluate(file("plot-strwidth.R")) expect_equal(classes(ev), rep(c("source", "recordedplot"), c(4, 1))) }) test_that("clip() does not produce new plots", { ev <- evaluate(file("plot-clip.R")) expect_equal(classes(ev), c("source", "recordedplot")[c(1, 2, 1, 1, 2)]) }) test_that("perspective plots are captured", { ev <- evaluate(file("plot-persp.R")) expect_equal(classes(ev), rep(c("source", "recordedplot"), c(6, 3))) }) test_that("an incomplete plot with a comment in the end is also captured", { ev <- evaluate(file("plot-last-comment.R")) expect_equal(classes(ev), rep(c("source", "recordedplot"), c(3, 1))) }) # a bug report yihui/knitr#722 test_that("repeatedly drawing the same plot does not omit plots randomly", { expect_true(all(replicate(100, length(evaluate("plot(1:10)"))) == 2)) }) # test_that("no plot windows open", { # graphics.off() # expect_equal(length(dev.list()), 0) # evaluate(file("plot.R")) # expect_equal(length(dev.list()), 0) # }) test_that("by default, evaluate() always records plots regardless of the device", { op <- options(device = pdf) on.exit(options(op)) ev <- evaluate("plot(1)") expect_length(ev, 2) }) test_that("Rplots.pdf files are not created", { op <- options(device = pdf) on.exit(options(op)) evaluate(file("plot.R")) expect_false(file.exists("Rplots.pdf")) }) # https://github.com/yihui/knitr/issues/2297 test_that("existing plots will not leak into evaluate()", { pdf(NULL) dev.control('enable') d <- dev.cur() plot(1, 1) ev <- evaluate(c('dev.new()', 'dev.off()', 'plot.new()', 'plot(1:10, 1:10)')) dev.off(d) expect_equal(tail(classes(ev), 6), c('source', 'character', 'recordedplot')[c(1, 2, 1, 3, 1, 3)]) }) evaluate/tests/testthat/plot-strwidth.R0000644000176200001440000000014014574121312020024 0ustar liggesusersx <- strwidth('foo', 'inches') y <- strheight('foo', 'inches') par(mar = c(4, 4, 1, 1)) plot(1) evaluate/tests/testthat/plot-multi-layout.R0000644000176200001440000000022514574121312020625 0ustar liggesusersfor (j in 1:3) { layout(matrix(c(1, 2, 1, 3, 4, 4), 3, 2, byrow = TRUE)) plot(rnorm(10)) plot(rnorm(10)) plot(rnorm(10)) plot(rnorm(10)) } evaluate/tests/testthat/test-evaluate.R0000644000176200001440000001036514623124116017775 0ustar liggesuserstest_that("file with only comments runs", { ev <- evaluate(file("comment.R")) expect_length(ev, 2) expect_equal(classes(ev), c("source", "source")) }) test_that("data sets loaded", { skip_if_not_installed("lattice") ev <- evaluate(file("data.R")) expect_length(ev, 3) }) # # Don't know how to implement this # test_that("newlines escaped correctly", { # ev <- evaluate("cat('foo\n')") # expect_that(ev[[1]]$src, equals("cat('foo\\n'))")) # }) test_that("terminal newline not needed", { ev <- evaluate("cat('foo')") expect_length(ev, 2) expect_equal(ev[[2]], "foo") }) test_that("S4 methods are displayed with show, not print", { setClass("A", contains = "function", where = environment()) setMethod("show", "A", function(object) cat("B")) a <- new('A', function() b) ev <- evaluate("a") expect_equal(ev[[2]], "B") }) test_that("errors during printing visible values are captured", { setClass("A", contains = "function", where = environment()) setMethod("show", "A", function(object) stop("B")) a <- new('A', function() b) ev <- evaluate("a") expect_s3_class(ev[[2]], "error") }) test_that("options(warn = -1) suppresses warnings", { ev <- evaluate("op = options(warn = -1); warning('hi'); options(op)") expect_equal(classes(ev), "source") }) test_that("options(warn = 0) and options(warn = 1) produces warnings", { ev <- evaluate("op = options(warn = 0); warning('hi'); options(op)") expect_equal(classes(ev), c("source", "simpleWarning")) ev <- evaluate("op = options(warn = 1); warning('hi'); options(op)") expect_equal(classes(ev), c("source", "simpleWarning")) }) # See https://github.com/r-lib/evaluate/pull/81#issuecomment-367685196 # test_that("options(warn = 2) produces errors instead of warnings", { # ev_warn_2 <- evaluate("op = options(warn = 2); warning('hi'); options(op)") # expect_equal(classes(ev_warn_2), c("source", "simpleError")) # }) test_that("output and plots interleaved correctly", { ev <- evaluate(file("interleave-1.R")) expect_equal(classes(ev), c("source", "character", "recordedplot", "character", "recordedplot")) ev <- evaluate(file("interleave-2.R")) expect_equal(classes(ev), c("source", "recordedplot", "character", "recordedplot", "character")) }) test_that("return value of value handler inserted directly in output list", { skip_if_not_installed("ggplot2") ev <- evaluate( file("raw-output.R"), output_handler = new_output_handler(value = identity) ) expect_equal( classes(ev), c("source", "numeric", "source", "source", "source", "gg") ) }) 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 }) ev <- evaluate("x<-1:10", output_handler = handler) expect_equal(classes(ev), c("source", "integer")) }) test_that("multiple expressions on one line can get printed as expected", { ev <- evaluate("x <- 1; y <- 2; x; y") expect_equal(classes(ev), c("source", "character", "character")) }) test_that("multiple lines of comments do not lose the terminating \\n", { ev <- evaluate("# foo\n#bar") expect_equal(ev[[1]][["src"]], "# foo\n") }) test_that("user can register calling handlers", { cnd <- structure(list(), class = c("foobar", "condition")) hnd <- function(cnd) handled <<- cnd handled <- NULL hnd <- function(cnd) handled <<- cnd out_hnd <- new_output_handler(calling_handlers = list(foobar = hnd)) evaluate("signalCondition(cnd)", output_handler = out_hnd) expect_s3_class(handled, "foobar") handled <- NULL out_hnd <- new_output_handler(calling_handlers = list(error = hnd)) evaluate("stop('tilt')", stop_on_error = 0, output_handler = out_hnd) expect_s3_class(handled, "error") }) test_that("calling handlers are checked", { expect_error( new_output_handler(calling_handlers = list(condition = 1)), "must be" ) expect_error( new_output_handler(calling_handlers = list(function(...) NULL)), "must be" ) expect_error( new_output_handler(calling_handlers = stats::setNames(list(function(...) NULL), NA)), "must be" ) expect_error( new_output_handler(calling_handlers = stats::setNames(list(function(...) NULL), "")), "must be" ) }) evaluate/tests/testthat/test-eval.R0000644000176200001440000000372014630061442017113 0ustar liggesuserstest_that("log_echo causes output to be immediately written to stderr()", { f <- function() { 1 } out <- capture.output( res <- evaluate("f()", log_echo = TRUE), type = "message" ) expect_equal(out, "f()") # But still recorded in eval result expect_length(res, 2) expect_equal(res[[1]]$src, "f()") }) test_that("log_warning causes warnings to be immediately written to stderr()", { f <- function() { warning("Hi!", immediate. = TRUE) } out <- capture.output( res <- evaluate("f()", log_warning = TRUE), type = "message" ) expect_equal(out, "Warning in f(): Hi!") # But still recorded in eval result expect_length(res, 2) expect_equal(res[[1]]$src, "f()") expect_equal(res[[2]], simpleWarning("Hi!", quote(f()))) }) test_that("show_warning handles different types of warning", { expect_snapshot({ w1 <- simpleWarning("This is a warning") cat(format_warning(w1)) w2 <- simpleWarning("This is a warning", call = quote(f())) cat(format_warning(w2)) w3 <- rlang::warning_cnd(message = "This is a warning") cat(format_warning(w3)) w4 <- rlang::warning_cnd(message = "This is a warning") cat(format_warning(w4)) }) }) test_that("can conditionally omit output with output handler", { hide_source <- function(src, call) { if (is.call(call) && identical(call[[1]], quote(hide))) { NULL } else { src } } handler <- new_output_handler(source = hide_source) hide <- function(x) invisible(x) out <- evaluate("hide(x <- 1)\nx", output_handler = handler) expect_length(out, 2) expect_snapshot(replay(out)) }) test_that("source handled called correctly when src is unparseable", { src <- NULL call <- NULL capture_args <- function(src, call) { src <<- src call <<- call src } handler <- new_output_handler(source = capture_args) evaluate("x + ", output_handler = handler) expect_equal(src, new_source("x + ")) expect_equal(call, expression()) }) evaluate/tests/testthat/plot-multi.R0000644000176200001440000000006514574121312017314 0ustar liggesuserspar(mfrow = c(2, 2)) plot(1) plot(2) plot(3) plot(4) evaluate/tests/testthat/test-output.R0000644000176200001440000000176614630061442017534 0ustar liggesuserstest_that("open plot windows maintained", { n <- length(dev.list()) evaluate(file("plot.R")) expect_length(dev.list(), n) }) # 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 expect_equal(new_source("x", quote(x)), expected) # One argument f1 <- function(src) signal_condition("handler_called") expect_condition(out <- new_source("x", quote(x), f1), class = "handler_called") expect_equal(out, expected) # Two arguments f2 <- function(src, call) {signal_condition("handler_called"); NULL} expect_condition(out <- new_source("x", quote(x), f2), class = "handler_called") expect_equal(out, NULL) # Three arguments f3 <- function(a, b, c) NULL expect_snapshot(new_source("x", quote(x), f3), error = TRUE) }) evaluate/tests/testthat/ggplot.R0000644000176200001440000000013514574121312016500 0ustar liggesuserssuppressPackageStartupMessages(library(ggplot2)) ggplot(mtcars, aes(mpg, wt)) + geom_point() evaluate/tests/testthat/example-1.R0000644000176200001440000000042014574121312016772 0ustar liggesusers# These test cases check that interweave # works for a variety of situations a <- 1 # Comment after an expression b <- 2 { a b } # Here is a comment which should be followed # by two new lines { print(a) # comment in a block print(b) } a; b a; b # Comment evaluate/tests/testthat/plot-par2.R0000644000176200001440000000032614574121312017026 0ustar liggesusersbarplot(table(mtcars$mpg), main = "All") # should capture all plots in this loop for (numcyl in levels(as.factor(mtcars$cyl))) { barplot(table(mtcars$mpg[mtcars$cyl == numcyl]), main = paste("cyl = ", numcyl)) } evaluate/tests/testthat/test-parse.R0000644000176200001440000000163714574121312017303 0ustar liggesuserstest_that("{ not removed", { f <- function() { for (i in 1:3) { plot(rnorm(100)) lines(rnorm(100)) } } expect_equal(nrow(parse_all(f)), 1) }) test_that("parse(allow_error = TRUE/FALSE)", { expect_error(parse_all('x <-', allow_error = FALSE)) res <- parse_all('x <-', allow_error = TRUE) expect_true(inherits(attr(res, 'PARSE_ERROR'), 'error')) }) # test some multibyte characters when the locale is UTF8 based if (isTRUE(l10n_info()[['UTF-8']])) { test_that("double quotes in Chinese characters not destroyed", { expect_identical(parse_all(c('1+1', '"你好"'))[2, 1], '"你好"') }) test_that("multibyte characters are parsed correct", { code <- c("ϱ <- 1# g / ml", "äöüßÄÖÜπ <- 7 + 3# nonsense") expect_identical(parse_all(code)$src, append_break(code)) }) } test_that("can ignore parse errors", { expect_error(evaluate('x <-', stop_on_error = 0), NA) }) evaluate/tests/testthat/_snaps/0000755000176200001440000000000014630061442016345 5ustar liggesusersevaluate/tests/testthat/_snaps/output.md0000644000176200001440000000030014630061442020220 0ustar liggesusers# handles various numbers of arguments Code new_source("x", quote(x), f3) Condition Error in `new_source()`: ! Source output handler must have one or two arguments evaluate/tests/testthat/_snaps/eval.md0000644000176200001440000000145614630061442017624 0ustar liggesusers# show_warning handles different types of warning Code w1 <- simpleWarning("This is a warning") cat(format_warning(w1)) Output Warning: This is a warning Code w2 <- simpleWarning("This is a warning", call = quote(f())) cat(format_warning(w2)) Output Warning in f(): This is a warning Code w3 <- rlang::warning_cnd(message = "This is a warning") cat(format_warning(w3)) Output Warning: This is a warning Code w4 <- rlang::warning_cnd(message = "This is a warning") cat(format_warning(w4)) Output Warning: This is a warning # can conditionally omit output with output handler Code replay(out) Output > x [1] 1 evaluate/tests/testthat/_snaps/replay.md0000644000176200001440000000022514627616416020177 0ustar liggesusers# replay() should work when print() returns visible NULLs Code replay(ret) Output > structure(1, class = "FOO_BAR") NULL evaluate/tests/testthat/ggplot-empty-2.R0000644000176200001440000000016414574121312017775 0ustar liggesuserssuppressPackageStartupMessages(library(ggplot2)) ggplot(iris) + aes(x = Species, y = Sepal.Length) + geom_bar() evaluate/tests/testthat/comment.R0000644000176200001440000000011714574121312016646 0ustar liggesusers# This test case contains no executable code # but it shouldn't throw an error evaluate/tests/testthat/data.R0000644000176200001440000000005114574121312016112 0ustar liggesusersdata(barley, package = "lattice") barley evaluate/tests/testthat/error.R0000644000176200001440000000001414574121312016331 0ustar liggesusersstop("1") 2 evaluate/tests/testthat/plot-multi-layout2.R0000644000176200001440000000031414574121312020706 0ustar liggesuserslayout(matrix(c(1, 2, 1, 3, 4, 4), 3, 2, byrow = TRUE)) # another expression before drawing the plots x <- 1 + 1 for (j in 1:2) { plot(rnorm(10)) plot(rnorm(10)) plot(rnorm(10)) plot(rnorm(10)) } evaluate/tests/testthat/plot-persp.R0000644000176200001440000000031514574121312017311 0ustar liggesusersx <- seq(-10, 10, length = 30) y <- x ff <- function(x,y) { r <- sqrt(x^2 + y^2); 10 * sin(r) / r } z <- outer(x, y, ff) z[is.na(z)] <- 1 for (i in 1:3) { persp(x, y, z, phi = 30 + i * 10, theta = 30) } evaluate/tests/testthat/plot-loop.R0000644000176200001440000000004714574121312017133 0ustar liggesusersfor (i in 1:3) { plot(rnorm(100)) } evaluate/tests/testthat/raw-output.R0000644000176200001440000000020014574121312017324 0ustar liggesusersrnorm(10) x <- list("I'm a list!") suppressPackageStartupMessages(library(ggplot2)) ggplot(mtcars, aes(mpg, wt)) + geom_point() evaluate/tests/test-all.R0000644000176200001440000000012314371256305015074 0ustar liggesuserslibrary(evaluate) if (require("testthat", quietly = TRUE)) test_check("evaluate") evaluate/MD50000644000176200001440000000737414631604472012412 0ustar liggesusersa70e8adca101c9ad9433c363b8aa85c5 *DESCRIPTION 84608dd8acefaf79f48adad1e7e40991 *LICENSE 437c0030837a125263825c691c0b90c7 *NAMESPACE 50e3014f5f69d02a71b94e4d876a6b83 *NEWS.md e3a1a2ff4e8de7138adfb5d55d991dac *R/eval.R 6945ab5d4ace48768904ecc4589dbeaa *R/graphics.R 4d6bfdb8870799394ccb6affc752f706 *R/hooks.R 9fdc4b7082e17b0bd89cdfc7badab4c0 *R/output.R b3f5a8631290640aff1459d71ff30f2a *R/parse.R 7f23a738406d97cd9f3b3a45edc088d9 *R/replay.R 621066d5bd50b2af562db7ef5a6e58ce *R/traceback.R f87f2db625566d2932cb846108e14446 *R/watcher.R 5e5dc31b541d5ca17c0bf7ad6e6cd9c7 *README.md edff32110e2261bbf9afba2b2448722a *man/create_traceback.Rd 90a90d6b04e444fa726ca01b9de5b266 *man/evaluate.Rd 9074248c19193869668a12e4fd2cce7a *man/flush_console.Rd bc41d5fe57d681be64d5c1895f88db9a *man/inject_funs.Rd 0f7a2f2d53f374175b7f4b9fb976dce1 *man/is.message.Rd 85c3a15a508816a85cda725ca9850a87 *man/line_prompt.Rd 466700abb00936d263bc965c3e4d3b37 *man/new_output_handler.Rd 265addf19fa5bdfb9676a271b4951ca4 *man/parse_all.Rd 9e114fd5b86e8a31aebc6d13c54138c5 *man/remove_hooks.Rd 31e9f5485aa5b7c19bc02e5153fc9225 *man/replay.Rd 9886b294b5f65a2dda3f22e8b246d652 *man/set_hooks.Rd 28516b61e6c61eabf10f3b669f5f9668 *man/try_capture_stack.Rd 396d5b6bf0b4f3f41c1f0a6454d82fd6 *man/watchout.Rd 7d1137c5d46bfb4567e5300009945ca2 *tests/test-all.R 2196e90f5be69d4ad3c5c7a86c55b7a9 *tests/testthat/_snaps/eval.md 647150561b8068b961dc3f5309e25171 *tests/testthat/_snaps/output.md 28bc77695dbb22b987947148f8c2cdc8 *tests/testthat/_snaps/replay.md 446d67f5fc9a97626f757fae3fefcee7 *tests/testthat/comment.R 94750480cbfd8455ba433ab42828023e *tests/testthat/data.R 38a0bd49c764aefce15f4844036ccf02 *tests/testthat/error-complex.R fea574ba53709e7b38a294d855011323 *tests/testthat/error.R 24e9ae27434864fdef5901807e66ea98 *tests/testthat/example-1.R d3f3c08fb5fc74bab58a0b169f55c1fc *tests/testthat/ggplot-empty-1.R 8a7d55d994d72b317ff9ae02193ad048 *tests/testthat/ggplot-empty-2.R f310aa43c59911746781a02d8473689d *tests/testthat/ggplot-loop.R 3c0b741c4cf8d6fc1275f1e8ccf86ff5 *tests/testthat/ggplot.R 7f8df2eafe897d4ef3984fa881276903 *tests/testthat/interleave-1.R c46d014984f40ebdad0ee83a4c0b0666 *tests/testthat/interleave-2.R c887105bd174693b5ab37f3c1e92ec10 *tests/testthat/order.R 237f9f25bfab96f6928e6f29297c4827 *tests/testthat/parse.R ea5f897a7a8a861dffbfb4a97f4ba666 *tests/testthat/plot-additions.R 9cf8a8768e36e0e4b9f33c7dae3e2a29 *tests/testthat/plot-clip.R 3eb3a37b6b99567c00e9e252d3cfc079 *tests/testthat/plot-last-comment.R 396ff3413370398b3be86fa9a27ae235 *tests/testthat/plot-loop.R e4085acac5469333f8615cf24ba3c2a8 *tests/testthat/plot-multi-layout.R af1fd71e6872ce27f380da68d9e57638 *tests/testthat/plot-multi-layout2.R 2f5434a4a5a4a9fa0164c21ee9ec52f4 *tests/testthat/plot-multi-missing.R 4b9fd50ee21d4f3da6332ffed48746cb *tests/testthat/plot-multi.R b4952448dc702d1ce95cb57b8d2660f5 *tests/testthat/plot-new.R 6013de5aae712457dedf5a949395a7b4 *tests/testthat/plot-par.R ea7ff46a39730ce982233eb4a603329e *tests/testthat/plot-par2.R 9647c89b1105dba33f01d78992c1a5f8 *tests/testthat/plot-persp.R 07096b6184ee44418a18cbedbe4aa5b6 *tests/testthat/plot-strwidth.R 4cbfd1ffe04ab0562a2514f22a2e049d *tests/testthat/plot.R 5a97226527fc9998e9ca488e524b706e *tests/testthat/raw-output.R 29600f8c08dd3d369748efcd40c1e1d8 *tests/testthat/test-errors.R 1267204eeb0a4943505a7670c844a7db *tests/testthat/test-eval.R 2ec56e481221817690c093124df6d5d8 *tests/testthat/test-evaluate.R 8f4af15effbce1e4469a08f4af731953 *tests/testthat/test-graphics.R e2d6369b99e61fbaccaf1b0117cbb852 *tests/testthat/test-output-handler.R 093d7162ed2c62969812bb12cf2494f4 *tests/testthat/test-output.R 37a963bbb956ca9b0f41ecdf4bd0b6ef *tests/testthat/test-parse.R 9346324ce19bcde3d7aab9c83641883c *tests/testthat/test-replay.R 905d85f44018ba83d1eb33636d13b2a4 *tests/testthat/try.R evaluate/R/0000755000176200001440000000000014630061442012261 5ustar liggesusersevaluate/R/traceback.R0000644000176200001440000000253714574121312014332 0ustar liggesusers#' Generate a traceback from a list of calls. #' #' @param callstack stack of calls, as generated by (e.g.) #' [base::sys.calls()] #' @keywords internal #' @export create_traceback <- function(callstack) { if (length(callstack) == 0) return() # Convert to text calls <- lapply(callstack, deparse, width = 500) calls <- sapply(calls, paste0, collapse = "\n") # Number and indent calls <- paste0(seq_along(calls), ": ", calls) calls <- sub("\n", "\n ", calls) calls } #' Try, capturing stack on error. #' #' This is a variant of [tryCatch()] that also captures the call #' stack if an error occurs. #' #' @param quoted_code code to evaluate, in quoted form #' @param env environment in which to execute code #' @keywords internal #' @export try_capture_stack <- function(quoted_code, env) { capture_calls <- function(e) { # Make sure a "call" component exists to avoid warnings with partial # matching in conditionCall.condition() e["call"] <- e["call"] # Capture call stack, removing last two calls from end (added by # withCallingHandlers), and first frame + 7 calls from start (added by # tryCatch etc) e$calls <- head(sys.calls()[-seq_len(frame + 7)], -2) signalCondition(e) } frame <- sys.nframe() tryCatch( withCallingHandlers(eval(quoted_code, env), error = capture_calls), error = identity ) } evaluate/R/parse.R0000644000176200001440000001404414574121312013521 0ustar liggesusers#' Parse, retaining comments. #' #' Works very similarly to parse, but also keeps original formatting and #' comments. #' #' @param x object to parse. Can be a string, a file connection, or a function. #' 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 A data.frame with columns `src`, the source code, and #' `expr`. If there are syntax errors in `x` and `allow_error = #' TRUE`, the data frame has an attribute `PARSE_ERROR` that stores the #' error object. #' @export parse_all <- function(x, filename = NULL, allow_error = FALSE) UseMethod("parse_all") #' @export parse_all.character <- function(x, filename = NULL, allow_error = FALSE) { # Do not convert strings to factors by default in data.frame() op <- options(stringsAsFactors = FALSE) on.exit(options(op), add = TRUE) if (length(grep("\n", x))) { # strsplit('a\n', '\n') needs to return c('a', '') instead of c('a') x <- gsub("\n$", "\n\n", x) x[x == ""] <- "\n" x <- unlist(strsplit(x, "\n"), recursive = FALSE, use.names = FALSE) } n <- length(x) if (is.null(filename)) filename <- "" src <- srcfilecopy(filename, x) if (allow_error) { exprs <- tryCatch(parse(text = x, srcfile = src), error = identity) if (inherits(exprs, 'error')) return(structure( data.frame(src = paste(x, collapse = '\n'), expr = I(list(expression()))), PARSE_ERROR = exprs )) } else { exprs <- parse(text = x, srcfile = src) } # No code, only comments and/or empty lines ne <- length(exprs) if (ne == 0) { return(data.frame(src = append_break(x), expr = I(rep(list(NULL), n)))) } srcref <- attr(exprs, "srcref", exact = TRUE) # Stard/End line numbers of expressions pos <- do.call(rbind, lapply(srcref, unclass))[, c(7, 8), drop = FALSE] l1 <- pos[, 1] l2 <- pos[, 2] # Add a third column i to store the indices of expressions pos <- cbind(pos, i = seq_len(nrow(pos))) pos <- as.data.frame(pos) # split() does not work on matrices # Split line number pairs into groups: if the next start line is the same as # the last end line, the two expressions must belong to the same group spl <- cumsum(c(TRUE, l1[-1] != l2[-ne])) # Extract src lines and expressions for each group; also record the start line # number of this group so we can re-order src/expr later res <- lapply(split(pos, spl), function(p) { n <- nrow(p) data.frame( src = paste(x[p[1, 1]:p[n, 2]], collapse = "\n"), expr = I(list(exprs[p[, 3]])), line = p[1, 1] ) }) # Now process empty expressions (comments/blank lines); see if there is a # "gap" between the last end number + 1 and the next start number - 1 pos <- cbind(c(1, l2 + 1), c(l1 - 1, n)) pos <- pos[pos[, 1] <= pos[, 2], , drop = FALSE] # Extract src lines from the gaps, and assign empty expressions to them res <- c(res, lapply(seq_len(nrow(pos)), function(i) { p <- pos[i, ] r <- p[1]:p[2] data.frame( src = x[r], expr = I(rep(list(NULL), p[2] - p[1] + 1)), line = r - 1 ) })) # Bind everything into a data frame, order it by line numbers, append \n to # all src lines except the last one, and remove the line numbers res <- do.call(rbind, res) res <- res[order(res$line), ] res$src <- append_break(res$src) res$line <- NULL # For compatibility with evaluate (<= 0.5.7): remove the last empty line (YX: # I think this is a bug) n <- nrow(res) if (res$src[n] == "") res <- res[-n, ] rownames(res) <- NULL res } # YX: It seems evaluate (<= 0.5.7) had difficulties with preserving line breaks, # so it ended up with adding \n to the first n-1 lines, which does not seem to # be necessary to me, and is actually buggy. I'm not sure if it is worth shaking # the earth and work with authors of reverse dependencies to sort this out. Also # see #42. append_break <- function(x) { n <- length(x) if (n <= 1) x else paste(x, rep(c("\n", ""), c(n - 1, 1)), sep = "") } # YX: This hack is because srcfilecopy() uses grepl("\n", fixed = TRUE), which # does not work when the source lines contain multibyte characters that are not # representable in the current locale on Windows (see # https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=16264). In our case, we # have already split the lines by \n, so there is no need to do that again like # srcfilecopy() does internally. if (getRversion() <= '3.2.2') srcfilecopy <- function(filename, lines, ...) { src <- base::srcfilecopy(filename, lines = "", ...) src$lines <- lines src } #' @export parse_all.connection <- function(x, filename = NULL, ...) { if (!isOpen(x, "r")) { open(x, "r") on.exit(close(x)) } text <- readLines(x) if (is.null(filename)) filename <- summary(x)$description parse_all(text, filename, ...) } #' @export parse_all.function <- function(x, filename = NULL, ...) { src <- attr(x, "srcref", exact = TRUE) if (is.null(src)) { src <- deparse(body(x)) # Remove { and } n <- length(src) if (n >= 2) src <- src[-c(1, n)] if (is.null(filename)) filename <- "" parse_all(src, filename, ...) } else { src2 <- attr(body(x), "srcref", exact = TRUE) n <- length(src2) if (n > 0) { if (is.null(filename)) filename <- attr(src, 'srcfile')$filename if (n >= 2) { parse_all(unlist(lapply(src2[-1], as.character)), filename, ...) } else { # f <- function(...) {} parse_all(character(0), filename, ...) } } else { if (is.null(filename)) filename <- "" parse_all(deparse(body(x)), filename, ...) } } } #' @export parse_all.default <- function(x, filename = NULL, ...) { if (is.null(filename)) filename <- "" parse_all(deparse(x), filename, ...) } # Calls are already parsed and always length one #' @export parse_all.call <- function(x, filename = NULL, ...) { out <- parse_all.default(x, filename = filename, ...) out$expr <- list(as.expression(x)) out } evaluate/R/hooks.R0000644000176200001440000000251114574121312013526 0ustar liggesusers#' Set hooks. #' #' This wraps the base [setHook()] function to provide a return #' value that makes it easy to undo. #' #' @param hooks a named list of hooks - each hook can either be a function or #' a list of functions. #' @param action `"replace"`, `"append"` or `"prepend"` #' @keywords internal #' @export #' @examples #' new <- list(before.plot.new = function() print("Plotted!")) #' hooks <- set_hooks(new) #' plot(1) #' set_hooks(hooks, "replace") #' plot(1) set_hooks <- function(hooks, action = "append") { old <- list() for (hook_name in names(hooks)) { old[[hook_name]] <- getHook(hook_name) setHook(hook_name, hooks[[hook_name]], action = action) } invisible(old) } #' Remove hooks. #' #' This provides a way to remove previously set hook values. #' #' @inheritParams set_hooks #' @keywords internal #' @export #' @examples #' new1 <- list(before.plot.new = function() print("Plotted!")) #' new2 <- list(before.plot.new = function() print("Plotted Again!")) #' set_hooks(new1) #' set_hooks(new2) #' plot(1) #' remove_hooks(new1) #' plot(1) #' remove_hooks(new2) #' plot(1) remove_hooks <- function(hooks) { for (hook_name in names(hooks)) { hook <- getHook(hook_name) for (fun in unlist(hooks[hook_name])) { hook[sapply(hook, identical, fun)] <- NULL } setHook(hook_name, hook, "replace") } } evaluate/R/graphics.R0000644000176200001440000000433614574121312014212 0ustar liggesusers#" Capture snapshot of current device. #" #" There's currently no way to capture when a graphics device changes, #" except to check its contents after the evaluation of every expression. #" This means that only the last plot of a series will be captured. #" #" @return \code{NULL} if plot is blank or unchanged, otherwise the output of #" \code{\link{recordPlot}}. plot_snapshot <- local({ last_plot <- NULL function(incomplete = FALSE) { # to record a plot, at least one device must be open; the list of devices # must not have changed since evaluate() started if (is.null(devs <- dev.list()) || !identical(devs, .env$dev_list)) return(NULL) if (!incomplete && !par('page')) return(NULL) # current page not complete plot <- recordPlot() if (identical(last_plot, plot) || is_par_change(last_plot, plot)) { return(NULL) } if (is.empty(plot)) return(NULL) last_plot <<- plot plot } }) is_par_change <- function(p1, p2) { calls1 <- plot_calls(p1) calls2 <- plot_calls(p2) n1 <- length(calls1) n2 <- length(calls2) if (n2 <= n1) return(FALSE) i1 <- seq_len(n1) if (!identical(calls1, calls2[i1])) return(FALSE) # also check if the content of the display list is still the same (note we # need p1[[1]][] as well because [] turns a dotted pair list into a list) if (!identical(p1[[1]][i1], p2[[1]][i1])) return(FALSE) last <- calls2[(n1 + 1):n2] all(last %in% empty_calls) } # if all calls are in these elements, the plot is basically empty empty_calls <- c("layout", "par", "clip") empty_calls <- c( "palette", "palette2", sprintf("C_%s", c(empty_calls, "strWidth", "strHeight", "plot_window")) ) is.empty <- function(x) { if (is.null(x)) return(TRUE) pc <- plot_calls(x) if (length(pc) == 0) return(TRUE) all(pc %in% empty_calls) } plot_calls <- function(plot) { el <- lapply(plot[[1]], "[[", 2) if (length(el) == 0) return() unlist(lapply(el, function(x) { # grid graphics do not have x[[1]]$name if (!is.null(nm <- x[[1]][["name"]])) return(nm) nm <- deparse(x[[1]]) # the plot element should not be empty, and ignore calls that are simply # requireNamespace() if (length(x[[2]]) > 0 || !all(grepl("^requireNamespace\\(", nm))) nm })) } evaluate/R/watcher.R0000644000176200001440000000460514574121312014046 0ustar liggesusers#' Watch for changes in output, text and graphical. #' #' @param debug activate debug mode where output will be both printed to #' screen and captured. #' @return list containing four functions: `get_new`, `pause`, #' `unpause`, `close`. #' @keywords internal watchout <- function(debug = FALSE) { output <- character() prev <- character() con <- textConnection("output", "wr", local = TRUE) sink(con, split = debug) list( get_new = function(plot = FALSE, incomplete_plots = FALSE, text_callback = identity, graphics_callback = identity) { incomplete <- test_con(con, isIncomplete) if (incomplete) cat("\n") out <- list() if (plot) { out$graphics <- plot_snapshot(incomplete_plots) if (!is.null(out$graphics)) graphics_callback(out$graphics) } n0 <- length(prev) n1 <- length(output) if (n1 > n0) { new <- output[n0 + seq_len(n1 - n0)] prev <<- output out$text <- paste0(new, collapse = "\n") if (!incomplete) out$text <- paste0(out$text, "\n") text_callback(out$text) } unname(out) }, pause = function() sink(), unpause = function() sink(con, split = debug), close = function() { if (!test_con(con, isOpen)) con_error('The connection has been closed') sink() close(con) output }, get_con = function() con ) } test_con = function(con, test) { tryCatch(test(con), error = function(e) con_error(e$message)) } con_error = function(x) stop( x, '... Please make sure not to call closeAllConnections().', call. = FALSE ) .env = new.env() .env$flush_console = function() {} #' An emulation of flush.console() in evaluate() #' #' When [evaluate()] is evaluating code, the text output is diverted into #' an internal connection, and there is no way to flush that connection. This #' function provides a way to "flush" the connection so that any text output can #' be immediately written out, and more importantly, the `text` handler #' (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. #' @note This function is supposed to be called inside `evaluate()` (e.g. #' either a direct `evaluate()` call or in \pkg{knitr} code chunks). #' @export flush_console = function() .env$flush_console() evaluate/R/output.R0000644000176200001440000001164314630061442013751 0ustar liggesusers#' Object class tests #' @export is.message is.warning is.error is.value is.source is.recordedplot #' @aliases is.message is.warning is.error is.value is.source is.recordedplot #' @keywords internal #' @rdname is.message is.message <- function(x) inherits(x, "message") #' @rdname is.message is.warning <- function(x) inherits(x, "warning") #' @rdname is.message is.error <- function(x) inherits(x, "error") #' @rdname is.message is.value <- function(x) inherits(x, "value") #' @rdname is.message is.source <- function(x) inherits(x, "source") #' @rdname is.message is.recordedplot <- function(x) inherits(x, "recordedplot") new_value <- function(value, visible = TRUE) { structure(list(value = value, visible = visible), class = "value") } new_source <- function(src, call, handler = NULL) { src <- structure(list(src = src), class = "source") if (is.null(handler)) { return(src) } n_args <- length(formals(handler)) if (n_args == 1) { # Old format only called for side effects handler(src) src } else if (n_args == 2) { # New format can influence result handler(src, call) } else { stop("Source output handler must have one or two arguments") } } classes <- function(x) vapply(x, function(x) class(x)[1], character(1)) render <- function(x) if (isS4(x)) methods::show(x) else print(x) #' Custom output handlers. #' #' An `output_handler` handles the results of [evaluate()], #' including the values, graphics, conditions. Each type of output is handled by #' a particular function in the handler object. #' #' The handler functions should accept an output object as their first argument. #' The return value of the handlers is ignored, except in the case of the #' `value` handler, where a visible return value is saved in the output #' list. #' #' Calling the constructor with no arguments results in the default handler, #' which mimics the behavior of the console by printing visible values. #' #' Note that recursion is common: for example, if `value` does any #' printing, then the `text` or `graphics` handlers may be called. #' #' @param source Function to handle the echoed source code under evaluation. #' This function should take two arguments (`src` and `call`), and return #' an object that will be inserted into the evaluate outputs. `src` is the #' unparsed text of the source code, and `call` is the parsed language object #' If `src` is unparsable, `call` will be `expression()`. #' #' 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 #' [recordPlot()]. #' @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. If it #' only has one argument, only visible values are handled; if it has more #' arguments, the second argument indicates whether the value is visible. #' @param calling_handlers List of [calling handlers][withCallingHandlers]. #' These handlers have precedence over the exiting handler installed #' by [evaluate()] when `stop_on_error` is set to 0. #' @return A new `output_handler` object #' @aliases output_handler #' @export new_output_handler <- function(source = identity, text = identity, graphics = identity, message = identity, warning = identity, error = identity, value = render, calling_handlers = list()) { source <- match.fun(source) stopifnot(length(formals(source)) >= 1) text <- match.fun(text) stopifnot(length(formals(text)) >= 1) graphics <- match.fun(graphics) stopifnot(length(formals(graphics)) >= 1) message <- match.fun(message) stopifnot(length(formals(message)) >= 1) warning <- match.fun(warning) stopifnot(length(formals(warning)) >= 1) error <- match.fun(error) stopifnot(length(formals(error)) >= 1) value <- match.fun(value) stopifnot(length(formals(value)) >= 1) 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") } check_handlers <- function(x) { if (!is.list(x)) { stop_bad_handlers() } if (!length(x)) { return() } names <- names(x) if (!is.character(names) || anyNA(names) || any(names == "")) { stop_bad_handlers() } for (elt in x) { if (!is.function(elt)) { stop_bad_handlers() } } } stop_bad_handlers <- function() { stop(simpleError( "`calling_handlers` must be a named list of functions.", call = call("new_output_handler") )) } default_output_handler <- new_output_handler() evaluate/R/replay.R0000644000176200001440000000537314574121312013710 0ustar liggesusers#' Replay a list of evaluated results. #' #' Replay a list of evaluated results, as if you'd run them in an R #' terminal. #' #' @param x result from [evaluate()] #' @export #' @examples #' samples <- system.file("tests", "testthat", package = "evaluate") #' if (file_test("-d", samples)) { #' replay(evaluate(file(file.path(samples, "order.R")))) #' replay(evaluate(file(file.path(samples, "plot.R")))) #' replay(evaluate(file(file.path(samples, "data.R")))) #' } replay <- function(x) UseMethod("replay", x) #' @export replay.list <- function(x) { invisible(lapply(x, replay)) } #' @export replay.default <- function(x) { render(x) } #' @export replay.character <- function(x) { cat(x) } #' @export replay.source <- function(x) { s <- if (is.null(attr(x$src,'timing'))) '' else render_timing(attr(x$src, 'timing')) cat(paste0(s, line_prompt(x$src))) } #' @export replay.warning <- function(x) { message("Warning message:\n", x$message) } #' @export replay.message <- function(x) { message(sub("\n$", "", x$message)) } #' @export replay.error <- function(x) { if (is.null(x$call)) { message("Error: ", x$message) } else { call <- deparse(x$call) message("Error in ", call, ": ", x$message) } } #' @export replay.value <- function(x) { if (x$visible) print(x$value) } #' @export replay.recordedplot <- function(x) { print(x) } render_timing <- function(t) { if (max(t) < 0.5) '' else paste0( '[', render_sec(t[[1]] + t[[2]]), # User time + Kernel time ',', render_sec(t[[3]]), # Wall time ']' ) } render_sec <- function(s) { if (s < 0.005) return('<5ms') if (s < 1) return(paste0(round(s,2), 's')) if (s < 10) return(paste0(round(s,1), 's')) sec <- round(s,0) if (sec < 120) return(paste0(sec, 's')) min <- floor(sec/60) sec <- sec - min*60 if (min < 10) return(paste0( min, 'm', formatC(sec, digits = 0, width = 2, format = "f", flag = "0"), 's' )) min <- min + round(sec/60, 0) if (min < 120) return(paste0(min, 'm')) h <- floor(min/60) min <- min - h * 60 if (h < 48) return(paste0( h, 'h', formatC(min, digits = 0, width = 2, format = "f", flag = "0"), 'm' )) d <- floor(h/24) h <- h - d*24 return(paste0(d, 'd', h, 'h')) } #' Line prompt. #' #' Format a single expression as if it had been entered at the command prompt. #' #' @param x string representing a single expression #' @param prompt prompt for first line #' @param continue prompt for subsequent lines #' @keywords internal #' @return a string line_prompt <- function(x, prompt = getOption("prompt"), continue = getOption("continue")) { lines <- strsplit(x, "\n")[[1]] n <- length(lines) lines[1] <- paste0(prompt, lines[1]) if (n > 1) lines[2:n] <- paste0(continue, lines[2:n]) paste0(lines, "\n", collapse = "") } evaluate/R/eval.R0000644000176200001440000002726114630061442013343 0ustar liggesusers#' Evaluate input and return all details of evaluation. #' #' Compare to [eval()], `evaluate` captures all of the #' information necessary to recreate the output as if you had copied and pasted #' the code into a R terminal. It captures messages, warnings, errors and #' output, all correctly interleaved in the order in which they occured. It #' stores the final result, whether or not it should be visible, and the #' contents of the current graphics device. #' #' @export #' @param input input object to be parsed and evaluated. May be a string, file #' connection or function. Passed on to [parse_all()]. #' @param envir environment in which to evaluate expressions. #' @param enclos when `envir` is a list or data frame, this is treated as #' the parent environment to `envir`. #' @param debug if `TRUE`, displays information useful for debugging, #' including all output that evaluate captures. #' @param stop_on_error if `2`, evaluation will halt on first error and you #' will get no results back. If `1`, evaluation will stop on first error #' without signaling the error, and you will get back all results up to that #' point. If `0` will continue running all code, just as if you'd pasted #' the code into the command line. #' @param keep_warning,keep_message whether to record warnings and messages; if #' `FALSE`, messages will be suppressed; if `NA`, they will not be captured #' (normally they will be sent to the console). Note that if the environment #' variable `R_EVALUATE_BYPASS_MESSAGES` is set to true, these arguments will #' always be set to `NA`, meaning that messages will not be captured by this #' function. #' @param log_echo,log_warning If `TRUE`, will immediately log code and #' warnings (respectively) to `stderr`. #' @param new_device if `TRUE`, will open a new graphics device and #' automatically close it after completion. This prevents evaluation from #' interfering with your existing graphics environment. #' @param output_handler an instance of [output_handler()] that #' 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 if `TRUE`, evaluate will wrap each input #' expression in `system.time()`, which will be accessed by following #' `replay()` call to produce timing information for each evaluated #' command. #' @import graphics grDevices utils evaluate <- function(input, envir = parent.frame(), enclos = NULL, debug = FALSE, stop_on_error = 0L, keep_warning = TRUE, keep_message = TRUE, log_echo = FALSE, log_warning = FALSE, new_device = TRUE, output_handler = default_output_handler, filename = NULL, include_timing = FALSE) { stop_on_error <- as.integer(stop_on_error) stopifnot(length(stop_on_error) == 1) parsed <- parse_all(input, filename, stop_on_error != 2L) if (inherits(err <- attr(parsed, 'PARSE_ERROR'), 'error')) { source <- new_source(parsed$src, expression(), output_handler$source) output_handler$error(err) err$call <- NULL # the call is unlikely to be useful return(list(source, err)) } if (is.null(enclos)) { enclos <- if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv() } if (new_device) { # Start new graphics device and clean up afterwards if (identical(grDevices::pdf, getOption("device"))) { dev.new(file = NULL) } else dev.new() dev.control(displaylist = "enable") dev <- dev.cur() on.exit(dev.off(dev)) } # record the list of current devices devs <- .env$dev_list; on.exit(.env$dev_list <- devs, add = TRUE) devn <- length(.env$dev_list <- dev.list()) dev <- dev.cur() # clean up the last_plot object after an evaluate() call (cf yihui/knitr#722) on.exit(assign("last_plot", NULL, envir = environment(plot_snapshot)), add = TRUE) # if this env var is set to true, always bypass messages if (tolower(Sys.getenv('R_EVALUATE_BYPASS_MESSAGES')) == 'true') keep_message = keep_warning = NA out <- vector("list", nrow(parsed)) for (i in seq_along(out)) { # if dev.off() was called, make sure to restore device to the one opened by # evaluate() or existed before evaluate() if (length(dev.list()) < devn) dev.set(dev) devn <- length(dev.list()) expr <- parsed$expr[[i]] if (!is.null(expr)) expr <- as.expression(expr) out[[i]] <- evaluate_call( expr, parsed$src[[i]], envir = envir, enclos = enclos, debug = debug, last = i == length(out), use_try = stop_on_error != 2L, keep_warning = keep_warning, keep_message = keep_message, log_echo = log_echo, log_warning = log_warning, output_handler = output_handler, include_timing = include_timing ) if (stop_on_error > 0L) { errs <- vapply(out[[i]], is.error, logical(1)) if (!any(errs)) next if (stop_on_error == 1L) break } } is_empty <- vapply(out, identical, list(NULL), FUN.VALUE = logical(1)) out <- out[!is_empty] unlist(out, recursive = FALSE, use.names = FALSE) } evaluate_call <- function(call, src = NULL, envir = parent.frame(), enclos = NULL, debug = FALSE, last = FALSE, use_try = FALSE, keep_warning = TRUE, keep_message = TRUE, log_echo = FALSE, log_warning = FALSE, output_handler = new_output_handler(), include_timing = FALSE) { if (debug) message(src) if (is.null(call) && !last) { source <- new_source(src, call[[1]], output_handler$source) return(list(source)) } stopifnot(is.call(call) || is.language(call) || is.atomic(call) || is.null(call)) # Capture output w <- watchout(debug) on.exit(w$close()) # Capture error output from try() (#88) old_try_outfile <- options(try.outFile = w$get_con()) on.exit(options(old_try_outfile), add = TRUE) if (log_echo && !is.null(src)) { cat(src, "\n", sep = "", file = stderr()) } source <- new_source(src, call[[1]], output_handler$source) output <- list(source) dev <- dev.cur() handle_output <- function(plot = FALSE, incomplete_plots = FALSE) { # if dev.cur() has changed, we should not record plots any more plot <- plot && identical(dev, dev.cur()) out <- w$get_new(plot, incomplete_plots, output_handler$text, output_handler$graphics) output <<- c(output, out) } flush_old <- .env$flush_console; on.exit({ .env$flush_console <- flush_old }, add = TRUE) .env$flush_console <- function() handle_output(FALSE) # Hooks to capture plot creation capture_plot <- function() { handle_output(TRUE) } hook_list <- list( persp = capture_plot, before.plot.new = capture_plot, before.grid.newpage = capture_plot ) set_hooks(hook_list) on.exit(remove_hooks(hook_list), add = TRUE) handle_condition <- function(cond) { handle_output() output <<- c(output, list(cond)) } # Handlers for warnings, errors and messages wHandler <- function(wn) { if (log_warning) { cat(format_warning(wn), "\n", sep = "", file = stderr()) } if (is.na(keep_warning)) return() # do not handle the warning as it will be raised as error after if (getOption("warn") >= 2) return() if (keep_warning && getOption("warn") >= 0) { handle_condition(wn) output_handler$warning(wn) } invokeRestart("muffleWarning") } eHandler <- if (use_try) function(e) { handle_condition(e) output_handler$error(e) } else identity mHandler <- if (is.na(keep_message)) identity else function(m) { if (keep_message) { handle_condition(m) output_handler$message(m) } invokeRestart("muffleMessage") } ev <- list(value = NULL, visible = FALSE) if (use_try) { handle <- function(f) try(f, silent = TRUE) } else { handle <- force } value_handler <- output_handler$value if (include_timing) { timing_fn <- function(x) system.time(x)[1:3] } else { timing_fn <- function(x) {x; NULL}; } if (length(funs <- .env$inject_funs)) { funs_names <- names(funs) funs_new <- !vapply(funs_names, exists, logical(1), envir, inherits = FALSE) funs_names <- funs_names[funs_new] funs <- funs[funs_new] on.exit(rm(list = funs_names, envir = envir), add = TRUE) for (i in seq_along(funs_names)) assign(funs_names[i], funs[[i]], envir) } user_handlers <- output_handler$calling_handlers multi_args <- length(formals(value_handler)) > 1 for (expr in call) { srcindex <- length(output) time <- timing_fn(handle( ev <- withCallingHandlers( withVisible(eval_with_user_handlers(expr, envir, enclos, user_handlers)), warning = wHandler, error = eHandler, message = mHandler ) )) handle_output(TRUE) if (!is.null(time)) attr(output[[srcindex]]$src, 'timing') <- time # If visible or the value handler has multi args, process and capture output if (ev$visible || multi_args) { pv <- list(value = NULL, visible = FALSE) value_fun <- if (multi_args) value_handler else { function(x, visible) value_handler(x) } handle(pv <- withCallingHandlers(withVisible( value_fun(ev$value, ev$visible) ), warning = wHandler, error = eHandler, message = mHandler)) handle_output(TRUE) # If the return value is visible, save the value to the output if (pv$visible) output <- c(output, list(pv$value)) } } # Always capture last plot, even if incomplete if (last) { handle_output(TRUE, TRUE) } output } eval_with_user_handlers <- function(expr, envir, enclos, calling_handlers) { if (!length(calling_handlers)) { return(eval(expr, envir, enclos)) } if (!is.list(calling_handlers)) { stop("`calling_handlers` must be a list", call. = FALSE) } call <- as.call(c( quote(withCallingHandlers), quote(eval(expr, envir, enclos)), calling_handlers )) eval(call) } #' Inject functions into the environment of `evaluate()` #' #' Create functions in the environment specified in the `envir` argument of #' [evaluate()]. This can be helpful if you want to substitute certain #' functions when evaluating the code. To make sure it does not wipe out #' existing functions in the environment, only functions that do not exist in #' the environment are injected. #' @param ... Named arguments of functions. If empty, previously injected #' functions will be emptied. #' @note For expert use only. Do not use it unless you clearly understand it. #' @keywords internal #' @examples library(evaluate) #' # normally you cannot capture the output of system #' evaluate("system('R --version')") #' #' # replace the system() function #' inject_funs(system = function(...) cat(base::system(..., intern = TRUE), sep = '\n')) #' #' evaluate("system('R --version')") #' #' inject_funs() # empty previously injected functions #' @export inject_funs <- function(...) { funs <- list(...) funs <- funs[names(funs) != ''] .env$inject_funs <- Filter(is.function, funs) } format_warning <- function(x) { if (inherits(x, "rlang_warning")) { format(x) } else { msg <- "Warning" call <- conditionCall(x) if (!is.null(conditionCall(x))) { msg <- paste0(msg, " in ", paste0(deparse(call), collapse = "\n")) } msg <- paste0(msg, ": ", conditionMessage(x)) } } evaluate/NAMESPACE0000644000176200001440000000142313506131227013277 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(parse_all,"function") S3method(parse_all,call) S3method(parse_all,character) S3method(parse_all,connection) S3method(parse_all,default) S3method(replay,character) S3method(replay,default) S3method(replay,error) S3method(replay,list) S3method(replay,message) S3method(replay,recordedplot) S3method(replay,source) S3method(replay,value) S3method(replay,warning) export(create_traceback) export(evaluate) export(flush_console) export(inject_funs) export(is.error) export(is.message) export(is.recordedplot) export(is.source) export(is.value) export(is.warning) export(new_output_handler) export(parse_all) export(remove_hooks) export(replay) export(set_hooks) export(try_capture_stack) import(grDevices) import(graphics) import(utils) evaluate/LICENSE0000644000176200001440000000005614574121312013066 0ustar liggesusersYEAR: 2023 COPYRIGHT HOLDER: evaluate authors evaluate/NEWS.md0000644000176200001440000002300514630660537013170 0ustar liggesusers# evaluate 0.24.0 * The `source` output handler can now take two arguments (the unparsed `src` and the parsed `call`) and choose to affect the displayed source. # Version 0.23 - Prevent existing plots from leaking into `evaluate()` results (thanks, @dmurdoch, yihui/knitr#2297). - If the environment variable `R_EVALUATE_BYPASS_MESSAGES` is set to true, the arguments `keep_message` and `keep_warning` of `evaluate()` will be set to `NA`, regardless of user input, which means messages and warnings will not be captured by `evaluate()`. This provides a possibility to force logging messages and warnings (thanks, @slodge, yihui/yihui.org#1458). # Version 0.22 - Fixed a problem in the internal function `plot_calls()` that made the examples of `recordGraphics` fail to run on its help page (thanks, Kurt Hornik). # 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 `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). # Version 0.20 - The arguments `keep_message` and `keep_warning` of `evaluate()` can take the value `NA` now, which means `evaluate()` will not capture the messages and they will be sent to the console. This is equivalent to the `FALSE` value before v0.19 (thanks, @gadenbuie, https://github.com/yihui/yihui.org/discussions/1458). # Version 0.19 - In `evaluate()`, `keep_message` and `keep_warning` will completely drop messages and warnings, respectively, when their values are `FALSE`. Previously messages would still be emitted (to the console) even if they take `FALSE` values. - Fixed the bug that `parse_all()` fails with line directives (thanks, @ArcadeAntics, #114). # Version 0.18 - Fixed tests that were still using the deprecated `ggplot2::qplot()`. # Version 0.17 - Adapted a unit test to the next version of **ggplot2** (thanks, @thomasp85, #113). # Version 0.16 - Fixed a bug that an empty **ggplot2** plot could be recorded and incorrectly saved (thanks, @sjspielman, rstudio/rmarkdown#2363). # Version 0.15 - `new_output_handler()` gains a `calling_handlers` argument. These are passed to `withCallingHandlers()` before `evaluate()` captures any conditions. - Fixed #106: do not assume that `is.atomic(NULL)` returns `TRUE` (thanks, @mmaechler). # Version 0.14 - The hooks `persp`, `before.plot.new`, and `before.grid.newpage` set by users will be respected throughout the R session (thanks, @KKPMW, #96). # Version 0.13 - Errors generated by try() are now part of the output (for R >= 3.4). To achieve this, the try.outFile option is set for the duration of all evaluations (thanks, @krlmlr, #91) # Version 0.12 - Removed the stringr dependency (thanks, @mllg, #90). # Version 0.11 - Fix for regression introduced in 0.10.1 in parse_all.call() (fixes #77) - evaluate() now respects options(warn >= 2); all warnings are turned into errors (#81) # Version 0.10.1 - Added parse_all.call() method to use the original source for evaluating call objects (because base::deparse() breaks non-ascii source code) (fixes #74) # Version 0.10 - Added option for the evaluate function to include timing information of ran commands. This information will be subsequently rendered by the replay. Example usage: evaluate::replay(evaluate::evaluate('Sys.sleep(1)', include_timing = TRUE)) - Added a new function `flush_console()` to emulate `flush.console()` in `evaluate()` (#61). - Added a `inject_funs()` function to create functions in the environment passed to the `envir` argument of `evaluate()`. # Version 0.9 - Added an argument `allow_error` to `parse_all()` to allow syntactical errors in R source code when `allow_error = TRUE`; this means `evaluate(stop_on_error = 0 or 1)` will no longer stop on syntactical errors but returns a list of source code and the error object instead. This can be useful to show syntactical errors for pedagogical purposes. # Version 0.8.3 - Added an argument `filename` to evaluate() and parse_all() (thanks, @flying-sheep, #58). # Version 0.8 - Changed package license to MIT. # Version 0.7.2 - replay() fails to replay certain objects such as NULL (#53). # Version 0.7 - R 3.0.2 is the minimal required version for this package now. # Version 0.6 - Plots are no longer recorded when the current graphical device has been changed, which may introduce issues like yihui/knitr#824. - `parse_all()` can parse R code that contains multibyte characters correctly now (#49, yihui/knitr#988) # Version 0.5.5 - Actually use the `text` and `graphics` in `new_output_handler` - Multiple expressions separated by `;` on the same line can be printed as expected when the result returned is visible, e.g. both `x` and `y` will be printed when the source code is `x; y`. In previous versions, only `y` is printed. (thanks, Bill Venables) # Version 0.5.3 ## BUG FIXES - fixed the bug reported at https://github.com/yihui/knitr/issues/722 (repeatedly knitting the same code results in plots being omitted randomly) (thanks, Simon Urbanek) # Version 0.5.1 ## BUG FIXES - under R 2.15.x, evaluate() was unable to filter out the plots triggered by clip() (thanks, Uwe Ligges) # Version 0.5 ## NEW FEATURES - evaluate() is better at telling if a new plot should render a new page due to the new par('page') in R 3.0.2 ## BUG FIXES - fixed yihui/knitr#600: when the last expression in the code is a comment, the previous incomplete plot was not captured - the empty plots produced by strwidth(), strheight(), and clip() are no longer recorded ## MAJOR CHANGES - evaluate() no longer records warnings in case of options(warn = -1); see yihui/knitr#610 - for 'output_handler' in evaluate(), visible values from the 'value' handler will be saved to the output list; this makes it possible for users to save the original values instead of their printed side effects; this change will not affect those who use the default output handlers (#40, thanks, Gabriel Becker) - the 'value' handler in new_output_handler() may take an additional argument that means if the value is visible or not; this makes it possible to save the invisible values as well (#41, thanks, Joroen Ooms) # Version 0.4.7 ## NEW FEATURES - added two arguments keep_warning and keep_message in evaluate() so that it is possible not to capture warnings or messages now ## BUG FIXES - fixed #25: plots can be correctly recorded under a complex layout now (#25, thanks, Jack Tanner and Andy Barbour) - fixed yihui/knitr#582: evaluate() misclassified some plot changes as "par changes" and removed some plots when it should not; now it is better at identifying plot changes dur to par() (thanks, Keith Twombley) # Version 0.4.4 ## BUG FIXES - Perspective plots from `persp()` are captured now (thanks to Harvey Lime and Yihui Xie) - If an error occurs during printing a visible value, evaluate will halt on a cryptic error "operator is invalid for atomic vectors" (#26, fixed by Yihui Xie) - If the internal connection was accidentally closed by the user, a more informative message will show up (#23) - Now the graphical device will always try to record graphics by default (when new_device = TRUE) (#34) - Some empty and incomplete plots caused by par() or layout() will be filtered out correctly for R 3.0 (#35) ## MAINTAINENCE - Yihui Xie is the new maintainer of this package now # Version 0.4.3 ## NEW FEATURES - Added `output_handler` argument to `evaluate`. Should be a `output_handler` object, which is a list of functions for handling each type of result, prior to printing of visible return values. This allows clients to override the console-like printing of values, while still processing them in the correct temporal context. The other handlers are necessary to convey the correct ordering of the output. This essentially provides stream-based processing, as an alternative to the existing deferred processing. - New option, `stop_on_error` which controls behaviour when errors occur. The default value, `0`, acts like you've copied and pasted the code into the console, and continues to execute all code. `1` will stop the code execution and return the results of evaluation up to that point, and `2` will raise an error. ## BUG FIXES - Compound expressions like `x <- 10; x` are now evaluated completely. - Chinese characters on windows now work correctly (thanks to Yihui Xie) - Graphics and output interleaved correctly when generated from a loop or other compound statements - By default, `evaluate` will now open a new graphics device and clean it up afterwards. To suppress that behaviour use `new_device = FALSE` - use `show` to display S4 objects. # Version 0.4.2 - replace deprecated `.Internal(eval.with.vis)` with correct `withVisible` - `evaluate` gains `debug` argument # Version 0.4.1 - use `test_package` to avoid problems with latest version of `testthat` # Version 0.4 - Use plot hooks to capture multiple plots created in a loop or within a function. (Contributed by Yihui Xie) # Version 0.3 - Import `stringr` instead of depending on it. - Test plot recording only in the presence of interactive devices. # Version 0.2 - try_capture_stack and create_traceback do a much better job of removing infrastructure calls from the captured traceback - visible results are automatically evaluated and their outputs are captured. This is particularly important for lattice and ggplot graphics, which otherwise require special handling. It also correctly captures warnings, errors and messages raised by the print method. evaluate/README.md0000644000176200001440000000312214627443223013344 0ustar liggesusers# evaluate [![R-CMD-check](https://github.com/r-lib/evaluate/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-lib/evaluate/actions/workflows/R-CMD-check.yaml) [![CRAN status](https://www.r-pkg.org/badges/version/evaluate)](https://CRAN.R-project.org/package=evaluate) [![Downloads from the RStudio CRAN mirror](https://cranlogs.r-pkg.org/badges/evaluate)](https://cran.r-project.org/package=evaluate) [![Codecov test coverage](https://codecov.io/gh/r-lib/evaluate/branch/main/graph/badge.svg)](https://app.codecov.io/gh/r-lib/evaluate?branch=main) evaluate provides tools that allow you to recreate the parsing, evaluation and display of R code, with enough information that you can accurately recreate what happens at the command line. Evaluate + replay works very similarly to `source()`, but is written in such a way to make it easy to adapt for other output formats, such as html or latex. ```R library(evaluate) ``` There are three components to the `evaluate` package: * `parse_all()`, a version of parse that keeps expressions with their original source code, maintaining formatting and comments. * `evaluate()`, which evaluates each expression produced by `parse_all()`, tracking all output, messages, warnings, and errors as their occur, and interleaving them in the correct order with the original source and value of the expression. * `replay()`, which outputs these pieces in a way that makes it look like you've entered the code at the command line. This function also serves as a template for other output formats. evaluate/man/0000755000176200001440000000000014630061442012633 5ustar liggesusersevaluate/man/new_output_handler.Rd0000644000176200001440000000475314630061442017041 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/output.R \name{new_output_handler} \alias{new_output_handler} \alias{output_handler} \title{Custom output handlers.} \usage{ new_output_handler( source = identity, text = identity, graphics = identity, message = identity, warning = identity, error = identity, value = render, calling_handlers = list() ) } \arguments{ \item{source}{Function to handle the echoed source code under evaluation. This function should take two arguments (\code{src} and \code{call}), and return an object that will be inserted into the evaluate outputs. \code{src} is the unparsed text of the source code, and \code{call} is the parsed language object If \code{src} is unparsable, \code{call} will be \code{expression()}. Return \code{src} for the default evaluate behaviour. Return \code{NULL} to drop the source from the output.} \item{text}{Function to handle any textual console output.} \item{graphics}{Function to handle graphics, as returned by \code{\link[=recordPlot]{recordPlot()}}.} \item{message}{Function to handle \code{\link[=message]{message()}} output.} \item{warning}{Function to handle \code{\link[=warning]{warning()}} output.} \item{error}{Function to handle \code{\link[=stop]{stop()}} output.} \item{value}{Function to handle the values returned from evaluation. If it only has one argument, only visible values are handled; if it has more arguments, the second argument indicates whether the value is visible.} \item{calling_handlers}{List of \link[=withCallingHandlers]{calling handlers}. These handlers have precedence over the exiting handler installed by \code{\link[=evaluate]{evaluate()}} when \code{stop_on_error} is set to 0.} } \value{ A new \code{output_handler} object } \description{ An \code{output_handler} handles the results of \code{\link[=evaluate]{evaluate()}}, including the values, graphics, conditions. Each type of output is handled by a particular function in the handler object. } \details{ The handler functions should accept an output object as their first argument. The return value of the handlers is ignored, except in the case of the \code{value} handler, where a visible return value is saved in the output list. Calling the constructor with no arguments results in the default handler, which mimics the behavior of the console by printing visible values. Note that recursion is common: for example, if \code{value} does any printing, then the \code{text} or \code{graphics} handlers may be called. } evaluate/man/try_capture_stack.Rd0000644000176200001440000000075114574121312016653 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/traceback.R \name{try_capture_stack} \alias{try_capture_stack} \title{Try, capturing stack on error.} \usage{ try_capture_stack(quoted_code, env) } \arguments{ \item{quoted_code}{code to evaluate, in quoted form} \item{env}{environment in which to execute code} } \description{ This is a variant of \code{\link[=tryCatch]{tryCatch()}} that also captures the call stack if an error occurs. } \keyword{internal} evaluate/man/is.message.Rd0000644000176200001440000000061714574121312015164 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/output.R \name{is.message} \alias{is.message} \alias{is.warning} \alias{is.error} \alias{is.value} \alias{is.source} \alias{is.recordedplot} \title{Object class tests} \usage{ is.message(x) is.warning(x) is.error(x) is.value(x) is.source(x) is.recordedplot(x) } \description{ Object class tests } \keyword{internal} evaluate/man/remove_hooks.Rd0000644000176200001440000000115214574121312015621 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hooks.R \name{remove_hooks} \alias{remove_hooks} \title{Remove hooks.} \usage{ remove_hooks(hooks) } \arguments{ \item{hooks}{a named list of hooks - each hook can either be a function or a list of functions.} } \description{ This provides a way to remove previously set hook values. } \examples{ new1 <- list(before.plot.new = function() print("Plotted!")) new2 <- list(before.plot.new = function() print("Plotted Again!")) set_hooks(new1) set_hooks(new2) plot(1) remove_hooks(new1) plot(1) remove_hooks(new2) plot(1) } \keyword{internal} evaluate/man/evaluate.Rd0000644000176200001440000000557414574121312014743 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/eval.R \name{evaluate} \alias{evaluate} \title{Evaluate input and return all details of evaluation.} \usage{ evaluate( input, envir = parent.frame(), enclos = NULL, debug = FALSE, stop_on_error = 0L, keep_warning = TRUE, keep_message = TRUE, log_echo = FALSE, log_warning = FALSE, new_device = TRUE, output_handler = default_output_handler, filename = NULL, include_timing = FALSE ) } \arguments{ \item{input}{input object to be parsed and evaluated. May be a string, file connection or function. Passed on to \code{\link[=parse_all]{parse_all()}}.} \item{envir}{environment in which to evaluate expressions.} \item{enclos}{when \code{envir} is a list or data frame, this is treated as the parent environment to \code{envir}.} \item{debug}{if \code{TRUE}, displays information useful for debugging, including all output that evaluate captures.} \item{stop_on_error}{if \code{2}, evaluation will halt on first error and you will get no results back. If \code{1}, evaluation will stop on first error without signaling the error, and you will get back all results up to that point. If \code{0} will continue running all code, just as if you'd pasted the code into the command line.} \item{keep_warning, keep_message}{whether to record warnings and messages; if \code{FALSE}, messages will be suppressed; if \code{NA}, they will not be captured (normally they will be sent to the console). Note that if the environment variable \code{R_EVALUATE_BYPASS_MESSAGES} is set to true, these arguments will always be set to \code{NA}, meaning that messages will not be captured by this function.} \item{log_echo, log_warning}{If \code{TRUE}, will immediately log code and warnings (respectively) to \code{stderr}.} \item{new_device}{if \code{TRUE}, will open a new graphics device and automatically close it after completion. This prevents evaluation from interfering with your existing graphics environment.} \item{output_handler}{an instance of \code{\link[=output_handler]{output_handler()}} that processes the output from the evaluation. The default simply prints the visible return values.} \item{filename}{string overrriding the \code{\link[base:srcfile]{base::srcfile()}} filename.} \item{include_timing}{if \code{TRUE}, evaluate will wrap each input expression in \code{system.time()}, which will be accessed by following \code{replay()} call to produce timing information for each evaluated command.} } \description{ Compare to \code{\link[=eval]{eval()}}, \code{evaluate} captures all of the information necessary to recreate the output as if you had copied and pasted the code into a R terminal. It captures messages, warnings, errors and output, all correctly interleaved in the order in which they occured. It stores the final result, whether or not it should be visible, and the contents of the current graphics device. } evaluate/man/flush_console.Rd0000644000176200001440000000156414574121312015773 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/watcher.R \name{flush_console} \alias{flush_console} \title{An emulation of flush.console() in evaluate()} \usage{ flush_console() } \description{ When \code{\link[=evaluate]{evaluate()}} is evaluating code, the text output is diverted into an internal connection, and there is no way to flush that connection. This function provides a way to "flush" the connection so that any text output can be immediately written out, and more importantly, the \code{text} handler (specified in the \code{output_handler} argument of \code{evaluate()}) will be called, which makes it possible for users to know it when the code produces text output using the handler. } \note{ This function is supposed to be called inside \code{evaluate()} (e.g. either a direct \code{evaluate()} call or in \pkg{knitr} code chunks). } evaluate/man/replay.Rd0000644000176200001440000000115614627443223014430 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/replay.R \name{replay} \alias{replay} \title{Replay a list of evaluated results.} \usage{ replay(x) } \arguments{ \item{x}{result from \code{\link[=evaluate]{evaluate()}}} } \description{ Replay a list of evaluated results, as if you'd run them in an R terminal. } \examples{ samples <- system.file("tests", "testthat", package = "evaluate") if (file_test("-d", samples)) { replay(evaluate(file(file.path(samples, "order.R")))) replay(evaluate(file(file.path(samples, "plot.R")))) replay(evaluate(file(file.path(samples, "data.R")))) } } evaluate/man/set_hooks.Rd0000644000176200001440000000122414574121312015117 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hooks.R \name{set_hooks} \alias{set_hooks} \title{Set hooks.} \usage{ set_hooks(hooks, action = "append") } \arguments{ \item{hooks}{a named list of hooks - each hook can either be a function or a list of functions.} \item{action}{\code{"replace"}, \code{"append"} or \code{"prepend"}} } \description{ This wraps the base \code{\link[=setHook]{setHook()}} function to provide a return value that makes it easy to undo. } \examples{ new <- list(before.plot.new = function() print("Plotted!")) hooks <- set_hooks(new) plot(1) set_hooks(hooks, "replace") plot(1) } \keyword{internal} evaluate/man/create_traceback.Rd0000644000176200001440000000065214574121312016367 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/traceback.R \name{create_traceback} \alias{create_traceback} \title{Generate a traceback from a list of calls.} \usage{ create_traceback(callstack) } \arguments{ \item{callstack}{stack of calls, as generated by (e.g.) \code{\link[base:sys.parent]{base::sys.calls()}}} } \description{ Generate a traceback from a list of calls. } \keyword{internal} evaluate/man/line_prompt.Rd0000644000176200001440000000100214574121312015443 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/replay.R \name{line_prompt} \alias{line_prompt} \title{Line prompt.} \usage{ line_prompt(x, prompt = getOption("prompt"), continue = getOption("continue")) } \arguments{ \item{x}{string representing a single expression} \item{prompt}{prompt for first line} \item{continue}{prompt for subsequent lines} } \value{ a string } \description{ Format a single expression as if it had been entered at the command prompt. } \keyword{internal} evaluate/man/watchout.Rd0000644000176200001440000000077014574121312014764 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/watcher.R \name{watchout} \alias{watchout} \title{Watch for changes in output, text and graphical.} \usage{ watchout(debug = FALSE) } \arguments{ \item{debug}{activate debug mode where output will be both printed to screen and captured.} } \value{ list containing four functions: \code{get_new}, \code{pause}, \code{unpause}, \code{close}. } \description{ Watch for changes in output, text and graphical. } \keyword{internal} evaluate/man/inject_funs.Rd0000644000176200001440000000213014627443223015434 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/eval.R \name{inject_funs} \alias{inject_funs} \title{Inject functions into the environment of \code{evaluate()}} \usage{ inject_funs(...) } \arguments{ \item{...}{Named arguments of functions. If empty, previously injected functions will be emptied.} } \description{ Create functions in the environment specified in the \code{envir} argument of \code{\link[=evaluate]{evaluate()}}. This can be helpful if you want to substitute certain functions when evaluating the code. To make sure it does not wipe out existing functions in the environment, only functions that do not exist in the environment are injected. } \note{ For expert use only. Do not use it unless you clearly understand it. } \examples{ library(evaluate) # normally you cannot capture the output of system evaluate("system('R --version')") # replace the system() function inject_funs(system = function(...) cat(base::system(..., intern = TRUE), sep = '\n')) evaluate("system('R --version')") inject_funs() # empty previously injected functions } \keyword{internal} evaluate/man/parse_all.Rd0000644000176200001440000000147514574121312015073 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parse.R \name{parse_all} \alias{parse_all} \title{Parse, retaining comments.} \usage{ parse_all(x, filename = NULL, allow_error = FALSE) } \arguments{ \item{x}{object to parse. Can be a string, a file connection, or a function. If a connection, will be opened and closed only if it was closed initially.} \item{filename}{string overriding the file name} \item{allow_error}{whether to allow syntax errors in \code{x}} } \value{ A data.frame with columns \code{src}, the source code, and \code{expr}. If there are syntax errors in \code{x} and \code{allow_error = TRUE}, the data frame has an attribute \code{PARSE_ERROR} that stores the error object. } \description{ Works very similarly to parse, but also keeps original formatting and comments. } evaluate/DESCRIPTION0000644000176200001440000000325614631604472013603 0ustar liggesusersType: Package Package: evaluate Title: Parsing and Evaluation Tools that Provide More Details than the Default Version: 0.24.0 Authors@R: c( person("Hadley", "Wickham", , "hadley@posit.co", role = c("aut", "cre")), person("Yihui", "Xie", role = "aut", comment = c(ORCID = "0000-0003-0645-5666")), person("Michael", "Lawrence", role = "ctb"), person("Thomas", "Kluyver", role = "ctb"), person("Jeroen", "Ooms", role = "ctb"), person("Barret", "Schloerke", role = "ctb"), person("Adam", "Ryczkowski", role = "ctb"), person("Hiroaki", "Yutani", role = "ctb"), person("Michel", "Lang", role = "ctb"), person("Karolis", "Koncevičius", role = "ctb"), person("Posit Software, PBC", role = c("cph", "fnd")) ) Description: Parsing and evaluation tools that make it easy to recreate the command line behaviour of R. License: MIT + file LICENSE URL: https://github.com/r-lib/evaluate BugReports: https://github.com/r-lib/evaluate/issues Depends: R (>= 4.0.0) Imports: methods Suggests: covr, ggplot2, lattice, rlang, testthat (>= 3.0.0), withr Config/Needs/website: tidyverse/tidytemplate Config/testthat/edition: 3 Encoding: UTF-8 RoxygenNote: 7.2.3 NeedsCompilation: no Packaged: 2024-06-10 13:33:57 UTC; hadleywickham Author: Hadley Wickham [aut, cre], Yihui Xie [aut] (), Michael Lawrence [ctb], Thomas Kluyver [ctb], Jeroen Ooms [ctb], Barret Schloerke [ctb], Adam Ryczkowski [ctb], Hiroaki Yutani [ctb], Michel Lang [ctb], Karolis Koncevičius [ctb], Posit Software, PBC [cph, fnd] Maintainer: Hadley Wickham Repository: CRAN Date/Publication: 2024-06-10 14:10:02 UTC