tests/testthat/test-class_pattern.R

In targets: Dynamic Function-Oriented 'Make'-Like Declarative Pipelines

tar_test("print pipeline", {
  x <- tar_target(x, 1)
  y <- pipeline_init(list(x))
  expect_true(is.character(utils::capture.output(print(y))))
})

tar_test("pattern initializes correctly", {
  x <- target_init("x", expr = quote(1 + 1), pattern = quote(map(a, b)))
  expect_true(inherits(x, "tar_pattern"))
})

tar_test("target_get_parent(pattern)", {
  x <- target_init("x", expr = quote(1 + 1), pattern = quote(map(a, b)))
  expect_equal(target_get_parent(x), "x")
})

tar_test("pattern$patternview", {
  x <- target_init("x", expr = quote(1 + 1), pattern = quote(map(a, b)))
  expect_silent(patternview_validate(x$patternview))
})

tar_test("run a simple map and check output", {
  pipeline <- pipeline_init(
    list(
      target_init(
        name = "data",
        expr = quote(seq_len(3L))
      ),
      target_init(
        name = "map",
        expr = quote(data),
        pattern = quote(map(data))
      )
    )
  )
  local <- local_init(pipeline)
  local$run()
  expect_equal(
    target_read_value(pipeline_get_target(pipeline, "data"))$object,
    seq_len(3L)
  )
  branches <- target_get_children(pipeline_get_target(pipeline, "map"))
  for (index in seq_along(branches)) {
    value <- target_read_value(pipeline_get_target(pipeline, branches[index]))
    out <- value$object
    expect_equal(out, index)
  }
})

tar_test("map over a non-dep", {
  pipeline <- pipeline_init(
    list(
      target_init(
        name = "data",
        expr = quote(seq_len(3L))
      ),
      target_init(
        name = "map",
        expr = quote("a"),
        pattern = quote(map(data))
      )
    )
  )
  local <- local_init(pipeline)
  local$run()
  branches <- target_get_children(pipeline_get_target(pipeline, "map"))
  for (index in seq_along(branches)) {
    value <- target_read_value(pipeline_get_target(pipeline, branches[index]))
    out <- value$object
    expect_equal(out, "a")
  }
})

tar_test("can load an entire map", {
  pipeline <- pipeline_init(
    list(
      target_init(
        name = "data",
        expr = quote(seq_len(3L))
      ),
      target_init(
        name = "map",
        expr = quote(data),
        pattern = quote(map(data))
      )
    )
  )
  local <- local_init(pipeline)
  local$run()
  expect_equal(counter_get_names(pipeline$loaded), character(0))
  target <- pipeline_get_target(pipeline, "map")
  target_load_value(target, pipeline)
  out <- sort(counter_get_names(pipeline$loaded))
  branches <- target_get_children(pipeline_get_target(pipeline, "map"))
  exp <- sort(c("map", branches))
  expect_equal(out, exp)
})

tar_test("vector aggregation", {
  pipeline <- pipeline_init(
    list(
      target_init(
        name = "data",
        expr = quote(seq_len(3L))
      ),
      target_init(
        name = "map",
        expr = quote(data),
        pattern = quote(map(data)),
        iteration = "vector"
      ),
      target_init(
        name = "combine",
        expr = quote(map)
      )
    )
  )
  local <- local_init(pipeline)
  local$run()
  out <- target_read_value(pipeline_get_target(pipeline, "combine"))$object
  expect_equiv(out, seq_len(3L))
  expect_named(out, target_get_children(pipeline_get_target(pipeline, "map")))
})

tar_test("list aggregation", {
  pipeline <- pipeline_init(
    list(
      target_init(
        name = "data",
        expr = quote(seq_len(3L))
      ),
      target_init(
        name = "map",
        expr = quote(data),
        pattern = quote(map(data)),
        iteration = "list"
      ),
      target_init(
        name = "combine",
        expr = quote(map)
      )
    )
  )
  local <- local_init(pipeline)
  local$run()
  out <- target_read_value(pipeline_get_target(pipeline, "combine"))$object
  expect_equiv(out, as.list(seq_len(3L)))
  expect_named(out, target_get_children(pipeline_get_target(pipeline, "map")))
})

