Nothing
context("run")
test_that("minimal", {
path <- test_prepare_orderly_example("minimal")
on.exit(unlink(path, recursive = TRUE))
envir <- orderly_environment(NULL)
id <- orderly_run("example", envir = envir, root = path, echo = FALSE)
expect_is(id, "character")
expect_match(id, "^[0-9]{8}-[0-9]{6}-[[:xdigit:]]{8}$")
expect_equal(ls(envir), "dat")
expect_is(envir$dat, "data.frame")
p <- orderly_commit(id, root = path)
expect_true(file.exists(p))
expect_true(same_path(p, file.path(path, "archive", "example", id)))
expect_setequal(
dir(p),
c("orderly.yml", "orderly_run.rds", "script.R", "mygraph.png"))
})
test_that("fail to create artefact", {
path <- test_prepare_orderly_example("minimal")
on.exit(unlink(path, recursive = TRUE))
writeLines("1 + 1", file.path(path, "src/example/script.R"))
expect_error(orderly_run("example", root = path, echo = FALSE),
"Script did not produce expected artefacts: mygraph.png")
})
test_that("leave device open", {
path <- test_prepare_orderly_example("minimal")
on.exit(unlink(path, recursive = TRUE))
txt <- readLines(file.path(path, "src/example/script.R"))
writeLines(txt[!grepl("dev.off()", txt, fixed = TRUE)],
file.path(path, "src/example/script.R"))
expect_error(orderly_run("example", root = path, echo = FALSE),
"Report left 1 device open")
expect_false(file.exists("mygraph.png"))
})
test_that("close too many devices", {
path <- test_prepare_orderly_example("minimal")
png(tempfile())
n <- length(dev.list())
on.exit({
unlink(path, recursive = TRUE)
if (length(dev.list()) == n) {
dev.off()
}
})
txt <- readLines(file.path(path, "src/example/script.R"))
writeLines(c(txt, "dev.off()"), file.path(path, "src/example/script.R"))
expect_error(orderly_run("example", root = path, echo = FALSE),
"Report closed 1 more devices than it opened")
})
test_that("sink imbalance", {
skip_on_cran()
skip_on_cran_windows()
path <- test_prepare_orderly_example("minimal")
config <- orderly_config_$new(path)
path_script <- file.path(path, "src/example/script.R")
txt <- readLines(path_script)
writeLines(c("sink('somefile', split = TRUE)", txt), path_script)
expect_error(
orderly_run("example", root = path, echo = FALSE),
"Report left 1 sink open")
logfile <- tempfile()
expect_error(
capture_log(
orderly_run("example", root = path, echo = FALSE), logfile),
"Report left 1 sink open")
p <- tempfile()
sink(p, split = FALSE)
writeLines(c("sink()", txt), path_script)
withr::with_options(
list(orderly.nolog = TRUE),
expect_error(
capture_log(
orderly_run("example", root = path, echo = FALSE), logfile),
"Report closed 1 more sinks than it opened!"))
expect_equal(sink.number(), 0)
})
test_that("leave connection open", {
## The issue here is that a garbage collection *might* occur causing
## the connection to close, but that is not guaranteed! So we pop
## the connection into the environment so that it will not be
## garbage collected.
e <- new.env(parent = .GlobalEnv)
path <- test_prepare_orderly_example("minimal")
config <- orderly_config_$new(path)
path_script <- file.path(path, "src/example/script.R")
writeLines(
'con <- file("mygraph.png", "w")',
path_script)
expect_error(
orderly_run("example", root = path, echo = FALSE, envir = e),
"File left open: mygraph.png")
## And check we can recover!
close(e$con)
writeLines(
c('con <- file("mygraph.png", "w")', "close(con)"),
path_script)
e <- new.env(parent = .GlobalEnv)
expect_error(
orderly_run("example", root = path, echo = FALSE, envir = e),
NA)
})
test_that("connection is saved to db", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("minimal")
id1 <- orderly_run("example", root = path, echo = FALSE)
orderly_commit(id1, root = path)
path_example <- file.path(path, "src", "example")
yml <- file.path(path_example, "orderly.yml")
txt <- readLines(yml)
dat <- list(connection = list(con = "source"))
writeLines(c(txt, yaml::as.yaml(dat)), yml)
id2 <- orderly_run("example", root = path, echo = FALSE)
orderly_commit(id2, root = path)
con <- orderly_db("destination", root = path)
on.exit(DBI::dbDisconnect(con))
d <- DBI::dbGetQuery(con, "SELECT id, connection FROM report_version")
expect_equal(d$connection[d$id == id1], 0L)
expect_equal(d$connection[d$id == id2], 1L)
})
test_that("no data", {
path <- test_prepare_orderly_example("minimal")
yml <- c("data: ~",
"script: script.R",
"artefacts:",
" data:",
" filenames: data.rds",
" description: the data")
script <- "saveRDS(mtcars, 'data.rds')"
path_example <- file.path(path, "src", "example")
writeLines(yml, file.path(path_example, "orderly.yml"))
writeLines(script, file.path(path_example, "script.R"))
id <- orderly_run("example", root = path, echo = FALSE)
p <- file.path(path_draft(path), "example", id, "data.rds")
expect_true(file.exists(p))
expect_equal(readRDS(p), mtcars)
})
test_that("use artefact", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("depends", testing = TRUE)
path_example <- file.path(path, "src", "example")
path_depend <- file.path(path, "src", "depend")
id1 <- orderly_run("example", root = path, echo = FALSE)
path_orig <- file.path(path_draft(path), "example", id1, "data.rds")
expect_true(file.exists(path_orig))
id2 <- orderly_run("depend", root = path, echo = FALSE, use_draft = TRUE)
path_previous <- file.path(path_draft(path), "depend", id2, "previous.rds")
expect_true(file.exists(path_previous))
expect_equal(hash_files(path_previous, FALSE),
hash_files(path_orig, FALSE))
d <-
readRDS(path_orderly_run_rds(file.path(path_draft(path), "depend", id2)))
expect_equal(d$meta$depends$hash, hash_files(path_previous, FALSE))
## Then rebuild the original:
id3 <- orderly_run("example", root = path, echo = FALSE)
id4 <- orderly_run("depend", root = path, echo = FALSE, use_draft = TRUE)
path_orig2 <- file.path(path_draft(path), "example", id3, "data.rds")
path_previous2 <- file.path(path_draft(path), "depend", id4, "previous.rds")
expect_equal(hash_files(path_previous2, FALSE),
hash_files(path_orig2, FALSE))
expect_true(hash_files(path_previous2, FALSE) !=
hash_files(path_previous, FALSE))
## Then we need to commit things and check that it all still works OK.
expect_error(orderly_commit(id2, root = path),
"Report uses draft id - commit first")
p1 <- orderly_commit(id1, root = path)
p2 <- orderly_commit(id2, root = path)
expect_error(orderly_commit(id4, root = path), id3)
p3 <- orderly_commit(id3, root = path)
p4 <- orderly_commit(id4, root = path)
})
test_that("Can't commit report using nonexistant id", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("depends", testing = TRUE)
id1 <- orderly_run("example", root = path, echo = FALSE)
id2 <- orderly_run("depend", root = path, echo = FALSE, use_draft = TRUE)
unlink(file.path(path, "draft", "example", id1), recursive = TRUE)
expect_error(orderly_commit(id2, root = path),
"Report uses nonexistant id")
})
test_that("resources", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("resources", testing = TRUE)
id <- orderly_run("use_resource", root = path, echo = FALSE)
p <- file.path(path, "draft", "use_resource", id)
expect_true(file.exists(file.path(p, "meta/data.csv")))
p <- orderly_commit(id, root = path)
h <- hash_files(
file.path(path, "src", "use_resource", "meta", "data.csv"), FALSE)
con <- orderly_db("destination", root = path)
d <- DBI::dbGetQuery(
con, "SELECT * FROM file_input WHERE file_purpose = 'resource'")
expect_identical(d$filename, "meta/data.csv")
expect_identical(d$file_hash, h)
expect_true(file.exists(file.path(p, "meta/data.csv")))
})
test_that("markdown", {
## This test is failing on r-devel and r-patch on most, but not all
## platforms. I cannot replicate anywhere (r-devel via docker,
## GHA). The failure is pretty simple - we don't find the string
## "ANSWER:2" in the file, which does apparently exist.
##
## I am reasonably sure that this is due to
## https://github.com/yihui/knitr/commit/9a80a00 which is a
## workaround for the breaking change worked around in 81a4cd6 but
## we can't easily check that either. It's not clear to me why this
## is failing only on the r-devel versions of CRAN, unless this is
## some unknown feature of the CRAN setup.
##
## Without the ability to replicate I am skipping this
## unconditionally now, as otherwise we'll fall foul of the 2 week
## deadline and orderly will be removed from CRAN.
skip_on_cran()
skip_on_cran_windows()
skip_if_not_installed("markdown")
skip_if_not_installed("knitr")
path <- test_prepare_orderly_example("demo")
id <- orderly_run("html", root = path, echo = FALSE)
report <- file.path(path, "draft", "html", id, "myreport.html")
expect_true(file.exists(report))
expect_true(any(grepl("ANSWER:2", readLines(report))))
})
test_that("database is not loaded unless needed", {
vars <- c(SOME_ENVVAR = "source.sqlite")
path <- withr::with_envvar(
vars,
test_prepare_orderly_example("nodb", testing = TRUE))
id <- orderly_run("example", root = path, echo = FALSE)
expect_true(
file.exists(file.path(path, "draft", "example", id, "mygraph.png")))
expect_error(orderly_db("source", path), "SOME_ENVVAR")
})
test_that("id file", {
path <- test_prepare_orderly_example("minimal")
tmp <- tempfile()
id <- orderly_run_internal("example", root = path, id_file = tmp,
echo = FALSE)
expect_true(file.exists(tmp))
expect_equal(readLines(tmp), id)
})
test_that("test mode artefacts", {
owd <- getwd()
on.exit(setwd(owd))
path <- test_prepare_orderly_example("minimal")
p <- orderly_test_start("example", root = path)
expect_false(orderly_test_check(p))
writeLines(character(0), file.path(p, "mygraph.png"))
expect_true(orderly_test_check(p))
})
test_that("orderly_test_check requires test mode", {
p <- tempfile()
dir.create(p)
on.exit(unlink(p, recursive = TRUE))
expect_error(orderly_test_check(p), "Not running in test mode")
})
test_that("run with message", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("changelog", testing = TRUE)
test_message <- "[label1] test"
id <- orderly_run("example", root = path, echo = FALSE,
message = test_message)
p <- orderly_commit(id, root = path)
d <- readRDS(path_orderly_run_rds(p))$meta$changelog
expect_equal(d[names(d) != "id"],
data_frame(
label = "label1", value = "test", from_file = FALSE,
report_version = id))
expect_match(d$id, "^[[:xdigit:]]{32}")
})
test_that("no unexpected artefact", {
path <- test_prepare_orderly_example("minimal")
path_example <- file.path(path, "src", "example")
# we're not expecting an 'unexpected' message at this point
# grab all messages...
messages <- capture_messages(orderly_run("example", root = path,
echo = FALSE))
# ...make sure none of the messages contain "unexpected"
expect_false(any(grep("unexpected", messages)))
})
test_that("renamed dependencies are expected", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("depends", testing = TRUE)
orderly_run("example", root = path, echo = FALSE)
messages <- capture_messages(
orderly_run("depend", root = path, echo = FALSE, use_draft = TRUE))
expect_false(any(grep("unexpected", messages)))
})
test_that("non-existent package", {
# if logging is on this test will wait for user input, so turn off
orderly_log_off()
on.exit(orderly_log_on())
path <- test_prepare_orderly_example("minimal")
path_example <- file.path(path, "src", "example")
yml_path <- file.path(path_example, "orderly.yml")
# add a non-existent package to the yaml
write(sprintf("packages: %s", "non_existent_package"),
file = yml_path, append = TRUE)
# has orderly detected that the package does not exist>
expect_error(orderly_run("example", root = path, echo = FALSE),
"Missing packages: 'non_existent_package'")
})
test_that("multiple non-existent packages", {
# if logging is on this test will wait for user input, so turn off
orderly_log_off()
on.exit(orderly_log_on())
path <- test_prepare_orderly_example("minimal")
path_example <- file.path(path, "src", "example")
yml_path <- file.path(path_example, "orderly.yml")
# add a non-existent package to the yaml
write(sprintf("packages: \n - %s", "non_existent_package"),
file = yml_path, append = TRUE)
write(sprintf(" - %s", "non_existent_package_2"),
file = yml_path, append = TRUE)
# has orderly detected that the package does not exist>
expect_error(orderly_run("example", root = path, echo = FALSE),
paste("Missing packages:",
"'non_existent_package', 'non_existent_package_2'"))
})
test_that("use multiple versions of an artefact", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("depends", testing = TRUE)
id1 <- orderly_run("example", root = path, echo = FALSE)
id2 <- orderly_run("example", root = path, echo = FALSE)
orderly_commit(id1, root = path)
orderly_commit(id2, root = path)
p <- file.path(path, "src", "depend2", "orderly.yml")
dat <- yaml_read(p)
dat$depends[[1]]$example$id <- id1
dat$depends[[2]]$example$id <- id2
yaml_write(dat, p)
id3 <- orderly_run("depend2", root = path, echo = FALSE)
p1 <- file.path(path, "draft", "depend2", id3,
c("previous1.rds", "previous2.rds"))
expect_true(all(file.exists(p1)))
p2 <- file.path(path, "archive", "example", c(id1, id2), "data.rds")
expect_equal(hash_files(p1, FALSE),
hash_files(p2, FALSE))
})
test_that("required field OK", {
path <- test_prepare_orderly_example("minimal")
# we need to use an orderly config with required fields set so copy it over
# this must have exactly two required fields
file.copy("example_config.yml", file.path(path, "orderly_config.yml"),
overwrite = TRUE)
path_example <- file.path(path, "src", "example")
# grab the current report yml without required fields
# this will fail with the new orderly_config.yml
yml_path <- file.path(path_example, "orderly.yml")
minimal_yml <- readLines(yml_path)
# get required fields out of config
config <- orderly_config_$new(path)
req_fields <- config$fields$name[config$fields$required]
# set required fields to correct type
minimal_yml <- c(minimal_yml, sprintf("%s: %s", req_fields[1], "character"))
minimal_yml <- c(minimal_yml, sprintf("%s: %s", req_fields[2], "character"))
writeLines(minimal_yml, yml_path)
id <- orderly_run("example", root = path, echo = FALSE)
p <- file.path(path_draft(path), "example", id, "mygraph.png")
expect_true(file.exists(p))
})
test_that("missing required field", {
path <- test_prepare_orderly_example("minimal")
# we need to use an orderly config with required fields set so copy it over
file.copy("example_config.yml", file.path(path, "orderly_config.yml"),
overwrite = TRUE)
path_example <- file.path(path, "src", "example")
# grab the current report yml without required fields
# this will fail with the new orderly_config.yml
yml_path <- file.path(path_example, "orderly.yml")
minimal_yml <- readLines(yml_path)
# get required fields out of config
config <- orderly_config_$new(path)
req_fields <- config$fields$name[config$fields$required]
# iterate over the required fields...
for (field in req_fields) {
# ...add one of them to the end of the file
broken_yml <- c(minimal_yml, sprintf("%s: %s", field, "Value"))
writeLines(broken_yml, yml_path)
# required fields still missing
missing_required <- setdiff(req_fields, field)
# we are expecting an error message here
if (length(missing_required) > 0) {
err_msg <- sprintf("Fields missing from .*: '%s'", missing_required)
expect_error(orderly_run("example", root = path, echo = FALSE),
regexp = err_msg)
}
}
})
test_that("required field wrong type", {
path <- test_prepare_orderly_example("minimal")
# we need to use an orderly config with required fields set so copy it over
# this must have exactly two required fields
file.copy("example_config.yml", file.path(path, "orderly_config.yml"),
overwrite = TRUE)
path_example <- file.path(path, "src", "example")
# grab the current report yml without required fields
# this will fail with the new orderly_config.yml
yml_path <- file.path(path_example, "orderly.yml")
minimal_yml <- readLines(yml_path)
# get required fields out of config
config <- orderly_config_$new(path)
req_fields <- config$fields$name[config$fields$required]
# add the second required to the yml with the wrong type
minimal_yml <- c(minimal_yml, sprintf("%s: %s", req_fields[1], "character"))
minimal_yml <- c(minimal_yml, sprintf("%s: %s", req_fields[2], 1))
writeLines(minimal_yml, yml_path)
# first required field wont give an error, the second will
err_msg <- sprintf("'.*orderly.yml:%s' must be character", req_fields[2])
expect_error(orderly_run("example", root = path, echo = FALSE),
regexp = err_msg)
})
test_that("commit failure", {
path <- test_prepare_orderly_example("minimal")
on.exit(unlink(path, recursive = TRUE))
expect_error(orderly_commit(new_report_id(), "example", path),
"Did not find draft report example/")
})
test_that("can't commit failed run", {
path <- test_prepare_orderly_example("minimal")
on.exit(unlink(path, recursive = TRUE))
append_lines('stop("some error")',
file.path(path, "src", "example", "script.R"))
expect_error(orderly_run("example", root = path, echo = FALSE),
"some error")
id <- dir(file.path(path, "draft", "example"))
expect_error(orderly_commit(id, root = path),
"Did not find run metadata file for example/")
})
test_that("can't commit report twice", {
path <- test_prepare_orderly_example("minimal")
on.exit(unlink(path, recursive = TRUE))
id <- orderly_run("example", root = path, echo = FALSE)
dir.create(file.path(path, "archive", "example", id), FALSE, TRUE)
expect_error(orderly_commit(id, root = path),
"Report example/.* appears to have already been copied")
})
test_that("missing parameters throws an error", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("demo")
on.exit(unlink(path, recursive = TRUE))
expect_error(orderly_run("other", root = path),
"Missing parameters: 'nmin'")
expect_error(orderly_run("other", list(cl = 2), root = path),
"Missing parameters: 'nmin'")
})
test_that("orderly_environment", {
expect_identical(orderly_environment(.GlobalEnv), .GlobalEnv)
e <- orderly_environment(NULL)
expect_identical(parent.env(e), .GlobalEnv)
expect_identical(orderly_environment(e), e)
expect_error(orderly_environment(list()), "'envir' must be an environment")
})
test_that("modify one resource", {
path <- test_prepare_orderly_example("resources", testing = TRUE)
path_example <- file.path(path, "src", "use_resource")
script_path <- file.path(path_example, "script.R")
## add a line to script.R that modifies a resource
write(sprintf("write.csv(x = c(1, 2, 3), file = 'meta/data.csv')"),
file = script_path, append = TRUE)
expect_error(
orderly_run("use_resource", root = path, echo = FALSE),
"Script has modified input: meta/data.csv")
})
test_that("modify multiple resources", {
path <- test_prepare_orderly_example("resources", testing = TRUE)
path_example <- file.path(path, "src", "multiple_resources")
script_path <- file.path(path_example, "script.R")
write(sprintf("write.csv(x = c(1, 2, 3), file = 'meta/data.csv')"),
file = script_path, append = TRUE)
write(sprintf("write.csv(x = c('Hello', 'World'), file = 'meta/data2.csv')"),
file = script_path, append = TRUE)
expect_error(
orderly_run("multiple_resources", root = path, echo = FALSE),
"Script has modified inputs: meta/data.csv, meta/data2.csv")
})
test_that("delete a resource", {
## delete 1 resource
path <- test_prepare_orderly_example("resources", testing = TRUE)
path_example <- file.path(path, "src", "use_resource")
script_path <- file.path(path_example, "script.R")
## add a line to script.R that deletes a resource
write(sprintf("file.remove('meta/data.csv')"),
file = script_path, append = TRUE)
expect_error(
orderly_run("use_resource", root = path, echo = FALSE),
"Script deleted input: meta/data.csv")
})
test_that("delete multiple resources", {
path <- test_prepare_orderly_example("resources", testing = TRUE)
path_example <- file.path(path, "src", "multiple_resources")
script_path <- file.path(path_example, "script.R")
# add a line to script.R that modifies a resource
write(sprintf("file.remove('meta/data.csv')"),
file = script_path, append = TRUE)
write(sprintf("file.remove('meta/data2.csv')"),
file = script_path, append = TRUE)
error_message <-
sprintf("Script deleted inputs: %s, %s",
"meta/data.csv", "meta/data2.csv")
expect_error(
orderly_run("multiple_resources", root = path, echo = FALSE),
error_message)
})
test_that("multiple resources", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("resources", testing = TRUE)
id <- orderly_run("multiple_resources", root = path, echo = FALSE)
p <- file.path(path, "draft", "multiple_resources", id)
expect_true(file.exists(file.path(p, "meta/data.csv")))
expect_true(file.exists(file.path(p, "meta/data2.csv")))
p <- orderly_commit(id, root = path)
h1 <- hash_files(
file.path(path, "src", "multiple_resources", "meta", "data.csv"), FALSE)
h2 <- hash_files(
file.path(path, "src", "multiple_resources", "meta", "data2.csv"), FALSE)
con <- orderly_db("destination", root = path)
on.exit(DBI::dbDisconnect(con))
d <- DBI::dbReadTable(con, "file_input")
d <- d[d$file_purpose == "resource", ]
expect_identical(d$filename, c("meta/data.csv", "meta/data2.csv"))
expect_identical(d$file_hash, c(h1, h2))
expect_true(file.exists(file.path(p, "meta/data.csv")))
expect_true(file.exists(file.path(p, "meta/data2.csv")))
})
test_that("producing a directory is an error", {
path <- test_prepare_orderly_example("minimal")
on.exit(unlink(path, recursive = TRUE))
writeLines(
'dir.create("mygraph.png")',
file.path(path, "src", "example", "script.R"))
expect_error(orderly_run("example", root = path, echo = FALSE),
"Produced a directory artefact: 'mygraph.png'",
fixed = TRUE)
})
test_that("can run report with a view", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("demo")
id <- orderly_run("view", root = path, echo = FALSE)
orderly_commit(id, root = path)
con <- orderly_db("destination", root = path)
on.exit(DBI::dbDisconnect(con))
res <- DBI::dbReadTable(con, "report_version_view")
expect_equal(res$database, "source")
})
test_that("can run a report from orderly with no database", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("db0", testing = TRUE)
id <- orderly_run("example", root = path, echo = FALSE)
expect_true(file.exists(
file.path(path, "draft", "example", id, "mygraph.png")))
p <- orderly_commit(id, root = path)
expect_true(file.exists(file.path(p, "mygraph.png")))
})
test_that("can run a report from orderly with one (named) database", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("db1", testing = TRUE)
id <- orderly_run("example", root = path, echo = FALSE)
expect_true(file.exists(
file.path(path, "draft", "example", id, "mygraph.png")))
p <- orderly_commit(id, root = path)
expect_true(file.exists(file.path(p, "mygraph.png")))
})
test_that("can run a report from orderly with two databases", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("db2", testing = TRUE)
id <- orderly_run("example", root = path, echo = FALSE)
expect_true(file.exists(
file.path(path, "draft", "example", id, "mygraph.png")))
p <- orderly_commit(id, root = path)
expect_true(file.exists(file.path(p, "mygraph.png")))
})
test_that("Can use connections with two databases", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("db2", testing = TRUE)
id <- orderly_run("connection", root = path, echo = FALSE)
expect_true(file.exists(
file.path(path, "draft", "connection", id, "mygraph.png")))
p <- orderly_commit(id, root = path)
expect_true(file.exists(file.path(p, "mygraph.png")))
})
test_that("prevent duplicate filenames", {
path <- test_prepare_orderly_example("depends", testing = TRUE)
id1 <- orderly_run("example", root = path, echo = FALSE)
p <- file.path(path, "src", "depend", "orderly.yml")
d <- yaml_read(p)
d$resources <- "previous.rds"
yaml_write(d, p)
file.create(file.path(path, "src", "depend", "previous.rds"))
expect_error(
orderly_run("depend", root = path, echo = FALSE, use_draft = TRUE),
"Orderly configuration implies duplicate files:\\s+- previous.rds:")
})
test_that("allow src/ in report name during run", {
path <- test_prepare_orderly_example("minimal")
id <- orderly_run("src/example", root = path, echo = FALSE)
expect_true(file.exists(file.path(path, "draft", "example", id)))
})
test_that("run with different database instance", {
path <- test_prepare_orderly_example("depends", testing = TRUE)
p <- file.path(path, "orderly_config.yml")
writeLines(c(
"database:",
" source:",
" driver: RSQLite::SQLite",
" instances:",
" default:",
" dbname: source.sqlite",
" alternative:",
" dbname: alternative.sqlite"),
p)
file.copy(file.path(path, "source.sqlite"),
file.path(path, "alternative.sqlite"))
con <- orderly_db("source", root = path, instance = "alternative")
DBI::dbExecute(con$source, "DELETE from thing where id > 10")
id1 <- orderly_run("example", root = path, echo = FALSE)
id2 <- orderly_run("example", root = path, echo = FALSE,
instance = "default")
id3 <- orderly_run("example", root = path, echo = FALSE,
instance = "alternative")
f <- function(id) {
nrow(readRDS(file.path(path, "draft", "example", id, "data.rds")))
}
expect_equal(f(id1), 20)
expect_equal(f(id2), 20)
expect_equal(f(id3), 10)
g <- function(id) {
d <- readRDS(file.path(path, "draft", "example", id, "orderly_run.rds"))
d$meta$instance
}
expect_equal(g(id1), list(source = "default"))
expect_equal(g(id2), list(source = "default"))
expect_equal(g(id3), list(source = "alternative"))
})
test_that("Require simple parameters", {
path <- test_prepare_orderly_example("parameters", testing = TRUE)
expect_error(
orderly_run("example", parameters = list(a = Sys.Date(), b = TRUE),
root = path, echo = FALSE),
"Invalid parameters: 'a' - must be character, numeric or logical")
expect_error(
orderly_run("example", parameters = list(a = NULL, b = 1:2),
root = path, echo = FALSE),
"Invalid parameters: 'a', 'b' - must be scalar")
})
test_that("preserve tags in metadata", {
root <- test_prepare_orderly_example("minimal")
append_lines(c("tags:", " - tag1", " - tag2"),
file.path(root, "orderly_config.yml"))
append_lines(c("tags:", " - tag1"),
file.path(root, "src", "example", "orderly.yml"))
id <- orderly_run("example", root = root, echo = FALSE)
d <- readRDS(path_orderly_run_rds(file.path(root, "draft", "example", id)))
expect_equal(d$meta$tags, "tag1")
})
test_that("Pass tags during run", {
root <- test_prepare_orderly_example("minimal")
append_lines(c("tags:", " - tag1", " - tag2"),
file.path(root, "orderly_config.yml"))
append_lines(c("tags:", " - tag1"),
file.path(root, "src", "example", "orderly.yml"))
## Add new tag
id <- orderly_run("example", root = root, echo = FALSE, tags = "tag2")
d <- readRDS(path_orderly_run_rds(file.path(root, "draft", "example", id)))
expect_equal(d$meta$tags, c("tag1", "tag2"))
## Ignore already present tag
id <- orderly_run("example", root = root, echo = FALSE, tags = "tag1")
d <- readRDS(path_orderly_run_rds(file.path(root, "draft", "example", id)))
expect_equal(d$meta$tags, "tag1")
## Error on unknown tag
expect_error(
orderly_run("example", root = root, echo = FALSE, tags = "tag3"),
"Unknown tag: 'tag3'")
expect_error(
orderly_run("example", root = root, echo = FALSE, tags = 1),
"'tags' must be character")
})
test_that("orderly_envir is available during run", {
path <- test_prepare_orderly_example("minimal")
p <- file.path(path, "src", "example")
writeLines(c("MY_A: a", "ORDERLY_B: b"), file.path(path, "orderly_envir.yml"))
append_lines('writeLines(Sys.getenv("MY_A"), "env")',
file.path(p, "script.R"))
id <- orderly_run("example", root = path, echo = FALSE)
p <- file.path(path, "draft", "example", id)
expect_equal(readLines(file.path(p, "env")), "a")
expect_equal(readRDS(path_orderly_run_rds(p))$env$ORDERLY_B, "b")
})
test_that("Use secrets in report", {
srv <- vaultr::vault_test_server()
cl <- srv$client()
cl$write("/secret/users/alice", list(password = "ALICE"))
cl$write("/secret/users/bob", list(password = "BOB"))
path <- test_prepare_orderly_example("minimal")
append_lines(
c("vault:",
paste(" addr:", srv$addr),
paste(" login: token"),
paste(" token:", srv$token)),
file.path(path, "orderly_config.yml"))
append_lines(c("secrets:",
" alice: /secret/users/alice:password",
" bob: /secret/users/bob:password"),
file.path(path, "src", "example", "orderly.yml"))
append_lines(
'writeLines(c(alice, bob), "passwords")',
file.path(path, "src", "example", "script.R"))
id <- orderly_run("example", root = path, echo = FALSE)
expect_equal(
readLines(file.path(path, "draft", "example", id, "passwords")),
c("ALICE", "BOB"))
})
test_that("can use environment variables in report", {
path <- test_prepare_orderly_example("minimal")
append_lines(
c("environment:",
paste(" data_path: EXTRA_DATA_PATH"),
paste(" example_var: EXAMPLE_VAR")),
file.path(path, "src", "example", "orderly.yml"))
append_lines(
'writeLines(c(data_path, example_var), "env_vars")',
file.path(path, "src", "example", "script.R"))
expect_error(orderly_run("example", root = path),
"Environment variable 'EXTRA_DATA_PATH' is not set
\t(used in orderly.yml:environment:data_path)", fixed = TRUE)
## On windows if env variable is empty then windows will return NA from call
## to Sys.getenv
if (is_windows()) {
expected_err <- "Environment variable 'EXAMPLE_VAR' is not set
\t(used in orderly.yml:environment:example_var)"
} else {
expected_err <- "Environment variable 'EXAMPLE_VAR' is empty
\t(used in orderly.yml:environment:example_var)"
}
data_path <- tempfile()
withr::with_envvar(
c("EXTRA_DATA_PATH" = data_path,
"EXAMPLE_VAR" = ""),
expect_error(orderly_run("example", root = path),
expected_err, fixed = TRUE)
)
withr::with_envvar(
c("EXTRA_DATA_PATH" = data_path,
"EXAMPLE_VAR" = "example value"),
id <- orderly_run("example", root = path, echo = FALSE)
)
expect_equal(
readLines(file.path(path, "draft", "example", id, "env_vars")),
c(data_path, "example value"))
})
test_that("pick up name from the working directory", {
skip_on_cran_windows()
path <- test_prepare_orderly_example("minimal")
id <- withr::with_dir(
file.path(path, "src", "example"),
orderly_run(echo = FALSE))
expect_true(file.exists(file.path(path, "draft", "example", id)))
})
test_that("orderly_run can capture messages", {
path <- test_prepare_orderly_example("minimal")
on.exit(unlink(path, recursive = TRUE))
id <- orderly_run_internal("example", root = path, echo = FALSE,
capture_log = TRUE, commit = TRUE)
archive_logs <- path_orderly_log(file.path(path, "archive", "example", id))
expect_true(file.exists(archive_logs))
log <- readLines(archive_logs)
expect_true("[ name ] example" %in% log)
expect_true(any(grepl("^\\[ commit \\] .*", log)))
})
test_that("logs from failed runs can still be written to file", {
path <- test_prepare_orderly_example("minimal")
on.exit(unlink(path, recursive = TRUE))
append_lines(
c("f <- function() g()",
"g <- function() h()",
"h <- function() stop('some error')",
"f()"),
file.path(path, "src", "example", "script.R"))
expect_error(orderly_run_internal("example", root = path, echo = FALSE,
capture_log = TRUE),
"some error")
id <- dir(file.path(path, "draft", "example"))
draft_logs <- file.path(path, "draft", "example", id, "orderly.log")
expect_true(file.exists(draft_logs))
log <- readLines(draft_logs)
expect_true("[ name ] example" %in% log)
## Error is found
expect_match(log, "Error: some error", all = FALSE)
## traceback preserved
expect_match(log, "f()", all = FALSE, fixed = TRUE)
expect_match(log, "g()", all = FALSE, fixed = TRUE)
})
test_that("run errors if given extra parameters", {
path <- test_prepare_orderly_example("demo")
expect_error(
orderly_run("minimal", list(a = 1), root = path),
"Extra parameters: 'a'")
expect_error(
orderly_run("other", list(nmin = 1, a = 1), root = path),
"Extra parameters: 'a'")
})
test_that("parameters passed to dependency resolution include defaults", {
dat <- prepare_orderly_query_example()
root <- dat$root
ids <- dat$ids
config <- orderly_config_$new(root)
p <- file.path(root, "src", "use_dependency", "orderly.yml")
txt <- readLines(p)
txt <- sub("latest", "latest(parameter:nmin < x)", txt, fixed = TRUE)
txt <- c(txt, c("parameters:",
" x:",
" default: 0.25"))
writeLines(txt, p)
## Use default
id <- orderly_run("use_dependency", echo = FALSE, root = root)
info <- readRDS(
path_orderly_run_rds(file.path(root, "draft", "use_dependency", id)))
expect_equal(info$meta$depends$id, dat$ids[[2]])
## Override default
id <- orderly_run("use_dependency", list(x = 0.15), echo = FALSE, root = root)
info <- readRDS(
path_orderly_run_rds(file.path(root, "draft", "use_dependency", id)))
expect_equal(info$meta$depends$id, dat$ids[[1]])
})
test_that("failed run creates failed rds", {
path <- test_prepare_orderly_git_example()
append_lines('stop("some error")',
file.path(path[["local"]], "src", "minimal", "script.R"))
expect_error(orderly_run("minimal", root = path[["local"]], echo = FALSE),
"some error")
drafts <- orderly_list_drafts(root = path[["local"]], include_failed = TRUE)
expect_equal(nrow(drafts), 1)
draft_dir <- file.path(path_draft(path[["local"]]), drafts$name, drafts$id)
expect_true(file.exists(path_orderly_fail_rds(draft_dir)))
failed_rds <- readRDS(path_orderly_fail_rds(draft_dir))
expect_setequal(names(failed_rds),
c("session_info", "time", "env", "git", "error", "meta",
"archive_version"))
expect_s3_class(failed_rds$error$error, "simpleError")
expect_equal(failed_rds$error$error$message, "some error")
expect_true(length(failed_rds$error$trace) > 5)
expect_match(failed_rds$error$trace[length(failed_rds$error$trace)],
'stop\\("some error"\\)')
expect_equal(failed_rds$meta$id, drafts$id)
expect_equal(failed_rds$meta$name, "minimal")
expect_null(failed_rds$meta$parameters)
expect_true(!is.null(failed_rds$meta$elapsed))
expect_equal(failed_rds$archive_version, cache$current_archive_version)
expect_equal(failed_rds$git$branch, "master")
expect_equal(failed_rds$git$status, " M src/minimal/script.R")
})
test_that("fail during cleanup creates failed rds", {
path <- test_prepare_orderly_example("minimal")
on.exit(unlink(path, recursive = TRUE))
writeLines("1 + 1", file.path(path, "src/example/script.R"))
expect_error(orderly_run("example", root = path, echo = FALSE),
"Script did not produce expected artefacts: mygraph.png")
drafts <- orderly_list_drafts(root = path, include_failed = TRUE)
expect_equal(nrow(drafts), 1)
draft_dir <- file.path(path_draft(path), drafts$name, drafts$id)
expect_true(file.exists(path_orderly_fail_rds(draft_dir)))
failed_rds <- readRDS(path_orderly_fail_rds(draft_dir))
expect_equal(names(failed_rds),
c("session_info", "time", "env", "error", "meta",
"archive_version"))
expect_equal(failed_rds$error$error$message,
"Script did not produce expected artefacts: mygraph.png")
expect_true(length(failed_rds$error$trace) > 5)
expect_match(failed_rds$error$trace[length(failed_rds$error$trace)],
"Script did not produce expected artefacts:")
})
test_that("message printed if run fails before working dir is set", {
path <- test_prepare_orderly_git_example()
## git checkout happens before workdir is set, so we trigger an error there
expect_message(expect_error(
orderly_run_internal("minimal", root = path[["local"]],
echo = FALSE, fetch = TRUE, ref = "123")),
"Can't save fail RDS, workdir not set")
})
test_that("orderly_run_internal writes fail rds on error", {
path <- test_prepare_orderly_example("minimal")
on.exit(unlink(path, recursive = TRUE))
append_lines(
c("f <- function() g()",
"g <- function() h()",
"h <- function() stop('some error')",
"f()"),
file.path(path, "src", "example", "script.R"))
expect_error(orderly_run_internal("example", root = path, echo = FALSE,
capture_log = TRUE),
"some error")
drafts <- orderly_list_drafts(root = path, include_failed = TRUE)
expect_equal(nrow(drafts), 1)
draft_dir <- file.path(path_draft(path), drafts$name, drafts$id)
expect_true(file.exists(path_orderly_fail_rds(draft_dir)))
failed_rds <- readRDS(path_orderly_fail_rds(draft_dir))
expect_equal(names(failed_rds),
c("session_info", "time", "env", "error", "meta",
"archive_version"))
expect_equal(failed_rds$error$error$message, "some error")
expect_true(length(failed_rds$error$trace) > 5)
expect_match(failed_rds$error$trace[length(failed_rds$error$trace) - 3],
"f()")
expect_match(failed_rds$error$trace[length(failed_rds$error$trace) - 2],
"g()")
expect_match(failed_rds$error$trace[length(failed_rds$error$trace) - 1],
"h()")
expect_match(failed_rds$error$trace[length(failed_rds$error$trace)],
'stop\\("some error"\\)')
})
test_that("orderly_run_internal can save workflow metadata", {
path <- test_prepare_orderly_example("minimal")
tmp <- tempfile()
id <- orderly_run_internal("example", root = path, id_file = tmp,
commit = TRUE, echo = FALSE,
workflow_id = "123")
rds <- path_orderly_run_rds(file.path(path, "archive", "example", id))
expect_true(file.exists(rds))
dat <- readRDS(rds)
expect_equal(dat$meta$workflow, "123")
con <- orderly_db("destination", root = path)
on.exit(DBI::dbDisconnect(con))
workflow <- DBI::dbGetQuery(con, "SELECT * FROM workflow")
expect_equal(workflow, data_frame(id = "123"))
report_version_workflow <-
DBI::dbGetQuery(con, "SELECT * FROM report_version_workflow")
expect_equal(report_version_workflow, data_frame(report_version = id,
workflow_id = "123"))
id2 <- orderly_run_internal("example", root = path, id_file = tmp,
commit = TRUE, echo = FALSE,
workflow_id = "123")
rds <- path_orderly_run_rds(file.path(path, "archive", "example", id2))
expect_true(file.exists(rds))
dat <- readRDS(rds)
expect_equal(dat$meta$workflow, "123")
workflow <- DBI::dbGetQuery(con, "SELECT * FROM workflow")
expect_equal(workflow, data_frame(id = "123"))
report_version_workflow <-
DBI::dbGetQuery(con, "SELECT * FROM report_version_workflow")
expect_equal(report_version_workflow,
data_frame(report_version = c(id, id2),
workflow_id = c("123", "123")))
})
test_that("Can run a report with no fields, when all are optional", {
path <- test_prepare_orderly_example("minimal")
on.exit(unlink(path, recursive = TRUE))
append_lines(
c("fields:", " requester:",
" required: false",
" author:",
" required: false"),
file.path(path, "orderly_config.yml"))
id <- orderly_run("example", root = path, echo = FALSE)
d <- readRDS(path_orderly_run_rds(file.path(path_draft(path), "example", id)))
expect_equal(d$meta$extra_fields,
data_frame(requester = NA_character_,
author = NA_character_))
orderly_commit(id, root = path)
con <- orderly_db("destination", root = path)
on.exit(DBI::dbDisconnect(con, add = TRUE, after = FALSE))
expect_equal(DBI::dbReadTable(con, "report_version")$id, id)
})
test_that("prevent use of 'rm(list = ls())' at top level", {
path <- test_prepare_orderly_example("minimal")
on.exit(unlink(path, recursive = TRUE))
path_src <- file.path(path, "src", "example", "script.R")
src <- readLines(path_src)
writeLines(c("rm(list = ls(all = TRUE))", src), path_src)
expect_error(
orderly_run("example", root = path),
"Do not use 'rm(list = ls())' or similar in your script",
fixed = TRUE)
})
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.