Nothing
drake_context("analysis")
# nolint start
test_with_dir("busy function", {
f <- function(a = 1, b = k(i), nineteen, string_args = c("sa1", "sa2")) {
for (iter in 1:10) {
got_for <- got_for + iter
}
while (iter2 %in% 1:10) {
got_while <- got_while + iter2
}
assign("iter3", val1)
delayedAssign(x = "iter4", value = val2)
x <- g(a + b) + iter + iter2 + iter3 + iter4
g(a - b) -> y
z <- g(a * b)
local({
xyz1 <- 5
})
stringvar <- "string1"
stringlist <- list(c("string2", "string3"))
h <- function() {
xyz2 <- 6
}
abc <- xyz1 + xyz2
f2 <- "local"
lm(f1 ~ f2 + f3)
file_in("x", "y")
drake::file_in(c("w", "z"))
base::c(got, basevar)
quote(quoted)
Quote(quoted2)
expression(quoted3)
}
out <- drake_deps(f)
out <- select_nonempty(decode_deps_list(out))
expect_equal(sort(out$file_in), sort(c("w", "x", "y", "z")))
str <- sort(
c("iter3", "iter4", "local", paste0("string", 1:3), "sa1", "sa2")
)
expect_equal(sort(out$strings), str)
expect_equal(out$namespaced, "base::c")
exp <- sort(c(
"assign", "basevar", "c", "delayedAssign", "expression", "for",
"f1", "f3", "g", "got", "got_for", "got_while",
"i", "iter2", "k", "list", "lm", "local", "Quote", "quote",
"val1", "val2", "while", "xyz1", "xyz2"
))
expect_equal(sort(out$globals), exp)
str <- sort(c(str, "w", "x", "y", "z"))
expect_equal(sort(analyze_strings(f)), str)
})
# nolint end
test_with_dir("equals analysis", {
for (text in c("z = g(a * b)", "function(x) {z = g(a * b)}")) {
expr <- parse(text = text)
out <- drake_deps(expr)
expect_equal(sort(out$globals), sort(c("a", "b", "g")))
}
})
# https://github.com/cran/codetools/blob/main/tests/tests.R # nolint
test_with_dir("local variable tests from the codetools package", {
find_locals <- function(expr) {
if (!is.function(expr) && !is.language(expr)) {
return(list())
}
results <- new_drake_deps_ht()
locals <- ht_new()
walk_code(expr, results, locals, NULL)
ht_list(locals)
}
expect_equal(find_locals(quote(x <- 1)), "x")
expect_equal(find_locals(quote(x <- y <- 1)), c("x", "y"))
expect_equal(find_locals(quote(local(x <- 1))), character(0))
expect_equal(find_locals(quote(assign(x, 3))), character(0))
expect_equal(find_locals(quote(delayedAssign(x, 3))), character(0))
expect_equal(find_locals(quote(assign("x", 3))), "x")
expect_equal(find_locals(quote(assign("x", 3, 4))), character(0))
})
test_with_dir("same tests with global variables", {
code <- quote(x <- 1)
expect_equal(as.character(drake_deps(code)$globals), character(0))
code <- quote(x <- y <- 1)
expect_equal(as.character(drake_deps(code)$globals), character(0))
code <- quote(local(x <- 1))
expect_equal(drake_deps(code)$globals, "local")
code <- quote(assign(x, 3))
out <- sort(drake_deps(code)$globals)
expect_equal(out, sort(c("assign", "x")))
code <- quote({
assign(x, 3)
x <- 1
})
out <- sort(drake_deps(code)$globals)
expect_equal(out, sort(c("assign", "x")))
code <- quote({
x <- 1
assign(x, 3)
})
expect_equal(drake_deps(code)$globals, "assign")
code <- quote(assign("x", 3))
out <- sort(drake_deps(code)$globals)
expect_equal(out, "assign")
code <- quote(assign("x", 3, 4))
out <- sort(drake_deps(code)$globals)
expect_equal(out, "assign")
})
test_with_dir("solitary codetools globals tests", {
code <- quote({
local <- 1
local(x <- 1)
})
out <- as.character(drake_deps(code)$globals)
expect_equal(out, character(0))
out <- drake_deps(quote(local(x <- 1, e)))$globals
expect_equal(sort(out), sort(c("local", "e")))
f <- function() {
if (g()) {
x
} else {
y
}
}
out <- drake_deps(f)$globals
expect_equal(sort(out), sort(c("if", "g", "x", "y")))
f <- function() {
if (FALSE) {
x
}
}
out <- drake_deps(f)$globals
expect_equal(sort(out), sort(c("if", "x")))
f <- function(x) {z <- 1; x + y + z} # nolint
expect_equal(sort(drake_deps(f)$globals), "y")
expect_equal(drake_deps(function() Quote(x))$globals, "Quote")
f <- function(f, x, y) {
local <- f
local(x <- y)
x
}
expect_equivalent(drake_deps(f), new_drake_deps())
f <- function() {
x <- 1; y <- 2 # nolint
}
out <- as.character(drake_deps(f)$globals)
expect_equal(out, character(0))
f <- function(u = x <- 1) {
y <- 2
}
expect_equal(as.character(drake_deps(f)$globals), character(0))
})
# https://github.com/cran/codetools/blob/9bac1daaf19a36bd03a2cd7d67041893032e7a04/R/codetools.R#L302-L365 # nolint
# https://cran.r-project.org/doc/manuals/R-lang.html#Subset-assignment
test_with_dir("replacement functions", {
code <- quote(f(x) <- 1)
out <- sort(drake_deps(code)$globals)
expect_equal(out, sort(c("f<-", "x")))
code <- quote({
f(x) <- 1
x <- 5
})
out <- sort(drake_deps(code)$globals)
expect_equal(out, sort(c("f<-", "x")))
code <- quote({
x <- 5
f(x) <- 1
})
out <- drake_deps(code)$globals
expect_equal(out, "f<-")
code <- quote(f(g(h(k(x)))) <- seven)
out <- sort(as.character(drake_deps(code)$globals))
exp <- sort(c("f<-", "g", "g<-", "h", "h<-", "k", "k<-", "x", "seven"))
expect_equal(out, exp)
code <- quote(f(g(h(x, w), y(a)), z(u, v)) <- 1)
out <- sort(as.character(drake_deps(code)$globals))
exp <- sort(
c("f<-", "g", "g<-", "h", "h<-", "a", "u", "v", "w", "x", "y", "z")
)
expect_equal(out, exp)
code <- quote({
x <- 5
f(g(h(x, w), y(a)), z(u, v)) <- 1
})
out <- sort(as.character(drake_deps(code)$globals))
exp <- sort(
c("f<-", "g", "g<-", "h", "h<-", "a", "u", "v", "w", "y", "z")
)
expect_equal(out, exp)
code <- quote({
f(g(h(x, w), y(a)), z(u, v)) <- 1
x <- 5
})
out <- sort(as.character(drake_deps(code)$globals))
exp <- sort(
c("f<-", "g", "g<-", "h", "h<-", "a", "u", "v", "w", "x", "y", "z")
)
expect_equal(out, exp)
code <- quote(f(base::g(pkg:::h(x, w), y(a)), z(u, v)) <- 1)
out <- drake_deps(code)
out <- select_nonempty(decode_deps_list(out))
expect_equal(
sort(out$globals),
sort(c("f<-", "a", "u", "v", "x", "w", "y", "z"))
)
expect_equal(
sort(out$namespaced),
sort(c("pkg:::h", "base::g", "base::`g<-`", "pkg:::`h<-`"))
)
})
test_with_dir("code analysis error handling", {
e <- quote(a <- 1)
expect_error(
make_assignment_fn(e),
regexp = "bad function in complex assignments"
)
f <- function(a, b) {
invisible()
}
expect_error(get_assigned_var(formals(f)), regexp = "missing assignment")
e <- quote(x <- 1)
e <- list(e[1], e[1])
expect_error(get_assigned_var(e), regexp = "unfinished code")
e <- quote(x <- 1)
e[[2]] <- quote(x <- 1)
e[[2]][[2]] <- formals(f)[[1]]
expect_error(get_assigned_var(e), regexp = "missing variable")
e <- list(1, 2)
expect_error(get_assigned_var(e), regexp = "not a symbol")
})
test_with_dir("character vectors inside language objects", {
y <- c("a", "b")
plan <- drake::drake_plan(
out = data.frame(x = 1:2, y = !!y)
)
expect_silent(
drake_config(plan, cache = storr::storr_environment(), session_info = FALSE)
)
expect_equal(
sort(drake_deps(plan$command[[1]])$strings),
sort(c("a", "b"))
)
})
test_with_dir("dollar sign (#938)", {
expect_equal(drake_deps(quote(x$y))$globals, "x")
f <- function(target, cache) {
exists <- cache$exists(key = target) && (
imported <- diagnose(
target = target,
character_only = TRUE,
cache = cache
)$imported %||%
FALSE
)
}
out <- sort(drake_deps(f)$globals)
out <- out[out == make.names(out, unique = FALSE)]
exp <- "diagnose"
expect_equal(out, exp)
})
test_with_dir("user-defined S3 (#959)", {
skip_on_cran()
dostuff <- function(x) {
do.stuff.class2 <- 40 # nolint
if (1 == 1) {
UseMethod("do.stuff")
} else {
sqrt(5)
}
}
# nolint start
do.stuff.class1 <-
do.stuffclass1 <-
do.stuff_class1 <-
do_stuff.class1 <-
do_stuff_class1 <-
dostuff.class1 <-
do.stuff.class2 <-
do.stuff.class3 <-
function(x) {
invisible()
}
# nolint end
plan <- drake_plan(x = {
y <- list(123)
class(y) <- "class1"
dostuff(y)
})
config <- drake_config(
plan,
history = FALSE,
cache = storr::storr_environment()
)
out <- sort(deps_target_impl(dostuff, config)$name)
exp <- sort(c("do.stuff.class1", "do.stuff.class3"))
expect_equal(out, exp)
dostuff <- function(x) {
do.stuff.class2 <- 40 # nolint
if (1 == 1) {
UseMethod(object = x, generic = "do.stuff")
} else {
sqrt(5)
}
}
config <- drake_config(
plan,
history = FALSE,
cache = storr::storr_environment()
)
out <- sort(deps_target_impl(dostuff, config)$name)
exp <- sort(c("do.stuff.class1", "do.stuff.class3"))
make_impl(config = config)
expect_equal(justbuilt(config), "x")
make_impl(config = config)
expect_equal(justbuilt(config), character(0))
do.stuff.class1 <- function(...) { # nolint
message(123)
invisible()
}
make_impl(config = config)
expect_equal(justbuilt(config), "x")
dostuff <- function(...) {
do.stuff.class2 <- 40 # nolint
if (a == 1) {
dont_use_method("do.stuff")
} else {
sqrt(5)
}
}
config <- drake_config(
plan,
history = FALSE,
cache = storr::storr_environment()
)
expect_equal(deps_target_impl(dostuff, config)$name, character(0))
dostuff <- function(x) {
UseMethod(paste0("do", ".", "stuff"))
}
config <- drake_config(
plan,
history = FALSE,
cache = storr::storr_environment()
)
expect_equal(deps_target_impl(dostuff, config)$name, character(0))
})
test_with_dir("unparsable commands are handled correctly", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
x <- "bluh$"
expect_error(deps_code(x))
})
test_with_dir("bad target names", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
expect_equal(
sort(deps_code("sqrt(x + y + .)")$name),
sort(c("sqrt", "x", "y"))
)
expect_equal(
sort(deps_code("subset(complete.cases(.))")$name),
sort(c("complete.cases", "subset"))
)
plan <- drake_plan(
x = 1,
y = 2,
a = sqrt(x + y + .),
b = subset(complete.cases(.))
)
e <- environment()
expect_false(exists(".", envir = e))
config <- drake_config(plan)
plan <- drake_plan(
.gitignore = 1,
y = 2,
a = sqrt(x + y),
b = subset(complete.cases(.gitignore))
)
expect_error(drake_config(plan), "cannot be target names")
})
test_with_dir("file_in() and file_out() and knitr_in(): commands vs imports", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
skip_if_not_installed("knitr")
# nolint start
cmd <- quote({
file_in("x"); file_out("y"); knitr_in("report.Rmd")
})
# nolint end
f <- function() {
file_in("x")
}
file.create("x")
file.create("y")
path <- system.file(
file.path("rmarkdown", "examples", "mtcars", "report.Rmd"),
package = "drake",
mustWork = TRUE
)
file.copy(
from = path,
to = file.path(getwd(), "report.Rmd"),
overwrite = TRUE
)
x <- cds_command_dependencies(cmd)
x <- select_nonempty(decode_deps_list(x))
x0 <- list(
file_in = "x", file_out = "y", loadd = "large",
readd = c("small", "coef_regression2_small"),
knitr_in = "report.Rmd"
)
expect_equal(length(x), length(x0))
for (i in names(x)) {
expect_equal(sort(x[[i]]), sort(x0[[i]]))
}
y <- cds_import_dependencies(f)
y <- select_nonempty(decode_deps_list(y))
y0 <- list(
file_in = "x"
)
expect_equal(length(y), length(y0))
for (i in names(y)) {
expect_equal(sort(y[[i]]), sort(y0[[i]]))
}
expect_equal(
sort(deps_code(f)$name), sort(unname(unlist(y))))
expect_equal(
sort(deps_code(cmd)$name),
sort(
c("coef_regression2_small", "large",
"report.Rmd", "small", "x", "y"
)
)
)
})
test_with_dir("deps_code() and deps_target_impl()", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
expect_equal(nrow(deps_code("")), 0)
expect_equal(length(select_nonempty(cds_command_dependencies(NA))), 0)
expect_equal(length(select_nonempty(cds_command_dependencies(NULL))), 0)
expect_equal(
length(select_nonempty(cds_command_dependencies(character(0)))),
0
)
expect_equal(deps_code(base::c)$name, character(0))
expect_equal(deps_code(base::list)$name, character(0))
f <- function(x, y) {
out <- x + y + g(x)
saveRDS(out, "out.rds")
}
expect_false(is_vectorized(f))
expect_false(is_vectorized("char"))
expect_equal(
sort(deps_code(f)$name),
sort(c("g", "saveRDS"))
)
my_plan <- drake_plan(
x = 1 + some_object,
my_target = x + readRDS(file_in("tracked_input_file.rds")),
return_value = f(x, y, g(z + w)),
botched = read.csv(file_in(nothing)),
meta = read.table(file_in("file_in"))
)
expect_warning(
config <- drake_config(
my_plan,
session_info = FALSE,
cache = storr::storr_environment()
),
regexp = "must be literal strings"
)
expect_equal(deps_code(my_plan$command[[1]])$name, "some_object")
expect_equal(
sort(deps_code(my_plan$command[[2]])$name),
sort(c("tracked_input_file.rds", "x", "readRDS")))
expect_equal(
sort(deps_code(my_plan$command[[3]])$name),
sort(c("f", "g", "w", "x", "y", "z"))
)
expect_warning(
expect_equal(
sort(deps_code(my_plan$command[[4]])$name),
sort(c("read.csv"))
),
regexp = "must be literal strings"
)
expect_equal(
sort(deps_code(my_plan$command[[5]])$name),
sort(c("read.table", "file_in"))
)
expect_true(!nrow(deps_target_impl(x, config)))
expect_equal(
sort(deps_target_impl(my_target, config)$name),
sort(c("tracked_input_file.rds", "x")))
expect_equal(
sort(deps_target_impl(return_value, config)$name),
sort(c("f", "x"))
)
expect_equal(
sort(deps_target_impl(botched, config)$name),
character(0)
)
expect_equal(
sort(deps_target_impl(meta, config)$name),
sort("file_in"))
})
test_with_dir("tracked() works", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
config <- dbug()
x <- sort(tracked(config))
y <- sort(c(
redisplay_keys(reencode_path("intermediatefile.rds")),
"drake_target_1",
"yourinput", "nextone",
"combined", "myinput", "final", "j", "i", "h", "g", "f",
"c", "b", "a", redisplay_keys(reencode_path("input.rds"))
))
expect_equal(x, y)
})
test_with_dir("missing input files", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
config <- dbug()
expect_silent(tmp <- missing_input_files(config))
unlink("input.rds", force = TRUE)
expect_warning(tmp <- missing_input_files(config))
expect_silent(tmp <- config_checks(config))
expect_warning(runtime_checks(config), regexp = "missing")
config$settings$skip_safety_checks <- TRUE
expect_silent(tmp <- runtime_checks(config))
})
test_with_dir("Vectorized nested functions work", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
e <- new.env(parent = globalenv())
eval(parse(text = "f <- Vectorize(function(x) g(x), \"x\")"), envir = e)
eval(parse(text = "g <- function(x) x + y"), envir = e)
e$y <- 7
config <- dbug()
config$envir <- e
config$plan <- drake_plan(a = f(1:10))
config$targets <- "a"
expect_equal(deps_code(e$f)$name, "g")
expect_equal(deps_code(e$g)$name, "y")
testrun(config)
config <- testconfig(config)
if ("a" %in% ls(config$envir)) {
rm(a, envir = config$envir)
}
expect_equal(readd(a), 8:17)
k <- readd(f)
expect_true(is.character(k))
expect_equal(character(0), outdated_impl(config))
config$envir$y <- 8
expect_equal("a", outdated_impl(config))
# Target "a" should react.
testrun(config)
config <- testconfig(config)
expect_equal(character(0), outdated_impl(config))
expect_equal(readd(a), 9:18)
# Change a vectorized function and see target "a" react.
eval(
parse(text = "f <- Vectorize(function(x) {g(x) + 3}, \"x\")"),
envir = e
)
testrun(config)
config <- testconfig(config)
expect_equal(justbuilt(config), "a")
expect_equal(readd(a), 12:21)
})
test_with_dir("deps_target_impl()", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
skip_if_not_installed("knitr")
load_mtcars_example()
config <- drake_config(my_plan, cache = storr::storr_environment())
d1 <- deps_target_impl(report, config = config)
d1 <- as.data.frame(d1[order(d1$name), ])
d2 <- data.frame(
name = c(
"coef_regression2_small",
"knitr::knit",
"large",
"report.md",
"report.Rmd",
"small"
),
type = c("readd", "namespaced", "loadd", "file_out", "knitr_in", "readd"),
stringsAsFactors = FALSE
)
d2 <- d2[order(d2$name), ]
d1$hash <- NULL
expect_equivalent(d1, d2)
d <- deps_target_impl(regression1_small, config = config)
expect_equal(sort(d$name), sort(c("reg1", "small")))
expect_equal(d$type, rep("globals", 2))
})
test_with_dir("self-referential commands and imports", {
skip_on_cran()
f <- function(x, ...) {
x <- f
}
x <- data.frame(f = 123)
plan <- drake_plan(y = f(x, y))
cache <- storr::storr_environment()
make(plan, cache = cache, session_info = FALSE)
o <- drake_config(plan, cache = cache, session_info = FALSE)
expect_equal(justbuilt(o), "y")
log1 <- drake_cache_log(cache = cache)
make(plan, cache = cache, session_info = FALSE)
o <- drake_config(plan, cache = cache, session_info = FALSE)
expect_true(nobuild(o))
log2 <- drake_cache_log(cache = cache)
expect_equal(log1, log2)
})
test_with_dir("ignore() suppresses updates", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
cache <- storr::storr_environment()
envir <- new.env(parent = globalenv())
envir$arg <- 4
# Without ignore()
make(
plan = drake_plan(x = sqrt(arg)),
envir = envir,
cache = cache
)
con <- drake_config(
plan = drake_plan(x = sqrt(arg)),
envir = envir,
cache = cache
)
expect_equal(justbuilt(con), "x")
con$envir$arg <- con$envir$arg + 1
make_impl(config = con)
expect_equal(justbuilt(con), "x")
# With ignore()
make(
plan = drake_plan(x = sqrt( ignore(arg) + 123)), # nolint
envir = envir,
cache = cache
)
con <- drake_config(
plan = drake_plan(x = sqrt( ignore(arg) + 123)), # nolint
envir = envir,
cache = cache
)
expect_equal(justbuilt(con), "x")
con$envir$arg <- con$envir$arg + 1
con$cache$clear(namespace = "progress")
make_impl(config = con)
expect_equal(justbuilt(con), character(0))
con$envir$arg2 <- con$envir$arg + 1234
con$plan <- drake_plan(x = sqrt( ignore (arg2 ) + 123)) # nolint
con$cache$clear(namespace = "progress")
make_impl(config = con)
expect_equal(justbuilt(con), character(0))
})
test_with_dir("ignore() works on its own", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
expect_equal(ignore(), NULL)
expect_equal(ignore(1234), 1234)
expect_identical(ignore_ignore(digest::digest), digest::digest)
})
test_with_dir("Standardized commands have no attributes", {
expect_null(attributes(cds_standardize_command("")))
expect_null(attributes(
cds_standardize_command("f(x) + y + function(abc) {}"))
)
expect_null(attributes(cds_standardize_command(quote(NULL))))
expect_null(attributes(cds_standardize_command(digest::digest)))
expect_null(attributes(cds_standardize_command(body(digest::digest))))
})
test_with_dir("Can standardize commands", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
expect_true(is.character(cds_standardize_command(parse(text = ""))))
expect_identical(
cds_standardize_command(parse(text = "f(x +2) + 2")),
cds_standardize_command(parse(text = "f(x + 2) + 2"))
)
expect_identical(
cds_standardize_command(quote(f(x + 2) + 2)),
cds_standardize_command(parse(text = "f(x + 2) + 2"))
)
expect_false(
identical(
cds_standardize_command(parse(text = "f(x + 2) + 2")),
cds_standardize_command(parse(text = "f(x + 1 - 1) + 2"))
)
)
expect_identical(
cds_standardize_command(parse(text = "b->a")),
cds_standardize_command(parse(text = "a <- b"))
)
expect_identical(
cds_standardize_command(parse(text = "y=sqrt(x=1)")),
cds_standardize_command(parse(text = "y = sqrt(x = 1)"))
)
expect_identical(
cds_standardize_command(
parse(text = "abcdefg = hijklmnop <- qrstuvwxyz\n\n")
),
cds_standardize_command(parse(text = "abcdefg = hijklmnop <- qrstuvwxyz"))
)
a <- cds_standardize_command(parse(text = "z = {f('#') # comment
x = 5
y <-
'test'
z <- 4
x2 <- 'test2'
}"))
b <- cds_standardize_command(parse(text = "z = {f('#') # comment X
x = 5
y <- 'test'
z <- 4
'test2' -> x2
}"))
c <- cds_standardize_command(parse(text = "z = {f('#') # comment X
x = 5
y <- 'test3'
z <- 4
'test2' -> x2
}"))
expect_identical(a, b)
expect_false(identical(b, c))
})
test_with_dir("standardized commands with ignore()", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
expect_equal(
cds_standardize_command(
parse(text = "f( sqrt( ignore(fun(arg) + 7) + 123))")
),
cds_standardize_command(parse(text = "f(sqrt(ignore() + 123))"))
)
expect_equal(
cds_standardize_command(
parse(text = "f(sqrt( ignore (fun(arg) + 7)+123) ) # noooop")
),
cds_standardize_command(parse(text = "f(sqrt(ignore() + 123))"))
)
expect_equal(
cds_standardize_command(
parse(text = " f (sqrt( drake::ignore(fun(arg) + 7) + 123 ))")
),
cds_standardize_command(parse(text = "f(sqrt(ignore() + 123))"))
)
expect_equal(
cds_standardize_command(
parse(text = "\tf(sqrt( drake ::: ignore (fun(arg) + 7) + 123))")
),
cds_standardize_command(parse(text = "f(sqrt(ignore() + 123))"))
)
expect_equal(
cds_standardize_command(
parse(text = "function(x) {(sqrt( ignore(fun(arg) + 7) + 123))}")
),
cds_standardize_command(
parse(text = "function(x) {\n (sqrt(ignore() + 123))\n}")
)
)
expect_equal(
cds_standardize_command(
parse(text = "f(sqrt( ignore(fun(arg) + 7) + 123)); g(ignore(i))")
),
cds_standardize_command(
parse(text = "f(sqrt( ignore() + 123)); g(ignore())")
)
)
f <- function(x) {
(sqrt( ignore(fun(arg) + 7) + 123)) # nolint
}
b <- body(ignore_ignore(f))
for (a in names(attributes(b))) {
attr(b, a) <- NULL
}
expect_equal(b, quote({ (sqrt(ignore() + 123)) })) # nolint
})
test_with_dir("Can standardize commands from expr or lang", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
x <- parse(text = "f(x +2) + 2")
y <- cds_standardize_command(x)
z <- cds_standardize_command(x)
w <- cds_standardize_command(x[[1]])
s <- safe_deparse(quote(f(x + 2) + 2))
expect_equal(y, s)
expect_equal(z, s)
expect_equal(w, s)
})
test_with_dir("ignore() in imported functions", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
f <- function(x) {
(sqrt( ignore(sqrt(x) + 7) + 123)) # nolint
}
plan <- drake_plan(x = f(1))
cache <- storr::storr_environment()
make(plan, cache = cache)
# Because ignore() affects standardization:
expect_true(is.character(readd(f, cache = cache)))
config <- drake_config(plan, cache = cache)
expect_equal(justbuilt(config), "x")
str <- readd(f, cache = cache)
expect_false(any(grepl("sqrt(x)", str, fixed = TRUE)))
expect_true(any(grepl("(sqrt(ignore() + 123))", str, fixed = TRUE)))
f <- function(x) {
(sqrt( ignore(sqrt(x) + 8) + 123)) # nolint
}
make(plan, cache = cache)
config <- drake_config(plan, cache = cache)
expect_equal(justbuilt(config), character(0))
f <- function(x) {
(sqrt( ignore(sqrt(x) + 8) + 124)) # nolint
}
make(plan, cache = cache)
config <- drake_config(plan, cache = cache)
expect_equal(justbuilt(config), "x")
})
test_with_dir("ignore() inside special functions", {
plan <- drake_plan(
a = 1,
b1 = readd(a),
b2 = readd("a"),
b3 = ignore(readd(a)),
b4 = readd(ignore(a)),
b5 = readd(ignore("a")),
c1 = loadd(a),
c2 = loadd("a"),
c3 = ignore(loadd(a)),
c4 = loadd(ignore(a)),
c5 = loadd(ignore("a")),
d1 = file_in("a"),
d2 = file_in("a"),
d3 = ignore(file_in("a")),
d4 = file_in(ignore("a")),
d5 = file_in(ignore("a")),
e1 = file_out("a"),
e2 = file_out("a"),
e3 = ignore(file_out("a")),
e4 = file_out(ignore("a")),
e5 = file_out(ignore("a")),
f1 = knitr_in("a"),
f2 = knitr_in("a"),
f3 = ignore(knitr_in("a")),
f4 = knitr_in(ignore("a")),
f5 = knitr_in(ignore("a"))
)
suppressWarnings(config <- drake_config(plan))
for (x in letters[2:6]) {
for (y in 1:5) {
target <- paste0(x, y)
deps <- deps_target_impl(target, config, character_only = TRUE)$name
if (y < 3) {
expect_equal(deps, "a")
} else {
expect_equal(deps, character(0))
}
}
}
})
test_with_dir("no_deps() in a command", {
skip_on_cran()
plan <- drake_plan(y = sqrt(no_deps(x)))
cache <- storr::storr_environment()
config <- drake_config(plan, cache = cache)
x <- 4
make(plan, cache = cache)
expect_equal(justbuilt(config), "y")
x <- 5
make(plan, cache = cache)
expect_equal(justbuilt(config), character(0))
plan <- drake_plan(y = sqrt(no_deps(x + 1)))
make(plan, cache = cache)
expect_equal(justbuilt(config), "y")
})
test_with_dir("no_deps() in a function", {
skip_on_cran()
y <- 1
f <- function(x) {
no_deps({
out <- sqrt(x + y) + 1
out
})
}
plan <- drake_plan(z = f(2))
cache <- storr::storr_environment()
config <- drake_config(plan, cache = cache)
make(plan, cache = cache)
expect_equal(justbuilt(config), "z")
y <- 2
make(plan, cache = cache)
expect_equal(justbuilt(config), character(0))
f <- function(x) {
no_deps({
out <- sqrt(x + y) + 2
out
})
}
make(plan, cache = cache)
expect_equal(justbuilt(config), "z")
})
test_with_dir("function_dependencies() works on :: and :::", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
expect_false("g" %in% ls())
crazy <- function(x, y) {
z <- g(x) + y
k <- "local"
j <- TRUE
h <- function(x) {
pkgx::pkgx(x)
}
pkgx::pkgx(mypkg1::myfun3(myfun1(mypkg1::myfun2(100))))
doesnt:::exist
outer:::outer(inner::inner(triple:::triple(x) + sqrt(y)))
}
ns <- sort(
c(
"pkgx::pkgx",
"doesnt:::exist",
"inner::inner",
"outer:::outer",
"mypkg1::myfun3",
"mypkg1::myfun2",
"triple:::triple"
)
)
cd <- drake_deps(crazy)
cd <- select_nonempty(decode_deps_list(cd))
expect_equal(sort(cd$namespaced), ns)
cd <- drake_deps(crazy)
cd <- select_nonempty(decode_deps_list(cd))
expect_equal(
unname(sort(unlist(cd))),
sort(c(ns, "g", "myfun1", "sqrt", "local"))
)
command <- "pkgx::pkgx(mypkg1::myfun3(myfun1(mypkg1::myfun2(100))))"
expect_equal(
sort(deps_code(command)$name),
sort(
c(
"pkgx::pkgx",
"myfun1",
"mypkg1::myfun3",
"mypkg1::myfun2"
)
)
)
})
test_with_dir("namespaced drake_plan works", {
skip_on_cran() # CRAN gets essential tests only (check time limits).
scenarios <- get_testing_scenario()
envir <- dbug()$envir
rm(list = ls(envir), envir = envir)
envir$f <- function(x) {
x <- base::nchar(sqrt(x))
base:::c(x, 1)
}
x <- drake_plan(a = base::list(f(1)))
make(
x,
envir = envir,
jobs = scenarios$jobs,
parallelism = scenarios$parallelism,
verbose = 0L,
session_info = FALSE
)
config <- drake_config(
x,
envir = envir,
jobs = scenarios$jobs,
parallelism = scenarios$parallelism,
verbose = 0L,
session_info = FALSE
)
fromcache <- readd("base::list", character_only = TRUE)
expect_true(is.character(fromcache))
fromcache2 <- readd("base:::c", character_only = TRUE)
expect_true(is.character(fromcache2))
ns <- sort(c("base:::c", "base::list", "base::nchar"))
expect_true(all(ns %in% cached(targets_only = FALSE)))
expect_true(all(ns %in% setdiff(cached(targets_only = FALSE),
cached(targets_only = TRUE))))
expect_equal(
outdated_impl(config),
character(0)
)
})
test_with_dir("standardizing Rcpp functions (#806)", {
skip_on_cran()
if (FALSE) {
# Takes too long.
skip_if_not_installed("Rcpp")
f <- Rcpp::cppFunction(
"int add(int x, int y, int z) {
int sum = x + y + z;
return sum;
}"
)
}
str <- "function (x, y, z) \n.Call(<pointer: 0x116937930>, x, y, z)"
x <- standardize_deparsed_function(str)
expect_true(grepl("function", x))
expect_true(grepl("Call", x))
expect_false(grepl("pointer: 0x", x))
expect_true(grepl("pointer: 0x", str))
})
test_with_dir("utils for code analysis fns", {
expect_equal(pair_text("x", c("y", "z")), c("xy", "xz"))
})
test_with_dir("handle @ (#1130)", {
expect_equal(deps_code(quote(x@y))$name, "x")
})
test_with_dir("handle calls in analyze_assign() (#1119)", {
test <- function(input) {
assign(paste0(input, x, "var"), 1)
}
expect_silent(out <- deps_code(test))
expect_equal(nrow(out), 3)
expect_equal(sort(out$name), sort(c("assign", "paste0", "x")))
})
test_with_dir("$<-() and @<-() (#1144)", {
f <- function() {
x$y <- 1
x@y <- 1
}
expect_equal(deps_code(f)$name, "x")
f <- function() {
g(x)$y <- 1
}
expect_equal(sort(deps_code(f)$name), sort(c("g", "x")))
})
test_with_dir("nonliteral file_in() (#1229)", {
expect_silent(
x <- deps_code(quote(file_in(c("file1", "file2"))))
)
expect_warning(
x <- deps_code(quote(file_in(paste("file1", "file2")))),
regexp = "must be literal strings"
)
})
test_with_dir("no file_out() or knitr_in() in imported fns (#1229)", {
expect_error(
deps_code(function(x) file_out("abc")),
regexp = "file_out"
)
expect_error(
suppressWarnings(deps_code(function(x) knitr_in("abc"))),
regexp = "knitr_in"
)
})
test_with_dir("ignore deps of drake_plan() calls inside functions (#1237)", {
f <- function() {
y <- x + 1
drake_plan(
report = rmarkdown::render(
input = knitr_in("report.Rmd"),
output_file = file_out("report.md"),
output_dir = ".",
quiet = TRUE
)
)
}
expect_true(grepl("file_out", standardize_imported_function(f)))
expect_true(grepl("knitr_in", standardize_imported_function(f)))
expect_silent(out <- deps_code(f))
expect_equal(out$name, "x")
})
test_with_dir("error analyzing malformed code (#1371)", {
expect_error(make(drake_plan(bar = scale_y_log10() + mod <- list())))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.