tar_test("group iteration", {
  pipeline <- pipeline_init(
    list(
      target_init(
        name = "data",
        expr = quote(
          data.frame(
            x = seq_len(6),
            tar_group = rep(seq_len(3), each = 2)
          )
        ),
        iteration = "group"
      ),
      target_init(
        name = "map",
        expr = quote(sum(data$x)),
        pattern = quote(map(data)),
        iteration = "vector"
      ),
      target_init(
        name = "combine",
        expr = quote(map)
      )
    )
  )
  local <- local_init(pipeline)
  local$run()
  out <- target_read_value(pipeline_get_target(pipeline, "combine"))$object
  expect_true(is.data.frame(tar_read(data)))
  expect_equiv(out, c(3L, 7L, 11L))
})

tar_test("error relaying", {
  pipeline <- pipeline_init(
    list(
      target_init(
        name = "data",
        expr = quote(stop(123))
      ),
      target_init(
        name = "map",
        expr = quote(data),
        pattern = quote(map(data))
      )
    )
  )
  local <- local_init(pipeline)
  expect_error(local$run(), class = "tar_condition_run")
})

tar_test("maps produce correct junctions and bud niblings", {
  pipeline <- pipeline_map()
  local <- local_init(pipeline)
  pipeline_prune_names(local$pipeline, local$names)
  local$update_scheduler()
  scheduler <- local$scheduler
  local$ensure_meta()
  local$process_target("data1")
  local$process_target("data2")
  target <- pipeline_get_target(pipeline, "map2")
  out <- target_produce_junction(target, pipeline)$deps
  expect_equal(dim(out), c(3L, 2L))
  expect_true(all(grepl("data1_", out$data1)))
  expect_true(all(grepl("data2_", out$data2)))
  buds <- map_int(seq_len(3), function(index) {
    bud <- pipeline_get_target(pipeline, out$data1[index])
    target_load_value(bud, pipeline)
    bud$value$object
  })
  expect_equal(buds, seq_len(3))
  buds <- map_int(seq_len(3), function(index) {
    bud <- pipeline_get_target(pipeline, out$data2[index])
    target_load_value(bud, pipeline)
    bud$value$object
  })
  expect_equal(buds, seq_len(3) + 3L)
})

tar_test("correct junction of a non-mapped stem", {
  pipeline <- pipeline_map()
  local <- local_init(pipeline)
  pipeline_prune_names(local$pipeline, local$names)
  local$update_scheduler()
  scheduler <- local$scheduler
  local$ensure_meta()
  local$process_target("data0")
  local$process_target("data1")
  target <- pipeline_get_target(pipeline, "map1")
  out <- target_produce_junction(target, pipeline)$deps
  expect_equal(dim(out), c(3L, 2L))
  expect_true(all(grepl("data1_", out$data1)))
  expect_equal(out$data0, rep("data0", 3))
  buds <- map_int(seq_len(3), function(index) {
    bud <- pipeline_get_target(pipeline, out$data1[index])
    target_load_value(bud, pipeline)
    bud$value$object
  })
  expect_equal(buds, seq_len(3))
  dep <- map_int(seq_len(3), function(index) {
    bud <- pipeline_get_target(pipeline, out$data0[index])
    target_load_value(bud, pipeline)
    bud$value$object
  })
  expect_equal(dep, rep(2L, 3L))
})

