diff --git a/R/class_builder.R b/R/class_builder.R index 56fd2061..1ab28196 100644 --- a/R/class_builder.R +++ b/R/class_builder.R @@ -397,10 +397,10 @@ builder_ensure_workspace <- function(target, pipeline, scheduler, meta) { builder_should_save_workspace <- function(target) { names <- c(target_get_name(target), target_get_parent(target)) - because_named <- any(names %in% tar_options$get_workspaces()) - has_error <- metrics_has_error(target$metrics) - if_error <- tar_options$get_workspace_on_error() || - identical(target$settings$error, "workspace") + because_named <- any(names %in% .subset2(tar_options, "workspaces")) + has_error <- metrics_has_error(.subset2(target, "metrics")) + if_error <- .subset2(tar_options, "get_workspace_on_error")() || + identical(.subset2(.subset2(target, "settings"), "error"), "workspace") because_error <- if_error && has_error because_named || because_error } diff --git a/R/class_counter.R b/R/class_counter.R index 26405755..04457972 100644 --- a/R/class_counter.R +++ b/R/class_counter.R @@ -80,9 +80,10 @@ counter_set_names <- function(counter, names) { } counter_del_name <- function(counter, name) { - if (counter_exists_name(counter, name)) { - remove(list = name, envir = counter$envir) - counter$count <- counter$count - 1L + envir <- .subset2(counter, "envir") + if (!is.null(.subset2(envir, name))) { + remove(list = name, envir = envir) + counter$count <- .subset2(counter, "count") - 1L } } diff --git a/R/class_database.R b/R/class_database.R index 27cf6f3b..d24d6958 100644 --- a/R/class_database.R +++ b/R/class_database.R @@ -183,13 +183,15 @@ database_class <- R6::R6Class( if (fill_missing) { row <- select_cols(row) } - line <- produce_line(row) - buffer[[.subset2(row, "name")]] <- line + sublines <- produce_sublines(row) + buffer[[.subset2(row, "name")]] <- sublines self$buffer_length <- buffer_length + 1L }, flush_rows = function() { - if (buffer_length) { - append_lines(as.character(as.list(buffer))) + if (buffer_length > 0L) { + lines_list <- eapply(buffer, paste, collapse = database_sep_outer) + lines <- as.character(lines_list) + append_lines(lines) self$buffer <- new.env(parent = emptyenv(), hash = FALSE) self$buffer_length <- 0L self$staged <- TRUE @@ -255,7 +257,7 @@ database_class <- R6::R6Class( ) file_move(from = tmp, to = self$path) }, - produce_line = function(row) { + produce_sublines = function(row) { old <- options(OutDec = ".") on.exit(options(old)) index <- 1L @@ -265,6 +267,10 @@ database_class <- R6::R6Class( sublines[index] <- produce_subline(.subset2(row, index)) index <- index + 1L } + sublines + }, + produce_line = function(row) { + sublines <- produce_sublines(row) paste(sublines, collapse = database_sep_outer) }, produce_subline = function(element) { diff --git a/R/class_file.R b/R/class_file.R index 8dc5f22d..241fa3a5 100644 --- a/R/class_file.R +++ b/R/class_file.R @@ -79,11 +79,22 @@ file_update_hash <- function(file) { } file_should_rehash <- function(file, time, size, trust_timestamps) { - if_any( - .subset2(tar_options, "trust_timestamps") %|||% trust_timestamps, - !identical(time, file$time) || !identical(size, file$size), - TRUE - ) + trust <- .subset2(tar_options, "trust_timestamps") + if (is.null(trust)) { + trust <- trust_timestamps + } + if (trust) { + file_time <- .subset2(file, "time") + file_size <- .subset2(file, "size") + if (anyNA(file_time) || anyNA(file_size)) { + out <- TRUE + } else { + out <- (time != file_time) || (size != file_size) + } + } else { + out <- TRUE + } + out } file_repopulate <- function(file, path, data) { @@ -111,7 +122,7 @@ file_ensure_hash <- function(file) { } file_has_correct_hash <- function(file) { - files <- file_list_files(file$path) + files <- file_list_files(.subset2(file, "path")) info <- file_info_runtime(files) time <- file_time(info) bytes <- file_bytes(info) @@ -120,9 +131,19 @@ file_has_correct_hash <- function(file) { file = file, time = time, size = size, - trust_timestamps = all(info$trust_timestamps) + trust_timestamps = all(.subset2(info, "trust_timestamps")) ) - if_any(do, identical(file$hash, file_hash(files)), TRUE) + if (do) { + file_hash <- .subset2(file, "hash") + if (anyNA(file_hash)) { + out <- FALSE + } else { + out <- file_hash == file_hash(files) + } + } else { + out <- TRUE + } + out } file_validate_path <- function(path) { diff --git a/R/class_metrics.R b/R/class_metrics.R index 03d166a1..b5ae7bf5 100644 --- a/R/class_metrics.R +++ b/R/class_metrics.R @@ -21,7 +21,7 @@ metrics_has_warnings <- function(metrics) { } metrics_has_error <- function(metrics) { - !is.null(metrics$error) + !is.null(.subset2(metrics, "error")) } metrics_has_cancel <- function(metrics) { diff --git a/tests/testthat/test-class_database.R b/tests/testthat/test-class_database.R index 35e3fe34..9f50a91b 100644 --- a/tests/testthat/test-class_database.R +++ b/tests/testthat/test-class_database.R @@ -398,10 +398,10 @@ tar_test("database buffer", { expect_false(file.exists(db$path)) db$flush_rows() lines <- readLines(db$path) - expect_equal(lines, c("x", "y")) + expect_equal(sort(lines), sort(c("x", "y"))) db$flush_rows() lines <- readLines(db$path) - expect_equal(lines, c("x", "y")) + expect_equal(sort(lines), sort(c("x", "y"))) }) tar_test("compare_working_directories()", {