|
24 | 24 | #' q <- eval_code(q, quote(library(checkmate)))
|
25 | 25 | #' q <- eval_code(q, expression(assert_number(a)))
|
26 | 26 | #'
|
27 |
| -#' @aliases eval_code,qenv,character-method |
28 |
| -#' @aliases eval_code,qenv,language-method |
29 |
| -#' @aliases eval_code,qenv,expression-method |
30 |
| -#' @aliases eval_code,qenv.error,ANY-method |
| 27 | +#' @aliases eval_code,qenv-method |
31 | 28 | #'
|
32 | 29 | #' @export
|
33 | 30 | setGeneric("eval_code", function(object, code, cache = FALSE, ...) standardGeneric("eval_code"))
|
34 | 31 |
|
35 | 32 | setMethod("eval_code", signature = c(object = "qenv"), function(object, code, cache = FALSE, ...) {
|
36 | 33 | code <- .preprocess_code(code) # preprocess code to ensure it is a character vector
|
37 |
| - srcref <- attr(code, "wholeSrcref") |
38 |
| - if (is.expression(code) && length(srcref) == 0L) { |
39 |
| - result <- Reduce(function(u, v) { |
40 |
| - if (inherits(v, "=") && identical(typeof(v), "language")) { |
41 |
| - # typeof(`=`) is language, but it doesn't dispatch on it, so we need to |
42 |
| - # explicitly pass it as first class of the object |
43 |
| - class(v) <- unique(c("language", class(v))) |
44 |
| - } |
45 |
| - .eval_code(u, v, cache = FALSE, ...) |
46 |
| - }, init = object, x = code) |
47 |
| - return(result) |
48 |
| - } else if (is.expression(code)) { |
49 |
| - code <- paste(attr(code, "wholeSrcref"), collapse = "\n") |
50 |
| - } |
51 | 34 | .eval_code(object = object, code = code, cache = cache, ...)
|
52 | 35 | })
|
53 | 36 |
|
@@ -117,7 +100,17 @@ setMethod("eval_code", signature = c(object = "qenv.error"), function(object, co
|
117 | 100 | }
|
118 | 101 |
|
119 | 102 | setGeneric(".preprocess_code", function(code) standardGeneric(".preprocess_code"))
|
120 |
| -setMethod(".preprocess_code", signature = c("ANY"), function(code) as.character(code)) |
| 103 | +setMethod(".preprocess_code", signature = c("ANY"), function(code) paste(code, collapse = "\n")) |
121 | 104 | setMethod(".preprocess_code", signature = c("language"), function(code) {
|
122 |
| - paste(vapply(lang2calls(code), deparse1, collapse = "\n", character(1L))) |
| 105 | + paste( |
| 106 | + vapply(lang2calls(code), deparse1, collapse = "\n", character(1L)), |
| 107 | + collapse = "\n" |
| 108 | + ) |
| 109 | +}) |
| 110 | +setMethod(".preprocess_code", signature = c("expression"), function(code) { |
| 111 | + if (length(attr(code, "wholeSrcref")) == 0L) { |
| 112 | + paste(lang2calls(code), collapse = "\n") |
| 113 | + } else { |
| 114 | + paste(attr(code, "wholeSrcref"), collapse = "\n") |
| 115 | + } |
123 | 116 | })
|
0 commit comments