tar_test("run a pipeline with maps", {
  pipeline <- pipeline_map()
  local <- local_init(pipeline)
  local$run()
  value <- function(name) {
    target_read_value(pipeline_get_target(pipeline, name))$object
  }
  expect_equal(value("data0"), 2L)
  expect_equal(value("data1"), seq_len(3L))
  expect_equal(value("data2"), seq_len(3L) + 3L)
  branches <- target_get_children(pipeline_get_target(pipeline, "map1"))
  for (index in seq_along(branches)) {
    expect_equal(value(branches[index]), index + 2L)
  }
  branches <- target_get_children(pipeline_get_target(pipeline, "map2"))
  for (index in seq_along(branches)) {
    expect_equal(value(branches[index]), 2L * index + 3L)
  }
  branches <- target_get_children(pipeline_get_target(pipeline, "map3"))
  for (index in seq_along(branches)) {
    expect_equal(value(branches[index]), index + 3L)
  }
  branches <- target_get_children(pipeline_get_target(pipeline, "map4"))
  for (index in seq_along(branches)) {
    expect_equal(value(branches[index]), 3L * index + 5L)
  }
  branches <- target_get_children(pipeline_get_target(pipeline, "map5"))
  for (index in seq_along(branches)) {
    expect_equal(value(branches[index]), 2L * index + 5L)
  }
  branches <- target_get_children(pipeline_get_target(pipeline, "map6"))
  for (index in seq_along(branches)) {
    expect_equal(value(branches[index]), index + 15L)
  }
})

tar_test("same with worker retrieval", {
  pipeline <- pipeline_map()
  local <- local_init(pipeline)
  for (name in pipeline_get_names(pipeline)) {
    target <- pipeline_get_target(pipeline, name)
    settings <- target$settings
    settings$retrieval <- "worker"
    target$settings <- settings
  }
  local$run()
  value <- function(name) {
    target_read_value(pipeline_get_target(pipeline, name))$object
  }
  expect_equal(value("data0"), 2L)
  expect_equal(value("data1"), seq_len(3L))
  expect_equal(value("data2"), seq_len(3L) + 3L)
  branches <- target_get_children(pipeline_get_target(pipeline, "map1"))
  for (index in seq_along(branches)) {
    expect_equal(value(branches[index]), index + 2L)
  }
  branches <- target_get_children(pipeline_get_target(pipeline, "map2"))
  for (index in seq_along(branches)) {
    expect_equal(value(branches[index]), 2L * index + 3L)
  }
  branches <- target_get_children(pipeline_get_target(pipeline, "map3"))
  for (index in seq_along(branches)) {
    expect_equal(value(branches[index]), index + 3L)
  }
  branches <- target_get_children(pipeline_get_target(pipeline, "map4"))
  for (index in seq_along(branches)) {
    expect_equal(value(branches[index]), 3L * index + 5L)
  }
  branches <- target_get_children(pipeline_get_target(pipeline, "map5"))
  for (index in seq_along(branches)) {
    expect_equal(value(branches[index]), 2L * index + 5L)
  }
  branches <- target_get_children(pipeline_get_target(pipeline, "map6"))
  for (index in seq_along(branches)) {
    expect_equal(value(branches[index]), index + 15L)
  }
})

tar_test("branches with different names use different seeds", {
  a <- target_init(name = "a", expr = quote(c(1, 1)))
  b <- target_init(
    name = "b",
    expr = quote(sample.int(1e9, a)),
    pattern = quote(map(a))
  )
  pipeline <- pipeline_init(list(a, b), clone_targets = FALSE)
  local_init(pipeline)$run()
  target_load_value(b, pipeline)
  out <- b$value$object
  expect_false(out[1] == out[2])
})

tar_test("map over a stem that was not mapped over last time", {
  pipeline <- pipeline_init(
    list(
      target_init(
        name = "data",
        expr = quote(seq_len(3L))
      ),
      target_init(
        name = "map",
        expr = quote(data)
      )
    )
  )
  local <- local_init(pipeline)
  local$run()
  pipeline <- pipeline_init(
    list(
      target_init(
        name = "data",
        expr = quote(seq_len(3L))
      ),
      target_init(
        name = "map",
        expr = quote(data),
        pattern = quote(map(data))
      )
    )
  )
  local <- local_init(pipeline)
  local$run()
  expect_equal(
    target_read_value(pipeline_get_target(pipeline, "data"))$object,
    seq_len(3L)
  )
  branches <- target_get_children(pipeline_get_target(pipeline, "map"))
  expect_length(branches, 3L)
  for (index in seq_along(branches)) {
    value <- target_read_value(pipeline_get_target(pipeline, branches[index]))
    out <- value$object
    expect_equal(out, index)
  }
})

