diff --git a/R/class_junction.R b/R/class_junction.R index c58f734c..34867e68 100644 --- a/R/class_junction.R +++ b/R/class_junction.R @@ -23,6 +23,10 @@ junction_upstream_edges <- function(junction) { data_frame(from = from, to = to) } +junction_get_splits <- function(junction) { + as.character(junction$splits) +} + junction_transpose <- function(junction) { splits <- junction$splits deps <- junction$deps @@ -34,6 +38,10 @@ junction_transpose <- function(junction) { out } +junction_invalidate <- function(junction) { + junction$splits <- rep(NA_character_, length(junction$splits)) +} + junction_validate_deps <- function(deps) { if (!is.null(deps) && !is.data.frame(deps)) { tar_throw_validate("deps field of junction must be null or a data frame.") diff --git a/R/class_outdated.R b/R/class_outdated.R index 4191c54f..c009ead4 100644 --- a/R/class_outdated.R +++ b/R/class_outdated.R @@ -104,8 +104,7 @@ outdated_class <- R6::R6Class( }, reset_junction = function(target) { if (!is.null(target$junction)) { - new_splits <- rep(NA_character_, length(target$junction$splits)) - target$junction$splits <- new_splits + junction_invalidate(target$junction) } }, register_checked = function(name) { diff --git a/R/class_pattern.R b/R/class_pattern.R index d74b197c..bd3e4ad8 100644 --- a/R/class_pattern.R +++ b/R/class_pattern.R @@ -44,7 +44,7 @@ pattern_s3_class <- c("tar_pattern", "tar_target") #' @export target_get_children.tar_pattern <- function(target) { - as.character(target$junction$splits) + junction_get_splits(target$junction) } #' @export diff --git a/R/class_stem.R b/R/class_stem.R index 6da77d88..f28023af 100644 --- a/R/class_stem.R +++ b/R/class_stem.R @@ -47,7 +47,7 @@ target_get_children.tar_stem <- function(target) { if_any( is.null(target$junction), character(0), - target$junction$splits + junction_get_splits(target$junction) ) } diff --git a/tests/testthat/test-class_junction.R b/tests/testthat/test-class_junction.R index 5dc7374f..8f35e46b 100644 --- a/tests/testthat/test-class_junction.R +++ b/tests/testthat/test-class_junction.R @@ -5,6 +5,17 @@ tar_test("junction deps", { expect_equal(out, exp) }) +tar_test("junction_get_splits()", { + x <- junction_init("x", letters, list(a = LETTERS, b = rev(letters))) + expect_equal(junction_get_splits(x), letters) +}) + +tar_test("junction_invalidate()", { + x <- junction_init("x", letters, list(a = LETTERS, b = rev(letters))) + junction_invalidate(x) + expect_equal(junction_get_splits(x), rep(NA_character_, length(x$splits))) +}) + tar_test("junction_upstream_edges()", { names <- paste0("child_", seq_len(3)) x <- paste0("x_", seq_len(3))