diff --git a/R/eval.R b/R/eval.R index 0e599ce0..af1703ae 100644 --- a/R/eval.R +++ b/R/eval.R @@ -95,12 +95,9 @@ evaluate <- function(input, 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]], + out[[i]] <- evaluate_top_level_expression( + exprs = parsed$expr[[i]], + src = parsed$src[[i]], envir = envir, enclos = enclos, debug = debug, @@ -128,27 +125,22 @@ evaluate <- function(input, 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) { +evaluate_top_level_expression <- function(exprs, + 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) { + stopifnot(is.expression(exprs)) 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()) @@ -161,7 +153,7 @@ evaluate_call <- function(call, cat(src, "\n", sep = "", file = stderr()) } - source <- new_source(src, call[[1]], output_handler$source) + source <- new_source(src, exprs[[1]], output_handler$source) output <- list(source) dev <- dev.cur() @@ -249,7 +241,7 @@ evaluate_call <- function(call, user_handlers <- output_handler$calling_handlers multi_args <- length(formals(value_handler)) > 1 - for (expr in call) { + for (expr in exprs) { srcindex <- length(output) time <- timing_fn(handle( ev <- withCallingHandlers( diff --git a/R/parse.R b/R/parse.R index b896a9df..f57cb868 100644 --- a/R/parse.R +++ b/R/parse.R @@ -7,11 +7,30 @@ #' 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. +#' @return +#' A data frame with columns `src`, a character vector of source code, and +#' `expr`, a list-column of parsed expressions. There will be one row for each +#' top-level expression in `x`. A top-level expression is a complete expression +#' which would trigger execution if typed at the console. The `expression` +#' object in `expr` can be of any length: it will be 0 if the top-level +#' expression contains only whitespace and/or comments; 1 if the top-level +#' expression is a single scalar (like `TRUE`, `1`, or `"x"`), name, or call; +#' or 2 if the top-level expression uses `;` to put multiple expressions on +#' one line. +#' +#' 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 +#' source <- " +#' # a comment +#' x +#' x;y +#' " +#' parsed <- parse_all(source) +#' lengths(parsed$expr) +#' str(parsed$expr) +#' parse_all <- function(x, filename = NULL, allow_error = FALSE) UseMethod("parse_all") #' @export @@ -40,7 +59,7 @@ parse_all.character <- function(x, filename = NULL, allow_error = FALSE) { # 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)))) + return(data.frame(src = append_break(x), expr = I(rep(list(expression()), n)))) } srcref <- attr(exprs, "srcref", exact = TRUE) @@ -78,7 +97,7 @@ parse_all.character <- function(x, filename = NULL, allow_error = FALSE) { r <- p[1]:p[2] data.frame( src = x[r], - expr = I(rep(list(NULL), p[2] - p[1] + 1)), + expr = I(rep(list(expression()), p[2] - p[1] + 1)), line = r - 1 ) })) diff --git a/man/parse_all.Rd b/man/parse_all.Rd index 7b8a0f13..26eee692 100644 --- a/man/parse_all.Rd +++ b/man/parse_all.Rd @@ -15,11 +15,31 @@ If a connection, will be opened and closed only if it was closed initially.} \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. +A data frame with columns \code{src}, a character vector of source code, and +\code{expr}, a list-column of parsed expressions. There will be one row for each +top-level expression in \code{x}. A top-level expression is a complete expression +which would trigger execution if typed at the console. The \code{expression} +object in \code{expr} can be of any length: it will be 0 if the top-level +expression contains only whitespace and/or comments; 1 if the top-level +expression is a single scalar (like \code{TRUE}, \code{1}, or \code{"x"}), name, or call; +or 2 if the top-level expression uses \verb{;} to put multiple expressions on +one line. + +If there are syntax errors in \code{x} and \code{allow_error = TRUE}, the data +frame will have an attribute \code{PARSE_ERROR} that stores the error object. } \description{ Works very similarly to parse, but also keeps original formatting and comments. } +\examples{ +source <- " + # a comment + x + x;y +" +parsed <- parse_all(source) +lengths(parsed$expr) +str(parsed$expr) + +} diff --git a/tests/testthat/test-eval.R b/tests/testthat/test-eval.R index ee7bef8f..1879d495 100644 --- a/tests/testthat/test-eval.R +++ b/tests/testthat/test-eval.R @@ -1,3 +1,12 @@ +test_that("can evaluate expressions of all lengths", { + source <- " + # a comment + 1 + x <- 2; x + " + expect_no_error(evaluate(source)) +}) + test_that("log_echo causes output to be immediately written to stderr()", { f <- function() { 1 diff --git a/tests/testthat/test-parse.R b/tests/testthat/test-parse.R index b66957c9..2c592125 100644 --- a/tests/testthat/test-parse.R +++ b/tests/testthat/test-parse.R @@ -1,3 +1,12 @@ +test_that("expr is always an expression", { + expect_equal(parse_all("#")$expr[[1]], expression()) + expect_equal(parse_all("1")$expr[[1]], expression(1), ignore_attr = "srcref") + expect_equal(parse_all("1;2")$expr[[1]], expression(1, 2), ignore_attr = "srcref") + + parsed <- parse_all("#\n1\n1;2") + expect_equal(lengths(parsed$expr), c(0, 1, 2)) +}) + test_that("{ not removed", { f <- function() {