tar_test("pattern$produce_record() of a successful map", {
  stem <- target_init("x", quote(sample.int(4)))
  target <- target_init("y", quote(x), pattern = quote(map(x)))
  pipeline <- pipeline_init(list(stem, target), clone_targets = FALSE)
  local <- local_init(pipeline)
  local$run()
  meta <- local$meta
  record <- target_produce_record(target, pipeline, meta)
  expect_silent(record_validate(record))
  expect_equal(record$name, "y")
  expect_equal(record$parent, NA_character_)
  expect_equal(record$type, "pattern")
  expect_equal(nchar(record$command), 16L)
  expect_equal(record$depend, NA_character_)
  expect_equal(record$path, NA_character_)
  expect_equal(nchar(record$data), 16L)
  expect_false(is.na(record$bytes))
  expect_true(is.numeric(record$bytes))
  expect_equal(record$time, NA_character_)
  expect_equal(record$format, "rds")
  expect_equal(record$iteration, "vector")
  expect_equal(record$children, target_get_children(target))
  expect_false(is.na(record$seconds))
  expect_true(is.numeric(record$seconds))
  expect_equal(record$warnings, NA_character_)
  expect_equal(record$error, NA_character_)
})

tar_test("map over empty stem", {
  pipeline <- pipeline_init(
    list(
      target_init(
        name = "data",
        expr = quote(character(0))
      ),
      target_init(
        name = "map",
        expr = quote(data),
        pattern = quote(map(data))
      )
    )
  )
  local <- local_init(pipeline)
  expect_error(local$run(), class = "tar_condition_run")
})

tar_test("empty mapping variable", {
  pipeline <- pipeline_init(
    list(
      target_init("x", quote(NULL)),
      target_init("y", quote(x), pattern = quote(map(x)))
    )
  )
  expect_error(
    local_init(pipeline)$run(),
    class = "tar_condition_run"
  )
})

tar_test("inconformable mapping variables", {
  pipeline <- pipeline_init(
    list(
      target_init("x", quote(seq_len(2L))),
      target_init("y", quote(seq_len(3L))),
      target_init("z", quote(x), pattern = quote(map(x, y)))
    )
  )
  expect_error(
    local_init(pipeline)$run(),
    class = "tar_condition_validate"
  )
})

tar_test("pattern print", {
  x <- tar_target(w, 1, map(x, y, z))
  out <- utils::capture.output(print(x))
  expect_true(any(grepl("pattern", out)))
})

tar_test("must branch over stems and patterns", {
  pipeline <- pipeline_init(
    list(
      target_init("x", quote(seq_len(2))),
      target_init("y", quote(x), pattern = quote(map(z)))
    )
  )
  algo <- local_init(pipeline = pipeline)
  expect_error(algo$run(), class = "tar_condition_validate")
})

tar_test("pattern dims are always deps", {
  x <- target_init("x", quote(seq_len(2)), pattern = quote(map(y)))
  expect_true("y" %in% x$command$deps)
})

tar_test("pattern dims are always deps when run", {
  pipeline <- pipeline_init(
    list(
      target_init("y", quote(seq_len(2))),
      target_init("x", quote("x"), pattern = quote(map(y)))
    )
  )
  local_init(pipeline)$run()
  x <- target_init("x", quote("x"), pattern = quote(map(y)))
  out <- target_read_value(pipeline_get_target(pipeline, "x"), pipeline)$object
  expect_equiv(out, c("x", "x"))
})

tar_test("patterns and branches get correct ranks with priorities", {
  pipeline <- pipeline_init(
    list(
      target_init("x", quote(seq_len(2)), priority = 0.1),
      target_init("z", quote(stop(x)), pattern = quote(map(x)), priority = 0.3),
      target_init("y", quote(stop(x)), pattern = quote(map(x)), priority = 0.2),
      target_init("w", quote(c(y, z)), priority = 0.4)
    )
  )
  algo <- local_init(pipeline, queue = "parallel")
  expect_error(algo$run())
  out <- algo$scheduler$queue$data
  branch_names <- target_get_children(pipeline_get_target(pipeline, "z"))
  branch_name <- intersect(branch_names, names(out))
  exp <- c(
    y = 0 - 0.2 / 2,
    w = 2 - 0.4 / 2,
    z = 1 - 1.1 / 2
  )
  exp[branch_name] <- 0 - 0.3 / 2
  expect_equal(sort(names(out)), sort(names(exp)))
  expect_equal(out[names(exp)], exp)
})

