Nothing
tar_test("progress database subkey", {
out <- progress_init()
expect_equal(
out$database$key,
file.path(path_store_default(), "meta", "progress")
)
})
tar_test("progress$queued", {
expect_silent(counter_validate(progress_init()$queued))
})
tar_test("progress$dispatched", {
expect_silent(counter_validate(progress_init()$dispatched))
})
tar_test("progress$completed", {
expect_silent(counter_validate(progress_init()$completed))
})
tar_test("progress$skipped", {
expect_silent(counter_validate(progress_init()$skipped))
})
tar_test("progress$canceled", {
expect_silent(counter_validate(progress_init()$canceled))
})
tar_test("progress$errored", {
expect_silent(counter_validate(progress_init()$errored))
})
tar_test("progress$assign_queued()", {
progress <- progress_init()
progress$assign_queued(target_init("x", 1))
expect_equal(counter_get_names(progress$completed), character(0))
expect_equal(counter_get_names(progress$queued), "x")
})
tar_test("progress$assign_dispatched()", {
progress <- progress_init()
progress$assign_queued(target_init("x", 1))
progress$assign_dispatched(target_init("x", 1))
expect_equal(counter_get_names(progress$queued), character(0))
expect_equal(counter_get_names(progress$dispatched), "x")
})
tar_test("progress$assign_skipped()", {
progress <- progress_init()
progress$assign_queued(target_init("x", 1))
progress$assign_skipped(target_init("x", 1))
expect_equal(counter_get_names(progress$queued), character(0))
expect_equal(counter_get_names(progress$skipped), "x")
})
tar_test("progress$assign_completed()", {
progress <- progress_init()
progress$assign_dispatched(target_init("x", 1))
progress$assign_completed(target_init("x", 1))
expect_equal(counter_get_names(progress$dispatched), character(0))
expect_equal(counter_get_names(progress$completed), "x")
})
tar_test("progress$assign_canceled()", {
progress <- progress_init()
progress$assign_dispatched(target_init("x", 1))
progress$assign_canceled(target_init("x", 1))
expect_equal(counter_get_names(progress$dispatched), character(0))
expect_equal(counter_get_names(progress$canceled), "x")
})
tar_test("progress$assign_errored()", {
progress <- progress_init()
progress$assign_dispatched(target_init("x", 1))
progress$assign_errored(target_init("x", 1))
expect_equal(counter_get_names(progress$dispatched), character(0))
expect_equal(counter_get_names(progress$errored), "x")
})
tar_test("progress$register_dispatched()", {
progress <- progress_init()
progress$database$reset_storage()
progress$register_dispatched(target_init("x", 1))
expect_equal(counter_get_names(progress$dispatched), "x")
progress$database$flush_rows()
data <- progress$database$read_data()
exp <- data_frame(
name = "x",
type = "stem",
parent = "x",
branches = 0L,
progress = "dispatched"
)
expect_equal(data, exp)
})
tar_test("progress$register_completed()", {
progress <- progress_init()
progress$database$reset_storage()
progress$register_completed(target_init("x", 1))
expect_equal(counter_get_names(progress$completed), "x")
progress$database$flush_rows()
data <- progress$database$read_data()
exp <- data_frame(
name = "x",
type = "stem",
parent = "x",
branches = 0L,
progress = "completed"
)
expect_equal(data, exp)
})
tar_test("progress$register_canceled()", {
progress <- progress_init()
progress$database$reset_storage()
progress$register_canceled(target_init("x", 1))
expect_equal(counter_get_names(progress$canceled), "x")
progress$database$flush_rows()
data <- progress$database$read_data()
exp <- data_frame(
name = "x",
type = "stem",
parent = "x",
branches = 0L,
progress = "canceled"
)
expect_equal(data, exp)
})
tar_test("progress$register_errored()", {
progress <- progress_init()
progress$database$reset_storage()
progress$register_errored(target_init("x", 1))
expect_equal(counter_get_names(progress$errored), "x")
progress$database$flush_rows()
data <- progress$database$read_data()
exp <- data_frame(
name = "x",
type = "stem",
parent = "x",
branches = 0L,
progress = "errored"
)
expect_equal(data, exp)
})
tar_test("progress$any_remaining() while queued", {
progress <- progress_init()
expect_false(progress$any_remaining())
progress$assign_queued(target_init("x", 1))
expect_true(progress$any_remaining())
})
tar_test("progress$any_targets()", {
progress <- progress_init()
expect_false(progress$any_targets())
counter_set_name(progress$completed, "x")
expect_true(progress$any_targets())
})
tar_test("progress$any_remaining() while dispatched", {
progress <- progress_init()
expect_false(progress$any_remaining())
progress$assign_dispatched(target_init("x", 1))
expect_true(progress$any_remaining())
})
tar_test("progress database gets used", {
x <- target_init("x", quote(1))
y <- target_init("y", quote(x))
local <- local_init(pipeline_init(list(x, y)))
local$run()
out <- local$scheduler$progress$database$read_data()
exp <- data_frame(
name = c("x", "x", "y", "y"),
type = rep("stem", 4L),
parent = c("x", "x", "y", "y"),
branches = rep(0L, 4L),
progress = c("dispatched", "completed", "dispatched", "completed")
)
expect_equal(out, exp)
x <- target_init("x", quote(1))
y <- target_init("y", quote(x))
local <- local_init(pipeline_init(list(x, y)))
local$run()
out <- local$scheduler$progress$database$read_data()
exp <- c("name", "type", "parent", "branches", "progress")
expect_equal(colnames(out), exp)
expect_equal(nrow(out), 2L)
expect_equal(out$progress, rep("skipped", 2L))
})
tar_test("progress records dynamic branching data", {
tar_script(
list(
tar_target(x, seq_len(2)),
tar_target(y, x, pattern = map(x))
)
)
tar_make(callr_function = NULL)
out <- tar_progress(fields = NULL)
branches <- out[out$type == "branch", ]
expect_equal(dim(branches), c(2L, 5L))
expect_true(all(grepl("^y_", branches$name)))
expect_equal(branches$type, rep("branch", 2))
expect_equal(branches$parent, rep("y", 2))
expect_equal(branches$branches, rep(0L, 2))
expect_equal(branches$progress, rep("completed", 2))
x <- out[out$name == "x", ]
y <- out[out$name == "y", ]
nonbranches <- rbind(x, y)
expect_equal(nonbranches$name, c("x", "y"))
expect_equal(nonbranches$type, c("stem", "pattern"))
expect_equal(nonbranches$parent, c("x", "y"))
expect_equal(nonbranches$branches, c(0L, 2L))
expect_equal(nonbranches$progress, rep("completed", 2))
})
tar_test("progress records dynamic branching error status", {
tar_script(
list(
tar_target(x, seq_len(2)),
tar_target(y, stopifnot(x < 1.5), pattern = map(x))
)
)
expect_error(tar_make(callr_function = NULL))
out <- tar_progress(fields = NULL)
x <- out[out$progress == "errored" & out$type == "pattern", ]
expect_equal(x$name, "y")
expect_equal(x$type, "pattern")
expect_equal(x$parent, "y")
expect_equal(x$branches, 2L)
expect_equal(x$progress, "errored")
x <- out[out$progress == "errored" & out$type == "branch", ]
expect_true(all(grepl("^y_", x$name)))
expect_equal(x$type, "branch")
expect_equal(x$parent, "y")
expect_equal(x$branches, 0L)
expect_equal(x$progress, "errored")
})
tar_test("progress$validate()", {
expect_silent(progress_init()$validate())
})
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.