diff --git a/R/file_and_path_utils.R b/R/file_and_path_utils.R index ccbb221..9bd4953 100644 --- a/R/file_and_path_utils.R +++ b/R/file_and_path_utils.R @@ -53,14 +53,14 @@ vt_path <- function(...){ } -#' @importFrom rprojroot find_root has_file is_r_package is_rstudio_project is_vcs_root +#' @importFrom rprojroot find_root has_file is_r_package is_rstudio_project #' @rdname validation_paths #' #' @export vt_find_config <- function(){ tryCatch({ - root <- find_root(has_file(".here") | is_rstudio_project | is_r_package | is_vcs_root) + root <- find_root(has_file(".here") | is_rstudio_project | is_r_package ) }, error = function(e){ abort( paste0( @@ -70,7 +70,8 @@ vt_find_config <- function(){ class = "vt.validation_root_missing" ) }) - + + tryCatch({ config <- find_file("validation.yml", root, full_names = TRUE) @@ -88,7 +89,9 @@ vt_find_config <- function(){ abort(e) } }) - + + check_for_child_projects_with_configs(root, config) + if(length(config) > 1){ config <- config_selector(config) } @@ -113,13 +116,21 @@ vt_find_config <- function(){ #' @importFrom withr with_dir #' @noRd #' -find_file <- function(filename, ref = ".", full_names = FALSE){ +find_file <- function(filename, ref = ".", full_names = FALSE, regex = FALSE, include_hidden_files = FALSE){ with_dir(new = normalizePath(ref,winslash = "/"), { - file_list <- list.files(path = ".", recursive = TRUE, full.names = TRUE) + file_list <- list.files(path = ".", recursive = TRUE, full.names = TRUE, all.files = include_hidden_files) }) - - file_path <- file_list[basename(file_list) %in% filename] + + if(!regex){ + file_path <- file_list[basename(file_list) %in% filename] + }else{ + if(length(filename)>1){ + abort("If `regex` is set to `TRUE`, filename is used as a pattern", + class = "vt.file_multiple_regex") + } + file_path <- file_list[grepl(pattern = filename,x = basename(file_list))] + } if(length(file_path) == 0){ abort(paste0("File `",filename,"` not found."), @@ -169,7 +180,62 @@ config_selector <- function(files, is_live = interactive()){ } +check_for_child_projects_with_configs <- function(root, configs){ + + if(length(configs) > 1){ + + root_files <- c( + tryCatch(find_file("[.]Rproj$", root, regex = TRUE, full_names = TRUE, include_hidden_files = TRUE),error = function(e){c()}), + tryCatch(find_file("[.]here$", root, regex = TRUE, full_names = TRUE, include_hidden_files = TRUE),error = function(e){c()}), + find_r_pkg_desc(root) + ) + + root_dirs <- unique(dirname(root_files)) + root_child_dirs<- setdiff(root_dirs, root) + + if(length(root_child_dirs) > 0){ + + roots_child_with_validation <- c() + for(root_path in root_child_dirs){ + if(any(grepl(paste0(root_path,"/"),configs,fixed=TRUE))){ + roots_child_with_validation <- c( + roots_child_with_validation, + root_path + ) + } + } + + roots_child_with_validation <- unique(roots_child_with_validation) + + if(length(roots_child_with_validation) > 1){ + + ref_dirs <- gsub(paste0(normalizePath(getwd(),winslash = "/"),"/"),"",roots_child_with_validation,fixed = TRUE) + + abort( + paste0("Nested projects with validation infrastructures exist. Set the working directory to one of:\n", + paste0("\t- `setwd(\"",ref_dirs,"\")`\n", collapse = "")), + class = "vt.multiple_validation_roots_found") + } + } + } +} - +find_r_pkg_desc <- function(root){ + + desc_files <- tryCatch(find_file("DESCRIPTION", root, regex = TRUE, full_names = TRUE, include_hidden_files = TRUE),error = function(e){c()}) + + if(is.null(desc_files)){ + return(c()) + }else{ + desc_file_out <- c() + for(desc_file in desc_files){ + contents <- readLines(con = desc_file) + if(any(grepl("^Package:", contents))){ + desc_file_out <- c(desc_file_out, desc_file) + } + } + return(desc_file_out) + } +} diff --git a/R/validate.R b/R/validate.R index abe934f..eb9acd3 100644 --- a/R/validate.R +++ b/R/validate.R @@ -335,6 +335,7 @@ copy_validation_content <- function(pkg = ".", src = pkg){ validation_directory <- file.path(get_config_working_dir(), "validation") validation_output_directory <- file.path(get_config_output_dir(),"validation") + if(validation_directory != validation_output_directory){ tryCatch({ @@ -343,20 +344,22 @@ copy_validation_content <- function(pkg = ".", src = pkg){ dir.create(file.path(pkg, validation_output_directory),recursive = TRUE) } + ## copy validation contents to validation output dir directory_copy( from = file.path(pkg, validation_directory), to = file.path(pkg, validation_output_directory), recursive = TRUE, overwrite = TRUE) - + ## copy validation Rmd file.copy( from = file.path(pkg, "vignettes", get_config_report_rmd_name()), to = file.path(pkg, validation_output_directory), overwrite = TRUE ) - + + # copy and strip down code documentation to validation output dir roxygen_copy( from = file.path(pkg, "R"), diff --git a/tests/testthat/test-find_config.R b/tests/testthat/test-find_config.R index 782b1b6..a843597 100644 --- a/tests/testthat/test-find_config.R +++ b/tests/testthat/test-find_config.R @@ -1,13 +1,13 @@ test_that("Find config when within a package with validation", { - + withr::with_tempdir({ quiet <- capture.output({ vt_create_package( - "example.package", + "example.package", open = FALSE) }) - - + + withr::with_dir(new = "example.package", { expect_equal( vt_find_config(), @@ -18,16 +18,16 @@ test_that("Find config when within a package with validation", { }) test_that("Find config when within a package with validation when working dir is non-standard", { - + withr::with_tempdir({ quiet <- capture.output({ vt_create_package( - "example.package", + "example.package", working_dir = "inst", open = FALSE) }) - - + + withr::with_dir(new = "example.package", { expect_equal( vt_find_config(), @@ -40,15 +40,15 @@ test_that("Find config when within a package with validation when working dir is }) test_that("Find config when within a validation packet", { - + withr::with_tempdir({ quiet <- capture.output({ - vt_create_packet("example_packet", + vt_create_packet("example_packet", target = "example.package", open = FALSE) }) - - + + withr::with_dir(new = "example_packet", { expect_equal( vt_find_config(), @@ -59,14 +59,14 @@ test_that("Find config when within a validation packet", { }) }) - + }) test_that("Informative error when outside a packet or package", { - + withr::with_tempdir({ - + expect_error( vt_find_config(), paste0( @@ -75,6 +75,37 @@ test_that("Informative error when outside a packet or package", { ), fixed = TRUE) }) + +}) + +test_that("Informative error when inside an Rproj, but multiple packets or packages are nested in a subfolders", { + + withr::with_tempdir({ + + quiet <- capture.output({ + usethis::create_project("test_project",open = FALSE) + + vt_create_packet("test_project/example_packet", + target = "example.package", + open = FALSE) + vt_create_packet("test_project/example_packet2", + target = "example.package2", + open = FALSE) + }) + + + withr::with_dir(new = "test_project", { + + expect_error( + vt_find_config(), + "Nested projects with validation infrastructures exist. Set the working directory to one of:", + fixed = TRUE + ) + + }) + + }) }) + diff --git a/tests/testthat/test-validate_sequence.R b/tests/testthat/test-validate_sequence.R index def5bd5..035d864 100644 --- a/tests/testthat/test-validate_sequence.R +++ b/tests/testthat/test-validate_sequence.R @@ -254,7 +254,8 @@ test_that("test building a validated bundle from source", { "") ) - })}) + }) +}) test_that("test installing a validated bundle from source and rerunning report", { skip_if(!"valtools" %in% rownames(installed.packages()))