tar_test("prohibit branching over stem files", {
  file.create(c("a", "b"))
  pipeline <- pipeline_init(
    list(
      target_init("paths", quote(c("a", "b")), format = "file"),
      target_init("data", quote(paths), pattern = quote(map(paths)))
    )
  )
  algo <- local_init(pipeline)
  expect_error(algo$run(), class = "tar_condition_validate")
})

tar_test("cross pattern initializes correctly", {
  x <- target_init("x", expr = quote(1 + 1), pattern = quote(cross(a, b)))
  expect_true(inherits(x, "tar_pattern"))
})

tar_test("target_get_parent(pattern with cross)", {
  x <- target_init("x", expr = quote(1 + 1), pattern = quote(cross(a, b)))
  expect_equal(target_get_parent(x), "x")
})

tar_test("pattern$patternview with cross", {
  x <- target_init("x", expr = quote(1 + 1), pattern = quote(cross(a, b)))
  expect_silent(patternview_validate(x$patternview))
})

tar_test("cross produces correct junctions and bud niblings", {
  pipeline <- pipeline_cross()
  local <- local_init(pipeline)
  pipeline_prune_names(local$pipeline, local$names)
  local$update_scheduler()
  scheduler <- local$scheduler
  local$ensure_meta()
  local$process_target("data1")
  local$process_target("data2")
  cross2 <- pipeline_get_target(pipeline, "cross2")
  splits <- target_produce_junction(cross2, pipeline)$splits
  expect_true(all(grepl("cross2_", splits)))
  target <- pipeline_get_target(pipeline, "cross2")
  out <- target_produce_junction(target, pipeline)$deps
  expect_equal(dim(out), c(9L, 2L))
  expect_true(all(grepl("data1_", out$data1)))
  expect_true(all(grepl("data2_", out$data2)))
  buds <- map_int(seq_len(9), function(index) {
    bud <- pipeline_get_target(pipeline, out$data1[index])
    target_load_value(bud, pipeline)
    bud$value$object
  })
  expect_equal(buds, rep(seq_len(3), each = 3))
  buds <- map_int(seq_len(9), function(index) {
    bud <- pipeline_get_target(pipeline, out$data2[index])
    target_load_value(bud, pipeline)
    pipeline_get_target(pipeline, out$data2[index])$value$object
  })
  expect_equal(buds, rep(rev(seq_len(3)), times = 3))
})

tar_test("correct junction of non-crossed stems", {
  pipeline <- pipeline_cross()
  local <- local_init(pipeline)
  pipeline_prune_names(local$pipeline, local$names)
  local$update_scheduler()
  scheduler <- local$scheduler
  local$ensure_meta()
  local$process_target("data1")
  local$process_target("data2")
  cross2 <- pipeline_get_target(pipeline, "cross2")
  splits <- target_produce_junction(cross2, pipeline)$splits
  expect_true(all(grepl("cross2_", splits)))
  target <- pipeline_get_target(pipeline, "cross2")
  out <- target_produce_junction(target, pipeline)$deps
  expect_equal(dim(out), c(9L, 2L))
  expect_true(all(grepl("data1_", out$data1)))
  expect_true(all(grepl("data2_", out$data2)))
  exp <- expand_grid(data1 = unique(out$data1), data2 = unique(out$data2))
  expect_equal(out, exp)
})

