Skip to content

Commit

Permalink
Apply full tidyverse style
Browse files Browse the repository at this point in the history
  • Loading branch information
hadley committed Aug 21, 2024
1 parent 87ce0d7 commit 9567cce
Show file tree
Hide file tree
Showing 17 changed files with 39 additions and 32 deletions.
3 changes: 1 addition & 2 deletions R/evaluate.R
Original file line number Diff line number Diff line change
Expand Up @@ -78,11 +78,10 @@ evaluate <- function(input,
output_handler = NULL,
filename = NULL,
include_timing = FALSE) {

on_error <- check_stop_on_error(stop_on_error)

# if this env var is set to true, always bypass messages
if (env_var_is_true('R_EVALUATE_BYPASS_MESSAGES')) {
if (env_var_is_true("R_EVALUATE_BYPASS_MESSAGES")) {
keep_message <- NA
keep_warning <- NA
}
Expand Down
3 changes: 2 additions & 1 deletion R/evaluation.R
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,8 @@ print.evaluate_evaluation <- function(x, ...) {
}
} else {
cat_line("Other: ")
cat(" "); str(component, indent.str = " ")
cat(" ")
str(component, indent.str = " ")
}
}

Expand Down
2 changes: 1 addition & 1 deletion R/flush-console.R
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@
#' 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() {
flush_console <- function() {
if (!is.null(the$console_flusher)) {
the$console_flusher()
}
Expand Down
4 changes: 2 additions & 2 deletions R/inject-funs.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@
#'
#' # replace the system() function
#' old <- inject_funs(system = function(...) {
#' cat(base::system(..., intern = TRUE), sep = '\n')
#' cat(base::system(..., intern = TRUE), sep = "\n")
#' })
#'
#' evaluate("system('R --version')")
Expand All @@ -26,7 +26,7 @@
#' @export
inject_funs <- function(...) {
funs <- list(...)
funs <- funs[names(funs) != '']
funs <- funs[names(funs) != ""]
old <- the$inject_funs
the$inject_funs <- Filter(is.function, funs)

Expand Down
4 changes: 2 additions & 2 deletions R/parse_all.R
Original file line number Diff line number Diff line change
Expand Up @@ -79,9 +79,9 @@ parse_all.character <- function(x, filename = NULL, allow_error = FALSE) {
src <- srcfilecopy(filename, x)
if (allow_error) {
exprs <- tryCatch(parse(text = x, srcfile = src), error = identity)
if (inherits(exprs, 'error')) {
if (inherits(exprs, "error")) {
return(structure(
data.frame(src = paste(x, collapse = '\n'), expr = empty_expr()),
data.frame(src = paste(x, collapse = "\n"), expr = empty_expr()),
PARSE_ERROR = exprs
))
}
Expand Down
3 changes: 2 additions & 1 deletion R/replay.R
Original file line number Diff line number Diff line change
Expand Up @@ -92,8 +92,9 @@ line_prompt <- function(x, prompt = getOption("prompt"), continue = getOption("c
n <- length(lines)

lines[1] <- paste0(prompt, lines[1])
if (n > 1)
if (n > 1) {
lines[2:n] <- paste0(continue, lines[2:n])
}

paste0(lines, "\n", collapse = "")
}
2 changes: 0 additions & 2 deletions R/reproducible-output.R
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,6 @@ local_reproducible_output <- function(width = 80,
hyperlinks = FALSE,
rstudio = FALSE,
frame = parent.frame()) {

local_options(
# crayon
crayon.enabled = color,
Expand All @@ -46,7 +45,6 @@ local_reproducible_output <- function(width = 80,

# rlang
rlang_interactive = FALSE,

.frame = frame
)

Expand Down
4 changes: 3 additions & 1 deletion R/traceback.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,9 @@
#' @keywords internal
#' @export
create_traceback <- function(callstack) {
if (length(callstack) == 0) return()
if (length(callstack) == 0) {
return()
}

# Convert to text
calls <- lapply(callstack, deparse, width = 500)
Expand Down
3 changes: 2 additions & 1 deletion R/watchout.R
Original file line number Diff line number Diff line change
Expand Up @@ -81,8 +81,9 @@ watchout <- function(handler = new_output_handler(),
}

print_value <- function(value, visible, envir) {
if (!show_value(handler, visible))
if (!show_value(handler, visible)) {
return()
}

pv <- withVisible(handle_value(handler, value, visible, envir))
capture_plot_and_output()
Expand Down
2 changes: 1 addition & 1 deletion man/inject_funs.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion tests/testthat/test-conditions.R
Original file line number Diff line number Diff line change
Expand Up @@ -131,7 +131,7 @@ test_that("all three starts of stop_on_error work as expected", {
test_that("errors during printing are captured", {
methods::setClass("A", contains = "function", where = environment())
methods::setMethod("show", "A", function(object) stop("B"))
a <- methods::new('A', function() b)
a <- methods::new("A", function() b)

ev <- evaluate("a")
expect_output_types(ev, c("source", "error"))
Expand Down
2 changes: 1 addition & 1 deletion tests/testthat/test-evaluate.R
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@ test_that("terminal newline not needed", {
test_that("S4 methods are displayed with show, not print", {
methods::setClass("A", contains = "function", where = environment())
methods::setMethod("show", "A", function(object) cat("B"))
a <- methods::new('A', function() b)
a <- methods::new("A", function() b)

ev <- evaluate("a")
expect_equal(ev[[2]], "B")
Expand Down
15 changes: 9 additions & 6 deletions tests/testthat/test-graphics.R
Original file line number Diff line number Diff line change
Expand Up @@ -145,8 +145,8 @@ test_that("multiple plots are captured even if calls in DL are the same", {

test_that("strwidth()/strheight() should not produce new plots", {
ev <- evaluate(function() {
x <- strwidth('foo', 'inches')
y <- strheight('foo', 'inches')
x <- strwidth("foo", "inches")
y <- strheight("foo", "inches")
plot(1)
})
expect_output_types(ev, c("source", "source", "source", "plot"))
Expand All @@ -156,15 +156,18 @@ test_that("clip() does not produce new plots", {
ev <- evaluate(function() {
plot(1)
clip(-1, 1, -1, 1)
points(1, col = 'red')
points(1, col = "red")
})
expect_output_types(ev, c("source", "plot", "source", "source", "plot"))
})

test_that("perspective plots are captured", {
x <- seq(-10, 10, length.out = 30)
y <- x
ff <- function(x, y) { r <- sqrt(x^2 + y^2); 10 * sin(r) / r }
ff <- function(x, y) {
r <- sqrt(x^2 + y^2)
10 * sin(r) / r
}
z <- outer(x, y, ff)
z[is.na(z)] <- 1

Expand Down Expand Up @@ -199,7 +202,7 @@ test_that("existing plot doesn't leak into evaluate()", {
defer(dev.off())

# errors because plot.new() called
ev <- evaluate('lines(1)')
ev <- evaluate("lines(1)")
expect_output_types(ev, c("source", "error"))
})

Expand All @@ -208,7 +211,7 @@ test_that("evaluate restores existing plot", {
d <- dev.cur()
defer(dev.off())

ev <- evaluate('plot(1)')
ev <- evaluate("plot(1)")
expect_output_types(ev, c("source", "plot"))
expect_equal(dev.cur(), d)
})
Expand Down
5 changes: 4 additions & 1 deletion tests/testthat/test-output.R
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,10 @@ test_that("handles various numbers of arguments", {
expect_equal(out, expected)

# Two arguments
f2 <- function(src, call) {signal_condition("handler_called"); NULL}
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)

Expand Down
14 changes: 7 additions & 7 deletions tests/testthat/test-parse_all.R
Original file line number Diff line number Diff line change
Expand Up @@ -61,24 +61,24 @@ test_that("expr is always an expression", {
})

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'))
expect_error(parse_all("x <-", allow_error = FALSE))
res <- parse_all("x <-", allow_error = TRUE)
expect_true(inherits(attr(res, "PARSE_ERROR"), "error"))

# And correctly flows through to evaluate
expect_no_error(evaluate('x <-', stop_on_error = 0))
expect_no_error(evaluate("x <-", stop_on_error = 0))
})

test_that("double quotes in Chinese characters not destroyed", {
skip_if_not(l10n_info()[['UTF-8']])
skip_if_not(l10n_info()[["UTF-8"]])

out <- parse_all(c('1+1', '"你好"'))
out <- parse_all(c("1+1", '"你好"'))
expect_equal(out$src[[2]], '"你好"\n')
expect_equal(out$expr[[2]], expression("你好"))
})

test_that("multibyte characters are parsed correctly", {
skip_if_not(l10n_info()[['UTF-8']])
skip_if_not(l10n_info()[["UTF-8"]])

code <- c("ϱ <- 1# g / ml", "äöüßÄÖÜπ <- 7 + 3# nonsense")
out <- parse_all(code)
Expand Down
1 change: 0 additions & 1 deletion tests/testthat/test-reproducible-output.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
test_that("local_reproducible_output() respects local context", {

local_reproducible_output(width = 105)
expect_equal(getOption("width"), 105)

Expand Down
2 changes: 1 addition & 1 deletion tests/testthat/test-watchout.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@ test_that("capture messages in try() (#88)", {
f <- function(x) stop(paste0("Obscure ", x))
g <- function() f("error")

ev <- evaluate('try(g())')
ev <- evaluate("try(g())")
expect_output_types(ev, c("source", "text"))
expect_match(ev[[2]], "Obscure error")
})
Expand Down

0 comments on commit 9567cce

Please sign in to comment.