tar_test("cross pipeline gives correct values", {
  pipeline <- pipeline_cross()
  local <- local_init(pipeline)
  scheduler <- local$scheduler
  local$run()
  value <- function(name) {
    target_read_value(pipeline_get_target(pipeline, name))$object
  }
  expect_equal(value("data1"), seq_len(3L))
  expect_equal(value("data2"), rev(seq_len(3L)))
  branches <- target_get_children(pipeline_get_target(pipeline, "map1"))
  children <- target_get_children(pipeline_get_target(pipeline, "map1"))
  out <- map_int(children, value)
  expect_equiv(out, seq(11, 13))
  children <- target_get_children(pipeline_get_target(pipeline, "cross1"))
  out1 <- map_int(children, value)
  exp1 <- seq(2, 4)
  expect_equiv(out1, exp1)
  children <- target_get_children(pipeline_get_target(pipeline, "cross2"))
  out2 <- map_int(children, value)
  exp2 <- rowSums(expand_grid(x = seq_len(3L), y = rev(seq_len(3L))))
  expect_equiv(out2, exp2)
  children <- target_get_children(pipeline_get_target(pipeline, "cross3"))
  out3 <- map_int(children, value)
  exp3 <- rowSums(expand_grid(x = seq_len(3L), y = seq(11, 13)))
  expect_equiv(out3, exp3)
  expect_equal(value("out1"), sum(exp1))
  expect_equal(value("out2"), sum(exp2))
  expect_equal(value("out3"), sum(exp3))
  expect_equal(value("out4"), sum(exp1) + sum(exp2))
  expect_equal(value("out5"), sum(exp2) + sum(exp3))
  expect_equiv(value("out6"), c(12, 25))
  children <- target_get_children(pipeline_get_target(pipeline, "map2"))
  out <- map_int(children, value)
  expect_equiv(out, c(144, 625))
})

tar_test("empty crossing variable", {
  pipeline <- pipeline_init(
    list(
      target_init("x", quote(NULL)),
      target_init("y", quote(x), pattern = quote(cross(x)))
    )
  )
  expect_error(
    local_init(pipeline)$run(),
    class = "tar_condition_run"
  )
})

tar_test("composed pattern", {
  tar_script(
    list(
      tar_target(w, seq_len(2)),
      tar_target(x, letters[seq_len(3)]),
      tar_target(y, LETTERS[seq_len(3)]),
      tar_target(
        z,
        data.frame(w = w, x = x, y = y, stringsAsFactors = FALSE),
        pattern = cross(w, map(x, y))
      )
    )
  )
  tar_make(callr_function = NULL)
  out <- tar_read(z)
  exp <- data_frame(
    w = rep(c(1, 2), each = 3),
    x = rep(c("a", "b", "c"), times = 2),
    y = rep(c("A", "B", "C"), times = 2)
  )
  expect_equal(out, exp)
})

tar_test("cross pattern with many inputs", {
  tar_script(
    list(
      tar_target(w, seq_len(2)),
      tar_target(x, letters[seq_len(3)]),
      tar_target(y, LETTERS[seq_len(3)]),
      tar_target(
        z,
        data.frame(w = w, x = x, y = y, stringsAsFactors = FALSE),
        pattern = cross(w, x, y)
      )
    )
  )
  tar_make(callr_function = NULL)
  out <- tar_read(z)
  exp <- data_frame(
    w = rep(c(1, 2), each = 9),
    x = rep(rep(c("a", "b", "c"), each = 3), times = 2),
    y = rep(c("A", "B", "C"), times = 6)
  )
  expect_equal(out, exp)
})

tar_test("head pattern in pipeline", {
  tar_script({
    list(
      tar_target(x, seq_len(26)),
      tar_target(dynamic, x, pattern = head(x, n = 2))
    )
  })
  tar_make(callr_function = NULL)
  expect_equal(unname(tar_read(dynamic)), seq_len(2))
})

tar_test("tail pattern in pipeline", {
  tar_script({
    list(
      tar_target(x, seq_len(26)),
      tar_target(dynamic, x, pattern = tail(x, n = 2))
    )
  })
  tar_make(callr_function = NULL)
  expect_equal(unname(tar_read(dynamic)), tail(seq_len(26), 2))
})

tar_test("sample pattern in pipeline", {
  tar_script({
    list(
      tar_target(x, seq_len(26)),
      tar_target(dynamic, x, pattern = sample(x, n = 2))
    )
  })
  set.seed(1)
  tar_make(callr_function = NULL)
  out <- tar_read(dynamic)
  tar_destroy()
  set.seed(2)
  tar_make(callr_function = NULL)
  out2 <- tar_read(dynamic)
  expect_equal(out, out2)
  expect_true(is.numeric(out))
  expect_length(out, 2)
})

tar_test("cross pattern validate", {
  x <- target_init("x", expr = quote(1 + 1), pattern = quote(cross(a, b)))
  expect_silent(target_validate(x))
})

tar_test("aggregate names of branches with length > 1 (#320)", {
  tar_script({
    list(
      tar_target(x, seq_len(2), iteration = "vector"),
      tar_target(y, rep(x, 2), pattern = map(x), iteration = "vector"),
      tar_target(z, y, iteration = "vector")
    )
  })
  expect_silent(tar_make(callr_function = NULL, reporter = "silent"))
  out <- tar_read(z)
  expect_length(names(out), 4)
  expect_length(unique(names(out)), 4)
  expect_equal(unname(out), c(1, 1, 2, 2))
})

tar_test("target_needs_worker(pattern)", {
  x <- tar_target(y, rep(x, 2), pattern = map(x), deployment = "worker")
  expect_true(target_needs_worker(x))
  x$junction <- list()
  expect_false(target_needs_worker(x))
  x <- tar_target(y, rep(x, 2), pattern = map(x), deployment = "main")
  expect_false(target_needs_worker(x))
  x$junction <- list()
  expect_false(target_needs_worker(x))
})

tar_test("bootstrap a pattern for a shortcut pattern and stem", {
  tar_script({
    list(
      tar_target(w, seq_len(2)),
      tar_target(x, w, pattern = map(w)),
      tar_target(y, x, pattern = map(x)),
      tar_target(z, sum(x))
    )
  })
  tar_make(callr_function = NULL)
  expect_equal(unname(tar_read(y)), c(1L, 2L))
  expect_equal(tar_read(z), 3L)
  tar_make(names = c("y", "z"), shortcut = TRUE, callr_function = NULL)
  p <- tar_progress()
  expect_equal(nrow(p), 4L)
  expect_equal(p$progress[grepl("^y_", p$name)], rep("skipped", 2L))
  expect_equal(p$progress[p$name == "y"], "skipped")
  expect_equal(p$progress[p$name == "z"], "skipped")
  tar_script({
    list(
      tar_target(w, seq_len(2)),
      tar_target(x, w, pattern = map(w)),
      tar_target(y, x + 1L, pattern = map(x)),
      tar_target(z, sum(x) + 1L)
    )
  })
  tar_make(names = c("y", "z"), shortcut = TRUE, callr_function = NULL)
  expect_equal(unname(tar_read(y)), c(2L, 3L))
  expect_equal(tar_read(z), 4L)
  p <- tar_progress()
  expect_equal(nrow(p), 4L)
  expect_equal(p$progress[grepl("^y_", p$name)], rep("completed", 2L))
  expect_equal(p$progress[p$name == "y"], "completed")
  expect_equal(p$progress[p$name == "z"], "completed")
})

tar_test("shortcut error trying to branch over empty stem", {
  skip_cran()
  tar_script(
    list(
      tar_target(x, NULL),
      tar_target(y, x)
    )
  )
  tar_make(callr_function = NULL)
  tar_invalidate(y)
  tar_make(y, shortcut = TRUE, callr_function = NULL)
  out <- tar_progress()
  expect_equal(out$name, "y")
  expect_equal(out$progress, "completed")
  expect_null(tar_read(y))
  tar_script(
    list(
      tar_target(x, NULL),
      tar_target(y, x, pattern = map(x))
    )
  )
  expect_error(
    tar_make(y, shortcut = TRUE, callr_function = NULL),
    class = "tar_condition_run"
  )
})

tar_test("pattern validate", {
  x <- target_init("x", expr = quote(1 + 1), pattern = quote(map(a, b)))
  expect_silent(target_validate(x))
})

tar_test("pattern validate with bad junction", {
  x <- target_init("x", expr = quote(1 + 1), pattern = quote(map(a, b)))
  x$junction <- junction_new()
  expect_error(target_validate(x), class = "tar_condition_validate")
})