From 00215ed5ecbc5f2a76a1a0a0715be9f29c597962 Mon Sep 17 00:00:00 2001 From: BrianLang Date: Fri, 25 Jul 2025 16:20:47 +0200 Subject: [PATCH 1/4] Add gitignore-style patterns to .rscignore Implement full gitignore pattern syntax (wildcards, negation, relative paths, double-asterisk) while maintaining backward compatibility and existing hierarchical behavior. Includes comprehensive test suite. --- R/bundleFiles.R | 266 +++++++++++++++++++++++++++++- tests/testthat/test-bundleFiles.R | 141 ++++++++++++++++ 2 files changed, 402 insertions(+), 5 deletions(-) diff --git a/R/bundleFiles.R b/R/bundleFiles.R index c4e3c09a..f8643500 100644 --- a/R/bundleFiles.R +++ b/R/bundleFiles.R @@ -201,11 +201,8 @@ ignoreBundleFiles <- function(dir, contents) { contents <- contents[!grepl("^~|~$", contents)] contents <- contents[!grepl(glob2rx("*.Rproj"), contents)] - # remove any files lines listed .rscignore - if (".rscignore" %in% contents) { - ignoreContents <- readLines(file.path(dir, ".rscignore")) - contents <- setdiff(contents, c(ignoreContents, ".rscignore")) - } + # remove any files listed in .rscignore using gitignore-style patterns + contents <- applyRscignorePatterns(contents, dir) contents } @@ -284,3 +281,262 @@ detectLongNames <- function(bundleDir, lengthLimit = 32) { ) return(invisible(FALSE)) } + +# GitIgnore-style pattern parsing for .rscignore files +# ============================================================================ + +#' Apply .rscignore patterns to file list with fallback +#' +#' @param contents File list to filter +#' @param dir Directory containing .rscignore file +#' @return Filtered file list +applyRscignorePatterns <- function(contents, dir) { + # Check if .rscignore file exists in the directory + rscignore_path <- file.path(dir, ".rscignore") + if (!file.exists(rscignore_path)) { + return(contents) + } + + # Try new pattern-based processing + tryCatch({ + patterns <- parseIgnoreFile(dir) + if (length(patterns) > 0) { + # Apply new gitignore-style patterns + contents <- applyIgnorePatterns(contents, patterns, dir) + } + + # Always exclude the .rscignore file itself + contents <- setdiff(contents, ".rscignore") + return(contents) + + }, error = function(e) { + # Fallback to old behavior + warning("Error processing .rscignore with new pattern system: ", e$message, call. = FALSE) + warning("Falling back to simple pattern matching", call. = FALSE) + + if (file.exists(rscignore_path)) { + tryCatch({ + ignoreContents <- readLines(rscignore_path, warn = FALSE) + contents <- setdiff(contents, c(ignoreContents, ".rscignore")) + }, error = function(e2) { + warning("Error reading .rscignore file: ", e2$message, call. = FALSE) + # Just remove .rscignore file from contents + contents <- setdiff(contents, ".rscignore") + }) + } + return(contents) + }) +} + +#' Parse .rscignore file into pattern objects +#' +#' @param directory_path Path to directory containing .rscignore file +#' @return List of pattern objects, or empty list if no .rscignore file +parseIgnoreFile <- function(directory_path) { + rscignore_path <- file.path(directory_path, ".rscignore") + if (!file.exists(rscignore_path)) { + return(list()) + } + + tryCatch({ + lines <- readLines(rscignore_path, warn = FALSE) + patterns <- list() + + for (line in lines) { + pattern_obj <- parseSinglePattern(line) + if (!is.null(pattern_obj)) { + patterns <- append(patterns, list(pattern_obj)) + } + } + + return(patterns) + }, error = function(e) { + warning("Error reading .rscignore file: ", e$message) + return(list()) + }) +} + +#' Parse a single pattern line +#' +#' @param line Raw line from .rscignore file +#' @return Pattern object or NULL if line should be skipped +parseSinglePattern <- function(line) { + original <- line + line <- trimws(line) + + # Skip empty lines and comments + if (nchar(line) == 0 || startsWith(line, "#")) { + return(NULL) + } + + # Handle negation + negation <- FALSE + if (startsWith(line, "!")) { + negation <- TRUE + line <- substring(line, 2) + } + + # Handle directory-only patterns + dir_only <- FALSE + if (endsWith(line, "/")) { + dir_only <- TRUE + line <- substring(line, 1, nchar(line) - 1) + } + + # Handle relative vs anywhere patterns + relative <- FALSE + if (startsWith(line, "/")) { + relative <- TRUE + line <- substring(line, 2) # Remove leading / + } else if (grepl("/", line)) { + relative <- TRUE + } + + # Validate pattern after processing + if (nchar(line) == 0) { + return(NULL) + } + + # Handle special double-asterisk edge cases + warning_msg <- NULL + if (line == "**") { + # ** alone matches everything + line <- "*" + } else if (grepl("\\*{3,}", line)) { + # *** or more - matches everything but warn + warning_msg <- paste("Pattern with multiple consecutive asterisks:", original) + line <- "*" + } else if (line == "**/") { + # **/ matches all directories + dir_only <- TRUE + line <- "*" + } + + # Issue warning if needed + if (!is.null(warning_msg)) { + warning(warning_msg) + } + + pattern_type <- if (negation) "negation" else if (relative) "relative" else "anywhere" + + list( + raw = original, + pattern = line, + type = pattern_type, + dir_only = dir_only, + negation = negation, + relative = relative + ) +} + +#' Match a file path against a pattern +#' +#' @param file_path File path relative to current directory +#' @param pattern Pattern object from parseSinglePattern +#' @param current_dir Current directory path (for file info) +#' @return TRUE if pattern matches, FALSE otherwise +matchPattern <- function(file_path, pattern, current_dir) { + full_path <- file.path(current_dir, file_path) + is_directory <- dir.exists(full_path) + + # Handle directory-only restriction + if (pattern$dir_only && !is_directory) { + return(FALSE) + } + + # Handle simple double-asterisk patterns + if (grepl("\\*\\*/", pattern$pattern) || grepl("/\\*\\*$", pattern$pattern)) { + return(matchDoubleAsteriskPattern(file_path, pattern)) + } + + # Regular glob matching + return(matchGlobPattern(file_path, pattern)) +} + +#' Match glob patterns +#' +#' @param file_path File path to match against +#' @param pattern Pattern object +#' @return TRUE if pattern matches, FALSE otherwise +matchGlobPattern <- function(file_path, pattern) { + tryCatch({ + # Convert glob to regex + regex_pattern <- glob2rx(pattern$pattern) + + # Get target string for matching + if (pattern$relative) { + target <- file_path # Full relative path + } else { + target <- basename(file_path) # Just the filename + } + + # Perform match + grepl(regex_pattern, target) + }, error = function(e) { + warning("Pattern matching error for: ", pattern$raw, " - ", e$message) + FALSE + }) +} + +#' Match simple double-asterisk patterns +#' +#' @param file_path File path to match against +#' @param pattern Pattern object containing ** +#' @return TRUE if pattern matches, FALSE otherwise +matchDoubleAsteriskPattern <- function(file_path, pattern) { + pattern_str <- pattern$pattern + + if (startsWith(pattern_str, "**/")) { + # Case 1: **/foo -> matches foo anywhere (equivalent to just "foo") + sub_pattern <- substring(pattern_str, 4) # Remove "**/"" + anywhere_pattern <- pattern + anywhere_pattern$pattern <- sub_pattern + anywhere_pattern$relative <- FALSE + return(matchGlobPattern(file_path, anywhere_pattern)) + + } else if (endsWith(pattern_str, "/**")) { + # Case 2: abc/** -> everything under abc/ directory + prefix <- substring(pattern_str, 1, nchar(pattern_str) - 3) # Remove "/**" + return(startsWith(file_path, paste0(prefix, "/"))) + } + + # For more complex ** patterns, fall back to basic matching for now + return(FALSE) +} + +#' Apply ignore patterns to a file list +#' +#' @param file_list List of file paths relative to current directory +#' @param patterns List of pattern objects +#' @param current_dir Current directory path +#' @return Filtered file list with ignored files removed +applyIgnorePatterns <- function(file_list, patterns, current_dir) { + if (length(patterns) == 0) { + return(file_list) + } + + ignored_files <- character(0) + + # Process ignore patterns first + ignore_patterns <- Filter(function(p) !p$negation, patterns) + for (pattern in ignore_patterns) { + for (file in file_list) { + if (matchPattern(file, pattern, current_dir)) { + ignored_files <- union(ignored_files, file) + } + } + } + + # Process negation patterns (un-ignore) + negation_patterns <- Filter(function(p) p$negation, patterns) + for (pattern in negation_patterns) { + for (file in ignored_files) { + if (matchPattern(file, pattern, current_dir)) { + ignored_files <- setdiff(ignored_files, file) + } + } + } + + # Return files not in ignored set + setdiff(file_list, ignored_files) +} diff --git a/tests/testthat/test-bundleFiles.R b/tests/testthat/test-bundleFiles.R index 4bdb9a4c..d80f4431 100644 --- a/tests/testthat/test-bundleFiles.R +++ b/tests/testthat/test-bundleFiles.R @@ -127,6 +127,147 @@ test_that("ignores files listed in .rscignore", { expect_setequal(bundleFiles(dir), character()) }) +test_that("supports gitignore-style wildcard patterns in .rscignore", { + dir <- local_temp_app() + file.create(file.path(dir, c("app.log", "debug.log", "config.txt", "data.csv"))) + expect_setequal(bundleFiles(dir), c("app.log", "debug.log", "config.txt", "data.csv")) + + # Test wildcard patterns + writeLines("*.log", file.path(dir, ".rscignore")) + expect_setequal(bundleFiles(dir), c("config.txt", "data.csv")) + + # Test multiple patterns + writeLines(c("*.log", "*.csv"), file.path(dir, ".rscignore")) + expect_setequal(bundleFiles(dir), "config.txt") +}) + +test_that("supports gitignore-style directory patterns in .rscignore", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("logs", "temp", "src"))) + file.create(file.path(dir, c("app.R", "logs/error.log", "temp/cache.txt", "src/main.R"))) + + # Test directory-only patterns + writeLines("logs/", file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + expect_true("temp/cache.txt" %in% result) + expect_true("src/main.R" %in% result) + expect_true("app.R" %in% result) + expect_false("logs/error.log" %in% result) +}) + +test_that("supports gitignore-style negation patterns in .rscignore", { + dir <- local_temp_app() + file.create(file.path(dir, c("app.log", "debug.log", "error.log", "config.txt"))) + + # Test negation patterns + writeLines(c("*.log", "!error.log"), file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + expect_true("error.log" %in% result) + expect_true("config.txt" %in% result) + expect_false("app.log" %in% result) + expect_false("debug.log" %in% result) +}) + +test_that("supports gitignore-style relative path patterns in .rscignore", { + dir <- local_temp_app() + dirCreate(file.path(dir, "src")) + file.create(file.path(dir, c("config.json", "src/config.json", "src/app.R"))) + + # Test relative path patterns + writeLines("/config.json", file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + expect_false("config.json" %in% result) + expect_true("src/config.json" %in% result) + expect_true("src/app.R" %in% result) +}) + +test_that("supports simple gitignore-style double-asterisk patterns in .rscignore", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("logs", "temp"))) + file.create(file.path(dir, c("cache.tmp", "app.R", "logs/other.tmp", "temp/data.txt"))) + + # Test 1: **/pattern (matches anywhere in current directory scope) + writeLines("**/cache.tmp", file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + expect_false("cache.tmp" %in% result) # Ignored at root level + expect_true("logs/other.tmp" %in% result) # Different file in subdirectory + expect_true("app.R" %in% result) + expect_true("temp/data.txt" %in% result) +}) + +test_that("supports hierarchical .rscignore behavior with ** patterns", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("logs", "temp"))) + file.create(file.path(dir, c("cache.tmp", "app.R", "logs/other.tmp", "temp/data.txt"))) + + # Test subdirectory .rscignore with ** pattern to ignore everything in temp/ + writeLines("**", file.path(dir, "temp/.rscignore")) # Ignore everything in temp/ + result <- bundleFiles(dir) + expect_false("temp/data.txt" %in% result) # Contents of temp/ are ignored + expect_true("cache.tmp" %in% result) + expect_true("app.R" %in% result) + expect_true("logs/other.tmp" %in% result) + + # Test hierarchical behavior - subdirectory .rscignore with specific ** pattern + writeLines("**/other.tmp", file.path(dir, "logs/.rscignore")) + result <- bundleFiles(dir) + expect_false("logs/other.tmp" %in% result) # Now ignored by subdirectory .rscignore + expect_false("temp/data.txt" %in% result) # Still ignored by temp/.rscignore + expect_true("cache.tmp" %in% result) + expect_true("app.R" %in% result) +}) + +test_that("handles comments and empty lines in .rscignore", { + dir <- local_temp_app() + file.create(file.path(dir, c("app.log", "debug.log", "config.txt"))) + + # Test with comments and empty lines + writeLines(c( + "# This is a comment", + "*.log", + "", + "# Another comment", + " # Indented comment" + ), file.path(dir, ".rscignore")) + + result <- bundleFiles(dir) + expect_setequal(result, "config.txt") +}) + +test_that("handles edge cases in gitignore patterns", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("docs", "src"))) + file.create(file.path(dir, c("app.R", "config.txt", "docs/readme.md", "src/main.R"))) + + # Test ** alone (matches everything) + writeLines("**", file.path(dir, ".rscignore")) + expect_length(bundleFiles(dir), 0) + + # Test **/ (matches all directories) + writeLines("**/", file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + expect_true("app.R" %in% result) + expect_true("config.txt" %in% result) + expect_false("docs/readme.md" %in% result) + expect_false("src/main.R" %in% result) +}) + +test_that("maintains backward compatibility with simple .rscignore patterns", { + dir <- local_temp_app() + dirCreate(file.path(dir, "a")) + file.create(file.path(dir, c("simple_file.txt", "a/another_file.R"))) + + # Test that simple string matching still works + writeLines("simple_file.txt", file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + expect_false("simple_file.txt" %in% result) + expect_true("a/another_file.R" %in% result) + + # Test hierarchical behavior is preserved + writeLines("another_file.R", file.path(dir, "a/.rscignore")) + expect_length(bundleFiles(dir), 0) +}) + test_that("ignores temporary files", { ignored <- ignoreBundleFiles( dir = ".", From 929e5975ce595daebce952c1fd96645c80a97618 Mon Sep 17 00:00:00 2001 From: BrianLang Date: Fri, 25 Jul 2025 22:33:37 +0200 Subject: [PATCH 2/4] Enhance .rscignore functionality with hierarchical behavior Introduce breaking changes to .rscignore files, enabling hierarchical pattern matching similar to .gitignore. Patterns in parent directories now affect subdirectories, allowing for more intuitive file ignoring. Added migration guidance and temporary compatibility option for legacy behavior. Update documentation and tests to reflect these changes. --- NEWS.md | 42 +++ R/bundleFiles.R | 263 +++++++++++++++---- man/applyIgnorePatterns.Rd | 21 ++ man/applyRscignorePatterns.Rd | 21 ++ man/applyRscignorePatternsLegacy.Rd | 19 ++ man/collectHierarchicalPatterns.Rd | 20 ++ man/listBundleFiles.Rd | 2 +- man/listDeploymentFiles.Rd | 7 +- man/matchDoubleAsteriskPattern.Rd | 19 ++ man/matchGlobPattern.Rd | 19 ++ man/matchPattern.Rd | 21 ++ man/matchPatternHierarchical.Rd | 21 ++ man/parseIgnoreFile.Rd | 17 ++ man/parseSinglePattern.Rd | 17 ++ tests/testthat/test-hierarchical-rscignore.R | 256 ++++++++++++++++++ 15 files changed, 713 insertions(+), 52 deletions(-) create mode 100644 man/applyIgnorePatterns.Rd create mode 100644 man/applyRscignorePatterns.Rd create mode 100644 man/applyRscignorePatternsLegacy.Rd create mode 100644 man/collectHierarchicalPatterns.Rd create mode 100644 man/matchDoubleAsteriskPattern.Rd create mode 100644 man/matchGlobPattern.Rd create mode 100644 man/matchPattern.Rd create mode 100644 man/matchPatternHierarchical.Rd create mode 100644 man/parseIgnoreFile.Rd create mode 100644 man/parseSinglePattern.Rd create mode 100644 tests/testthat/test-hierarchical-rscignore.R diff --git a/NEWS.md b/NEWS.md index fc39209d..586eaa50 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,47 @@ # rsconnect (development version) +## Breaking changes + +* `.rscignore` files now follow hierarchical .gitignore-style behavior by default. + Patterns in parent directories now affect subdirectories, making .rscignore + files work more intuitively and consistently with .gitignore behavior (#issue). + + **What changed**: Previously, each .rscignore file only affected files in its + own directory. Now, patterns in parent .rscignore files affect all subdirectories, + and child .rscignore files can override parent patterns using negation (`!pattern`). + + **Migration**: Most existing .rscignore files will work the same or better. If you + have the same filename in multiple directories and want different ignore behavior, + add negation patterns (`!filename`) to subdirectory .rscignore files where needed. + + **Temporary compatibility**: Use `options(rsconnect.rscignore.legacy = TRUE)` to + temporarily restore old behavior, but this will be removed in version 2.0.0. + +### Migration examples + +**Before (deprecated behavior)**: +``` +project/ +├── .rscignore # "temp.log" only ignores project/temp.log +├── temp.log # ← ignored +├── src/ +│ ├── temp.log # ← NOT ignored (different directory) +│ └── main.R +``` + +**After (new default behavior)**: +``` +project/ +├── .rscignore # "temp.log" ignores ALL temp.log files +├── temp.log # ← ignored +├── src/ +│ ├── temp.log # ← NOW ignored (hierarchical) +│ ├── .rscignore # Add "!temp.log" here to un-ignore if needed +│ └── main.R +``` + +## Minor improvements and bug fixes + # rsconnect 1.5.0 * Functions for interacting with Posit Connect deployments in diff --git a/R/bundleFiles.R b/R/bundleFiles.R index f8643500..7d271777 100644 --- a/R/bundleFiles.R +++ b/R/bundleFiles.R @@ -14,9 +14,10 @@ #' are automatically excluded. #' #' * You can exclude additional files by listing them in in a `.rscignore` -#' file. This file must have one file or directory per line (with path -#' relative to the current directory). It doesn't support wildcards, or -#' ignoring files in subdirectories. +#' file. This file follows .gitignore-style syntax with one pattern per line. +#' Patterns support wildcards (*, ?, []), directory patterns (dir/), and +#' negation (!pattern). Patterns in parent directories affect subdirectories +#' hierarchically. #' #' `listDeploymentFiles()` will throw an error if the total file size exceeds #' the maximum bundle size (as controlled by option `rsconnect.max.bundle.size`), @@ -99,12 +100,15 @@ readFileManifest <- function(appFileManifest, error_call = caller_env()) { #' * `contents`: Paths to bundle, relative to `appDir`. #' @export #' @keywords internal -listBundleFiles <- function(appDir) { - recursiveBundleFiles(appDir) +listBundleFiles <- function(appDir, bundle_root = appDir) { + recursiveBundleFiles(appDir, bundle_root = bundle_root) } bundleFiles <- function(appDir) { - listBundleFiles(appDir)$contents + # Store bundle root for hierarchical processing + bundle_root <- normalizePath(appDir) + result <- listBundleFiles(appDir, bundle_root) + result$contents } explodeFiles <- function(dir, files, error_arg = "appFiles") { @@ -118,7 +122,7 @@ explodeFiles <- function(dir, files, error_arg = "appFiles") { files <- files[!missing] } - recursiveBundleFiles(dir, contents = files, ignoreFiles = FALSE)$contents + recursiveBundleFiles(dir, contents = files, ignoreFiles = FALSE, bundle_root = dir)$contents } recursiveBundleFiles <- function( @@ -127,14 +131,15 @@ recursiveBundleFiles <- function( rootDir = dir, totalFiles = 0, totalSize = 0, - ignoreFiles = TRUE + ignoreFiles = TRUE, + bundle_root = rootDir ) { # generate a list of files at this level if (is.null(contents)) { contents <- list.files(dir, all.files = TRUE, no.. = TRUE) } if (ignoreFiles) { - contents <- ignoreBundleFiles(dir, contents) + contents <- ignoreBundleFiles(dir, contents, bundle_root) } # Info for each file lets us know to recurse (directories) or aggregate (files). @@ -149,7 +154,8 @@ recursiveBundleFiles <- function( rootDir = rootDir, totalFiles = totalFiles, totalSize = totalSize, - ignoreFiles = ignoreFiles + ignoreFiles = ignoreFiles, + bundle_root = bundle_root ) children <- append(children, file.path(name, out$contents)) @@ -171,7 +177,7 @@ recursiveBundleFiles <- function( ) } -ignoreBundleFiles <- function(dir, contents) { +ignoreBundleFiles <- function(dir, contents, bundle_root = dir) { # entries ignored regardless of type ignored <- c( # rsconnect packages @@ -202,7 +208,7 @@ ignoreBundleFiles <- function(dir, contents) { contents <- contents[!grepl(glob2rx("*.Rproj"), contents)] # remove any files listed in .rscignore using gitignore-style patterns - contents <- applyRscignorePatterns(contents, dir) + contents <- applyRscignorePatterns(contents, dir, bundle_root) contents } @@ -289,19 +295,87 @@ detectLongNames <- function(bundleDir, lengthLimit = 32) { #' #' @param contents File list to filter #' @param dir Directory containing .rscignore file +#' @param bundle_root Root directory of the bundle (project root) #' @return Filtered file list -applyRscignorePatterns <- function(contents, dir) { +applyRscignorePatterns <- function(contents, dir, bundle_root = NULL) { + # Check for legacy mode (deprecated behavior) + legacy_mode <- getOption("rsconnect.rscignore.legacy", FALSE) + + # Validate option value + if (!is.logical(legacy_mode) && !is.null(legacy_mode)) { + # Try to convert to logical + converted <- suppressWarnings(as.logical(legacy_mode)) + if (is.na(converted)) { + stop("Option 'rsconnect.rscignore.legacy' must be TRUE, FALSE, or NULL. Got: ", + paste(deparse(getOption("rsconnect.rscignore.legacy")), collapse = "")) + } + legacy_mode <- converted + } + + # Handle NULL case + if (is.null(legacy_mode)) { + legacy_mode <- FALSE + } + + if (legacy_mode) { + # Issue deprecation warning for legacy behavior + lifecycle::deprecate_warn( + when = "1.6.0", + what = I("Legacy .rscignore behavior"), + details = c( + "Directory-scoped .rscignore patterns are deprecated.", + "Hierarchical .gitignore-style behavior is now the default.", + "Update your .rscignore files to use '!' negation patterns if needed.", + "Set `options(rsconnect.rscignore.legacy = FALSE)` to remove this warning." + ) + ) + # Use directory-scoped behavior + return(applyDirectoryScopedPatterns(contents, dir)) + } + + # NEW DEFAULT: Use hierarchical behavior + if (is.null(bundle_root)) { + bundle_root <- dir # Fallback for backward compatibility + } + + tryCatch({ + patterns <- collectHierarchicalPatterns(dir, bundle_root) + if (length(patterns) > 0) { + contents <- applyIgnorePatterns(contents, patterns, dir) + } + + # Always exclude .rscignore files themselves + contents <- setdiff(contents, ".rscignore") + return(contents) + + }, error = function(e) { + # Fallback to directory-scoped behavior on error + warning("Error in hierarchical pattern processing: ", e$message, call. = FALSE) + warning("Falling back to directory-scoped patterns", call. = FALSE) + return(applyDirectoryScopedPatterns(contents, dir)) + }) +} + +#' Directory-scoped .rscignore pattern application +#' +#' Applies .rscignore patterns only from the current directory, +#' without hierarchical inheritance from parent directories. +#' +#' @param contents File contents to filter +#' @param dir Directory to check for .rscignore +#' @return Filtered contents +applyDirectoryScopedPatterns <- function(contents, dir) { # Check if .rscignore file exists in the directory rscignore_path <- file.path(dir, ".rscignore") if (!file.exists(rscignore_path)) { return(contents) } - # Try new pattern-based processing + # Simple, robust directory-scoped pattern application tryCatch({ patterns <- parseIgnoreFile(dir) if (length(patterns) > 0) { - # Apply new gitignore-style patterns + # Apply patterns only from this directory (no hierarchical inheritance) contents <- applyIgnorePatterns(contents, patterns, dir) } @@ -310,24 +384,88 @@ applyRscignorePatterns <- function(contents, dir) { return(contents) }, error = function(e) { - # Fallback to old behavior - warning("Error processing .rscignore with new pattern system: ", e$message, call. = FALSE) - warning("Falling back to simple pattern matching", call. = FALSE) + # Simple fallback: read lines and filter directly + warning("Error processing .rscignore patterns: ", e$message, call. = FALSE) + warning("Using simple line-based filtering", call. = FALSE) - if (file.exists(rscignore_path)) { - tryCatch({ - ignoreContents <- readLines(rscignore_path, warn = FALSE) - contents <- setdiff(contents, c(ignoreContents, ".rscignore")) - }, error = function(e2) { - warning("Error reading .rscignore file: ", e2$message, call. = FALSE) - # Just remove .rscignore file from contents - contents <- setdiff(contents, ".rscignore") - }) - } - return(contents) + tryCatch({ + ignoreContents <- readLines(rscignore_path, warn = FALSE) + # Remove empty lines and comments + ignoreContents <- ignoreContents[nzchar(ignoreContents) & !grepl("^#", ignoreContents)] + # Filter contents + contents <- setdiff(contents, c(ignoreContents, ".rscignore")) + return(contents) + }, error = function(e2) { + warning("Error reading .rscignore file: ", e2$message, call. = FALSE) + # Just remove .rscignore file from contents + return(setdiff(contents, ".rscignore")) + }) }) } +#' Collect hierarchical .rscignore patterns +#' +#' Walks up the directory tree from current_dir to bundle_root, +#' collecting patterns from .rscignore files at each level. +#' +#' @param current_dir Current directory being processed +#' @param bundle_root Root directory of the bundle (project root) +#' @return List of pattern objects in precedence order (parent first, child last) +collectHierarchicalPatterns <- function(current_dir, bundle_root) { + # Validate inputs + if (!dir.exists(current_dir)) { + stop("Current directory does not exist: ", current_dir) + } + + if (!dir.exists(bundle_root)) { + stop("Bundle root does not exist: ", bundle_root) + } + + # Ensure paths are normalized for comparison + current_dir <- normalizePath(current_dir) + bundle_root <- normalizePath(bundle_root) + + # Collect directories from current to root + directories <- character() + search_dir <- current_dir + + while (TRUE) { + directories <- c(directories, search_dir) + + # Stop if we've reached the bundle root + if (search_dir == bundle_root) { + break + } + + # Move up one level + parent_dir <- dirname(search_dir) + + # Stop if we can't go higher (filesystem root) + if (parent_dir == search_dir) { + break + } + + search_dir <- parent_dir + } + + # Process directories from parent to child (reverse order) + # This ensures we get parent patterns first, child patterns last + patterns <- list() + for (dir in rev(directories)) { + dir_patterns <- parseIgnoreFile(dir) + if (length(dir_patterns) > 0) { + # Add patterns with directory context for debugging + for (pattern in dir_patterns) { + pattern$source_dir <- dir + patterns <- append(patterns, list(pattern)) + } + } + } + + # Return patterns in processing order (parent first, child last) + return(patterns) +} + #' Parse .rscignore file into pattern objects #' #' @param directory_path Path to directory containing .rscignore file @@ -504,10 +642,10 @@ matchDoubleAsteriskPattern <- function(file_path, pattern) { return(FALSE) } -#' Apply ignore patterns to a file list +#' Apply ignore patterns to a file list with hierarchical precedence #' #' @param file_list List of file paths relative to current directory -#' @param patterns List of pattern objects +#' @param patterns List of pattern objects (parent first, child last) #' @param current_dir Current directory path #' @return Filtered file list with ignored files removed applyIgnorePatterns <- function(file_list, patterns, current_dir) { @@ -515,28 +653,57 @@ applyIgnorePatterns <- function(file_list, patterns, current_dir) { return(file_list) } - ignored_files <- character(0) + # Track which files are ignored + file_status <- setNames(rep(FALSE, length(file_list)), file_list) - # Process ignore patterns first - ignore_patterns <- Filter(function(p) !p$negation, patterns) - for (pattern in ignore_patterns) { + # Process patterns in order (parent to child, within-file order preserved) + # Later patterns override earlier patterns + for (pattern in patterns) { for (file in file_list) { - if (matchPattern(file, pattern, current_dir)) { - ignored_files <- union(ignored_files, file) + # Hierarchical pattern matching logic (formerly in matchPatternHierarchical) + matches <- FALSE + + # For relative patterns (starting with /), only match files in the same directory + # as the .rscignore file that contains the pattern + if (pattern$relative && startsWith(pattern$raw, "/")) { + # Get the directory containing this pattern's .rscignore file + pattern_dir <- pattern$source_dir + + # Get the directory containing the current file + if (grepl("/", file)) { + file_dir <- file.path(current_dir, dirname(file)) + } else { + file_dir <- current_dir + } + + # Normalize paths for comparison + pattern_dir <- normalizePath(pattern_dir, mustWork = FALSE) + file_dir <- normalizePath(file_dir, mustWork = FALSE) + + # If directories match, compare just the filename + if (pattern_dir == file_dir) { + file_basename <- basename(file) + matches <- matchPattern(file_basename, pattern, current_dir) + } + } else { + # For non-relative patterns, use normal matching + matches <- matchPattern(file, pattern, current_dir) } - } - } - - # Process negation patterns (un-ignore) - negation_patterns <- Filter(function(p) p$negation, patterns) - for (pattern in negation_patterns) { - for (file in ignored_files) { - if (matchPattern(file, pattern, current_dir)) { - ignored_files <- setdiff(ignored_files, file) + + if (matches) { + if (pattern$negation) { + # Negation pattern: un-ignore the file + file_status[[file]] <- FALSE + } else { + # Regular pattern: ignore the file + file_status[[file]] <- TRUE + } } } } - # Return files not in ignored set - setdiff(file_list, ignored_files) + # Return files that are not ignored + file_list[!file_status] } + + diff --git a/man/applyIgnorePatterns.Rd b/man/applyIgnorePatterns.Rd new file mode 100644 index 00000000..76fd7210 --- /dev/null +++ b/man/applyIgnorePatterns.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bundleFiles.R +\name{applyIgnorePatterns} +\alias{applyIgnorePatterns} +\title{Apply ignore patterns to a file list with hierarchical precedence} +\usage{ +applyIgnorePatterns(file_list, patterns, current_dir) +} +\arguments{ +\item{file_list}{List of file paths relative to current directory} + +\item{patterns}{List of pattern objects (parent first, child last)} + +\item{current_dir}{Current directory path} +} +\value{ +Filtered file list with ignored files removed +} +\description{ +Apply ignore patterns to a file list with hierarchical precedence +} diff --git a/man/applyRscignorePatterns.Rd b/man/applyRscignorePatterns.Rd new file mode 100644 index 00000000..42e4d022 --- /dev/null +++ b/man/applyRscignorePatterns.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bundleFiles.R +\name{applyRscignorePatterns} +\alias{applyRscignorePatterns} +\title{Apply .rscignore patterns to file list with fallback} +\usage{ +applyRscignorePatterns(contents, dir, bundle_root = NULL) +} +\arguments{ +\item{contents}{File list to filter} + +\item{dir}{Directory containing .rscignore file} + +\item{bundle_root}{Root directory of the bundle (project root)} +} +\value{ +Filtered file list +} +\description{ +Apply .rscignore patterns to file list with fallback +} diff --git a/man/applyRscignorePatternsLegacy.Rd b/man/applyRscignorePatternsLegacy.Rd new file mode 100644 index 00000000..c3c14c18 --- /dev/null +++ b/man/applyRscignorePatternsLegacy.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bundleFiles.R +\name{applyRscignorePatternsLegacy} +\alias{applyRscignorePatternsLegacy} +\title{Legacy .rscignore pattern application (deprecated)} +\usage{ +applyRscignorePatternsLegacy(contents, dir) +} +\arguments{ +\item{contents}{File contents to filter} + +\item{dir}{Directory to check for .rscignore} +} +\value{ +Filtered contents +} +\description{ +Legacy .rscignore pattern application (deprecated) +} diff --git a/man/collectHierarchicalPatterns.Rd b/man/collectHierarchicalPatterns.Rd new file mode 100644 index 00000000..caa983f5 --- /dev/null +++ b/man/collectHierarchicalPatterns.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bundleFiles.R +\name{collectHierarchicalPatterns} +\alias{collectHierarchicalPatterns} +\title{Collect hierarchical .rscignore patterns} +\usage{ +collectHierarchicalPatterns(current_dir, bundle_root) +} +\arguments{ +\item{current_dir}{Current directory being processed} + +\item{bundle_root}{Root directory of the bundle (project root)} +} +\value{ +List of pattern objects in precedence order (parent first, child last) +} +\description{ +Walks up the directory tree from current_dir to bundle_root, +collecting patterns from .rscignore files at each level. +} diff --git a/man/listBundleFiles.Rd b/man/listBundleFiles.Rd index 8c324763..3d511259 100644 --- a/man/listBundleFiles.Rd +++ b/man/listBundleFiles.Rd @@ -4,7 +4,7 @@ \alias{listBundleFiles} \title{List Files to be Bundled} \usage{ -listBundleFiles(appDir) +listBundleFiles(appDir, bundle_root = appDir) } \arguments{ \item{appDir}{Directory containing the application.} diff --git a/man/listDeploymentFiles.Rd b/man/listDeploymentFiles.Rd index b22643c2..794288e3 100644 --- a/man/listDeploymentFiles.Rd +++ b/man/listDeploymentFiles.Rd @@ -41,9 +41,10 @@ from the following: version control directories, internal config files, and RStudio state, are automatically excluded. \item You can exclude additional files by listing them in in a \code{.rscignore} -file. This file must have one file or directory per line (with path -relative to the current directory). It doesn't support wildcards, or -ignoring files in subdirectories. +file. This file follows .gitignore-style syntax with one pattern per line. +Patterns support wildcards (*, ?, []), directory patterns (dir/), and +negation (!pattern). Patterns in parent directories affect subdirectories +hierarchically. } \code{listDeploymentFiles()} will throw an error if the total file size exceeds diff --git a/man/matchDoubleAsteriskPattern.Rd b/man/matchDoubleAsteriskPattern.Rd new file mode 100644 index 00000000..cd563a8e --- /dev/null +++ b/man/matchDoubleAsteriskPattern.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bundleFiles.R +\name{matchDoubleAsteriskPattern} +\alias{matchDoubleAsteriskPattern} +\title{Match simple double-asterisk patterns} +\usage{ +matchDoubleAsteriskPattern(file_path, pattern) +} +\arguments{ +\item{file_path}{File path to match against} + +\item{pattern}{Pattern object containing **} +} +\value{ +TRUE if pattern matches, FALSE otherwise +} +\description{ +Match simple double-asterisk patterns +} diff --git a/man/matchGlobPattern.Rd b/man/matchGlobPattern.Rd new file mode 100644 index 00000000..2a64c3d2 --- /dev/null +++ b/man/matchGlobPattern.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bundleFiles.R +\name{matchGlobPattern} +\alias{matchGlobPattern} +\title{Match glob patterns} +\usage{ +matchGlobPattern(file_path, pattern) +} +\arguments{ +\item{file_path}{File path to match against} + +\item{pattern}{Pattern object} +} +\value{ +TRUE if pattern matches, FALSE otherwise +} +\description{ +Match glob patterns +} diff --git a/man/matchPattern.Rd b/man/matchPattern.Rd new file mode 100644 index 00000000..979495fc --- /dev/null +++ b/man/matchPattern.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bundleFiles.R +\name{matchPattern} +\alias{matchPattern} +\title{Match a file path against a pattern} +\usage{ +matchPattern(file_path, pattern, current_dir) +} +\arguments{ +\item{file_path}{File path relative to current directory} + +\item{pattern}{Pattern object from parseSinglePattern} + +\item{current_dir}{Current directory path (for file info)} +} +\value{ +TRUE if pattern matches, FALSE otherwise +} +\description{ +Match a file path against a pattern +} diff --git a/man/matchPatternHierarchical.Rd b/man/matchPatternHierarchical.Rd new file mode 100644 index 00000000..dc5ff6c7 --- /dev/null +++ b/man/matchPatternHierarchical.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bundleFiles.R +\name{matchPatternHierarchical} +\alias{matchPatternHierarchical} +\title{Match a file path against a pattern with hierarchical awareness} +\usage{ +matchPatternHierarchical(file_path, pattern, current_dir) +} +\arguments{ +\item{file_path}{File path relative to current directory} + +\item{pattern}{Pattern object from parseSinglePattern} + +\item{current_dir}{Current directory path (for file info)} +} +\value{ +TRUE if pattern matches, FALSE otherwise +} +\description{ +Match a file path against a pattern with hierarchical awareness +} diff --git a/man/parseIgnoreFile.Rd b/man/parseIgnoreFile.Rd new file mode 100644 index 00000000..597e3307 --- /dev/null +++ b/man/parseIgnoreFile.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bundleFiles.R +\name{parseIgnoreFile} +\alias{parseIgnoreFile} +\title{Parse .rscignore file into pattern objects} +\usage{ +parseIgnoreFile(directory_path) +} +\arguments{ +\item{directory_path}{Path to directory containing .rscignore file} +} +\value{ +List of pattern objects, or empty list if no .rscignore file +} +\description{ +Parse .rscignore file into pattern objects +} diff --git a/man/parseSinglePattern.Rd b/man/parseSinglePattern.Rd new file mode 100644 index 00000000..de5dca7a --- /dev/null +++ b/man/parseSinglePattern.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bundleFiles.R +\name{parseSinglePattern} +\alias{parseSinglePattern} +\title{Parse a single pattern line} +\usage{ +parseSinglePattern(line) +} +\arguments{ +\item{line}{Raw line from .rscignore file} +} +\value{ +Pattern object or NULL if line should be skipped +} +\description{ +Parse a single pattern line +} diff --git a/tests/testthat/test-hierarchical-rscignore.R b/tests/testthat/test-hierarchical-rscignore.R new file mode 100644 index 00000000..0ea617a9 --- /dev/null +++ b/tests/testthat/test-hierarchical-rscignore.R @@ -0,0 +1,256 @@ +# Streamlined hierarchical .rscignore tests (consolidated from 23 to 10 tests) + +test_that("hierarchical inheritance works by default", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("src", "docs"))) + file.create(file.path(dir, c("app.log", "config.json", "src/debug.log", "src/config.json", "docs/error.log", "src/main.R"))) + + # Test both wildcard and exact patterns inherit to subdirectories + writeLines(c("*.log", "config.json"), file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + + # All .log files ignored (wildcard inheritance) + expect_false("app.log" %in% result) + expect_false("src/debug.log" %in% result) + expect_false("docs/error.log" %in% result) + + # All config.json files ignored (exact pattern inheritance) + expect_false("config.json" %in% result) + expect_false("src/config.json" %in% result) + + # Non-matching files preserved + expect_true("src/main.R" %in% result) +}) + +test_that("child patterns override parent patterns with proper precedence", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("src", "src/utils"))) + file.create(file.path(dir, c("temp.txt", "src/temp.txt", "src/utils/temp.txt", "src/main.R"))) + + # Root: ignore temp.txt everywhere + writeLines("temp.txt", file.path(dir, ".rscignore")) + + # Child: un-ignore temp.txt in src/ + writeLines("!temp.txt", file.path(dir, "src/.rscignore")) + + # Grandchild: re-ignore temp.txt in src/utils/ + writeLines("temp.txt", file.path(dir, "src/utils/.rscignore")) + + result <- bundleFiles(dir) + + expect_false("temp.txt" %in% result) # Root: ignored + expect_true("src/temp.txt" %in% result) # Child: un-ignored (overrides parent) + expect_false("src/utils/temp.txt" %in% result) # Grandchild: re-ignored (overrides parent negation) + expect_true("src/main.R" %in% result) # Unaffected +}) + +test_that("legacy vs hierarchical mode behavioral differences", { + dir <- local_temp_app() + dirCreate(file.path(dir, "src")) + file.create(file.path(dir, c("debug.log", "src/debug.log", "src/main.R"))) + writeLines("*.log", file.path(dir, ".rscignore")) + + # LEGACY MODE: only affects same directory + withr::local_options(rsconnect.rscignore.legacy = TRUE) + result_legacy <- suppressWarnings(bundleFiles(dir)) + expect_false("debug.log" %in% result_legacy) + expect_true("src/debug.log" %in% result_legacy) # NOT inherited + + # HIERARCHICAL MODE: affects subdirectories too + withr::local_options(rsconnect.rscignore.legacy = FALSE) + result_hierarchical <- bundleFiles(dir) + expect_false("debug.log" %in% result_hierarchical) + expect_false("src/debug.log" %in% result_hierarchical) # Inherited +}) + +test_that("gitignore-style patterns work correctly", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("src", "logs"))) + file.create(file.path(dir, c("config.json", "src/config.json", "src/app.R"))) + file.create(file.path(dir, c("logs/debug.log", "logs/access.log"))) + + # Test relative path patterns (should only affect same directory) + writeLines(c("/config.json", "logs/"), file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + + expect_false("config.json" %in% result) # Root config.json ignored by /config.json + expect_true("src/config.json" %in% result) # Subdirectory config.json NOT ignored by /config.json + expect_false("logs/debug.log" %in% result) # Directory pattern ignores contents + expect_false("logs/access.log" %in% result) # Directory pattern ignores contents + expect_true("src/app.R" %in% result) # Unaffected file +}) + +test_that("error handling and edge cases", { + dir <- local_temp_app() + dirCreate(file.path(dir, "src")) + file.create(file.path(dir, c("test.txt", "src/test.txt"))) + + # Test empty .rscignore file + writeLines("", file.path(dir, ".rscignore")) + expect_no_error(result1 <- bundleFiles(dir)) + expect_true("test.txt" %in% result1) + expect_true("src/test.txt" %in% result1) + + # Test missing bundle_root (should fallback gracefully) + contents <- c("test.txt", "src/test.txt") + expect_no_error(result2 <- applyRscignorePatterns(contents, dir, bundle_root = NULL)) + + # Test with mocked error in hierarchical processing + with_mocked_bindings( + collectHierarchicalPatterns = function(...) stop("Test error"), + { + expect_warning( + result3 <- applyRscignorePatterns("test.txt", dir, dir), + "Error in hierarchical pattern processing" + ) + expect_warning( + result3 <- applyRscignorePatterns("test.txt", dir, dir), + "Falling back to directory-scoped patterns" + ) + } + ) +}) + +# ============================================================================= +# CONSOLIDATED BREAKING CHANGE TESTS (was 5 tests, now 3 tests) +# ============================================================================= + +test_that("BREAKING CHANGE: parent patterns now inherit to subdirectories", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("src", "docs"))) + file.create(file.path(dir, c("debug.log", "config.json", "src/debug.log", "src/config.json", "docs/readme.md"))) + + # Root patterns for both wildcard and exact matching + writeLines(c("*.log", "config.json"), file.path(dir, ".rscignore")) + + # LEGACY MODE: Patterns only affect same directory + withr::local_options(rsconnect.rscignore.legacy = TRUE) + # Suppress warnings since lifecycle may have already emitted them + result_legacy <- suppressWarnings(bundleFiles(dir)) + legacy_affected <- sum(!c("debug.log", "config.json") %in% result_legacy) # Root files ignored + legacy_inherited <- sum(!c("src/debug.log", "src/config.json") %in% result_legacy) # Subdir files ignored + expect_equal(legacy_affected, 2) # Root files ignored + expect_equal(legacy_inherited, 0) # Subdir files NOT ignored (old behavior) + + # HIERARCHICAL MODE: Patterns inherit to subdirectories + withr::local_options(rsconnect.rscignore.legacy = FALSE) + result_hierarchical <- bundleFiles(dir) + hierarchical_affected <- sum(!c("debug.log", "config.json") %in% result_hierarchical) # Root files ignored + hierarchical_inherited <- sum(!c("src/debug.log", "src/config.json") %in% result_hierarchical) # Subdir files ignored + expect_equal(hierarchical_affected, 2) # Root files ignored + expect_equal(hierarchical_inherited, 2) # Subdir files NOW ignored (new behavior) + + # Document the breaking change scope + expect_gt(hierarchical_inherited, legacy_inherited) # More files ignored in hierarchical mode +}) + +test_that("BREAKING CHANGE: negation patterns now work across directory boundaries", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("src", "important"))) + file.create(file.path(dir, c("temp.txt", "src/temp.txt", "important/temp.txt", "important/critical.R"))) + + # Root: ignore all temp.txt files + writeLines("temp.txt", file.path(dir, ".rscignore")) + + # Subdirectory: selectively un-ignore temp.txt + writeLines("!temp.txt", file.path(dir, "important/.rscignore")) + + # LEGACY MODE: Negation only works locally, parent patterns don't inherit + withr::local_options(rsconnect.rscignore.legacy = TRUE) + result_legacy <- suppressWarnings(bundleFiles(dir)) + expect_false("temp.txt" %in% result_legacy) # Root ignored + expect_true("src/temp.txt" %in% result_legacy) # OLD: Not affected by root pattern + expect_true("important/temp.txt" %in% result_legacy) # OLD: Negation works but parent didn't apply + + # HIERARCHICAL MODE: Negation overrides inherited parent patterns + withr::local_options(rsconnect.rscignore.legacy = FALSE) + result_hierarchical <- bundleFiles(dir) + expect_false("temp.txt" %in% result_hierarchical) # Root ignored + expect_false("src/temp.txt" %in% result_hierarchical) # NEW: Ignored by inherited root pattern + expect_true("important/temp.txt" %in% result_hierarchical) # NEW: Un-ignored by child negation + + # Verify non-matching files unaffected + expect_true("important/critical.R" %in% result_legacy) + expect_true("important/critical.R" %in% result_hierarchical) +}) + +test_that("BREAKING CHANGE: pattern scope and precedence differences", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("logs", "backup", "src"))) + file.create(file.path(dir, c("app.log", "logs/access.log", "backup/old.log", "src/error.log", "src/main.R"))) + + # Root wildcard pattern + writeLines("*.log", file.path(dir, ".rscignore")) + + # LEGACY MODE: Wildcard only affects same directory + withr::local_options(rsconnect.rscignore.legacy = TRUE) + result_legacy <- suppressWarnings(bundleFiles(dir)) + legacy_logs <- length(result_legacy[grepl("\\.log$", result_legacy)]) + expect_gt(legacy_logs, 0) # Some .log files survive in subdirectories + + # HIERARCHICAL MODE: Wildcard affects all subdirectories + withr::local_options(rsconnect.rscignore.legacy = FALSE) + result_hierarchical <- bundleFiles(dir) + hierarchical_logs <- length(result_hierarchical[grepl("\\.log$", result_hierarchical)]) + expect_equal(hierarchical_logs, 0) # No .log files survive anywhere + + # Document the scope expansion + expect_gt(legacy_logs, hierarchical_logs) # Hierarchical ignores more files + + # Verify non-matching files unaffected in both modes + expect_true("src/main.R" %in% result_legacy) + expect_true("src/main.R" %in% result_hierarchical) +}) + +test_that("complex scenarios work correctly", { + # Test multiple inheritance levels with various pattern types + dir <- local_temp_app() + dirCreate(file.path(dir, c("src", "src/utils", "tests"))) + file.create(file.path(dir, c("app.log", "src/debug.log", "src/utils/trace.log", "tests/unit.log"))) + file.create(file.path(dir, c("src/main.R", "src/utils/helper.R", "tests/test.R"))) + + # Root: ignore all .log files + writeLines("*.log", file.path(dir, ".rscignore")) + + # Subdirectory: allow debug.log specifically + writeLines("!debug.log", file.path(dir, "src/.rscignore")) + + result <- bundleFiles(dir) + + # Complex inheritance and precedence + expect_false("app.log" %in% result) # Root .log ignored + expect_true("src/debug.log" %in% result) # Un-ignored by child negation + expect_false("src/utils/trace.log" %in% result) # Ignored by inherited root pattern (no local override) + expect_false("tests/unit.log" %in% result) # Ignored by inherited root pattern + + # Non-.log files preserved + expect_true("src/main.R" %in% result) + expect_true("src/utils/helper.R" %in% result) + expect_true("tests/test.R" %in% result) +}) + +test_that("parameter validation and option handling", { + dir <- local_temp_app() + file.create(file.path(dir, "test.txt")) + + # Test bundle_root parameter validation + expect_no_error(applyRscignorePatterns("test.txt", dir, bundle_root = dir)) + expect_no_error(applyRscignorePatterns("test.txt", dir, bundle_root = NULL)) + + # Test option validation + withr::local_options(rsconnect.rscignore.legacy = NULL) + expect_no_error(bundleFiles(dir)) # NULL should default to FALSE + + withr::local_options(rsconnect.rscignore.legacy = FALSE) + expect_no_error(bundleFiles(dir)) + + withr::local_options(rsconnect.rscignore.legacy = TRUE) + suppressWarnings(bundleFiles(dir)) # Test that legacy mode works without error + + # Test invalid option values + withr::local_options(rsconnect.rscignore.legacy = "invalid") + expect_error(bundleFiles(dir), "must be TRUE, FALSE, or NULL") + + withr::local_options(rsconnect.rscignore.legacy = 42) + suppressWarnings(bundleFiles(dir)) # Should convert to TRUE and work +}) \ No newline at end of file From 10a8931c2090fe9e340df7d913e0904c5934ebdb Mon Sep 17 00:00:00 2001 From: BrianLang Date: Sat, 26 Jul 2025 16:02:07 +0200 Subject: [PATCH 3/4] Refactor .rscignore tests to separate file for enhanced clarity Move existing tests for .rscignore functionality, including gitignore-style patterns and hierarchical behavior, to a new dedicated test file. Revert test-bundleFiles.R to original state. --- tests/testthat/test-bundleFiles.R | 141 -------- ...rscignore.R => test-rscignore-gitignore.R} | 318 +++++++++++++----- 2 files changed, 240 insertions(+), 219 deletions(-) rename tests/testthat/{test-hierarchical-rscignore.R => test-rscignore-gitignore.R} (60%) diff --git a/tests/testthat/test-bundleFiles.R b/tests/testthat/test-bundleFiles.R index d80f4431..4bdb9a4c 100644 --- a/tests/testthat/test-bundleFiles.R +++ b/tests/testthat/test-bundleFiles.R @@ -127,147 +127,6 @@ test_that("ignores files listed in .rscignore", { expect_setequal(bundleFiles(dir), character()) }) -test_that("supports gitignore-style wildcard patterns in .rscignore", { - dir <- local_temp_app() - file.create(file.path(dir, c("app.log", "debug.log", "config.txt", "data.csv"))) - expect_setequal(bundleFiles(dir), c("app.log", "debug.log", "config.txt", "data.csv")) - - # Test wildcard patterns - writeLines("*.log", file.path(dir, ".rscignore")) - expect_setequal(bundleFiles(dir), c("config.txt", "data.csv")) - - # Test multiple patterns - writeLines(c("*.log", "*.csv"), file.path(dir, ".rscignore")) - expect_setequal(bundleFiles(dir), "config.txt") -}) - -test_that("supports gitignore-style directory patterns in .rscignore", { - dir <- local_temp_app() - dirCreate(file.path(dir, c("logs", "temp", "src"))) - file.create(file.path(dir, c("app.R", "logs/error.log", "temp/cache.txt", "src/main.R"))) - - # Test directory-only patterns - writeLines("logs/", file.path(dir, ".rscignore")) - result <- bundleFiles(dir) - expect_true("temp/cache.txt" %in% result) - expect_true("src/main.R" %in% result) - expect_true("app.R" %in% result) - expect_false("logs/error.log" %in% result) -}) - -test_that("supports gitignore-style negation patterns in .rscignore", { - dir <- local_temp_app() - file.create(file.path(dir, c("app.log", "debug.log", "error.log", "config.txt"))) - - # Test negation patterns - writeLines(c("*.log", "!error.log"), file.path(dir, ".rscignore")) - result <- bundleFiles(dir) - expect_true("error.log" %in% result) - expect_true("config.txt" %in% result) - expect_false("app.log" %in% result) - expect_false("debug.log" %in% result) -}) - -test_that("supports gitignore-style relative path patterns in .rscignore", { - dir <- local_temp_app() - dirCreate(file.path(dir, "src")) - file.create(file.path(dir, c("config.json", "src/config.json", "src/app.R"))) - - # Test relative path patterns - writeLines("/config.json", file.path(dir, ".rscignore")) - result <- bundleFiles(dir) - expect_false("config.json" %in% result) - expect_true("src/config.json" %in% result) - expect_true("src/app.R" %in% result) -}) - -test_that("supports simple gitignore-style double-asterisk patterns in .rscignore", { - dir <- local_temp_app() - dirCreate(file.path(dir, c("logs", "temp"))) - file.create(file.path(dir, c("cache.tmp", "app.R", "logs/other.tmp", "temp/data.txt"))) - - # Test 1: **/pattern (matches anywhere in current directory scope) - writeLines("**/cache.tmp", file.path(dir, ".rscignore")) - result <- bundleFiles(dir) - expect_false("cache.tmp" %in% result) # Ignored at root level - expect_true("logs/other.tmp" %in% result) # Different file in subdirectory - expect_true("app.R" %in% result) - expect_true("temp/data.txt" %in% result) -}) - -test_that("supports hierarchical .rscignore behavior with ** patterns", { - dir <- local_temp_app() - dirCreate(file.path(dir, c("logs", "temp"))) - file.create(file.path(dir, c("cache.tmp", "app.R", "logs/other.tmp", "temp/data.txt"))) - - # Test subdirectory .rscignore with ** pattern to ignore everything in temp/ - writeLines("**", file.path(dir, "temp/.rscignore")) # Ignore everything in temp/ - result <- bundleFiles(dir) - expect_false("temp/data.txt" %in% result) # Contents of temp/ are ignored - expect_true("cache.tmp" %in% result) - expect_true("app.R" %in% result) - expect_true("logs/other.tmp" %in% result) - - # Test hierarchical behavior - subdirectory .rscignore with specific ** pattern - writeLines("**/other.tmp", file.path(dir, "logs/.rscignore")) - result <- bundleFiles(dir) - expect_false("logs/other.tmp" %in% result) # Now ignored by subdirectory .rscignore - expect_false("temp/data.txt" %in% result) # Still ignored by temp/.rscignore - expect_true("cache.tmp" %in% result) - expect_true("app.R" %in% result) -}) - -test_that("handles comments and empty lines in .rscignore", { - dir <- local_temp_app() - file.create(file.path(dir, c("app.log", "debug.log", "config.txt"))) - - # Test with comments and empty lines - writeLines(c( - "# This is a comment", - "*.log", - "", - "# Another comment", - " # Indented comment" - ), file.path(dir, ".rscignore")) - - result <- bundleFiles(dir) - expect_setequal(result, "config.txt") -}) - -test_that("handles edge cases in gitignore patterns", { - dir <- local_temp_app() - dirCreate(file.path(dir, c("docs", "src"))) - file.create(file.path(dir, c("app.R", "config.txt", "docs/readme.md", "src/main.R"))) - - # Test ** alone (matches everything) - writeLines("**", file.path(dir, ".rscignore")) - expect_length(bundleFiles(dir), 0) - - # Test **/ (matches all directories) - writeLines("**/", file.path(dir, ".rscignore")) - result <- bundleFiles(dir) - expect_true("app.R" %in% result) - expect_true("config.txt" %in% result) - expect_false("docs/readme.md" %in% result) - expect_false("src/main.R" %in% result) -}) - -test_that("maintains backward compatibility with simple .rscignore patterns", { - dir <- local_temp_app() - dirCreate(file.path(dir, "a")) - file.create(file.path(dir, c("simple_file.txt", "a/another_file.R"))) - - # Test that simple string matching still works - writeLines("simple_file.txt", file.path(dir, ".rscignore")) - result <- bundleFiles(dir) - expect_false("simple_file.txt" %in% result) - expect_true("a/another_file.R" %in% result) - - # Test hierarchical behavior is preserved - writeLines("another_file.R", file.path(dir, "a/.rscignore")) - expect_length(bundleFiles(dir), 0) -}) - test_that("ignores temporary files", { ignored <- ignoreBundleFiles( dir = ".", diff --git a/tests/testthat/test-hierarchical-rscignore.R b/tests/testthat/test-rscignore-gitignore.R similarity index 60% rename from tests/testthat/test-hierarchical-rscignore.R rename to tests/testthat/test-rscignore-gitignore.R index 0ea617a9..3f1cc27c 100644 --- a/tests/testthat/test-hierarchical-rscignore.R +++ b/tests/testthat/test-rscignore-gitignore.R @@ -1,23 +1,157 @@ -# Streamlined hierarchical .rscignore tests (consolidated from 23 to 10 tests) +# New .rscignore functionality tests - gitignore-style patterns and hierarchical behavior +# These tests cover features not present in the main branch + +# ============================================================================= +# GITIGNORE-STYLE PATTERN TESTS +# ============================================================================= + +test_that("supports gitignore-style wildcard patterns in .rscignore", { + dir <- local_temp_app() + file.create(file.path(dir, c("app.log", "debug.log", "config.txt", "data.csv"))) + expect_setequal(bundleFiles(dir), c("app.log", "debug.log", "config.txt", "data.csv")) + + # Test wildcard patterns + writeLines("*.log", file.path(dir, ".rscignore")) + expect_setequal(bundleFiles(dir), c("config.txt", "data.csv")) + + # Test multiple patterns + writeLines(c("*.log", "*.csv"), file.path(dir, ".rscignore")) + expect_setequal(bundleFiles(dir), "config.txt") +}) + +test_that("supports gitignore-style directory patterns in .rscignore", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("logs", "temp", "src"))) + file.create(file.path(dir, c("app.R", "logs/error.log", "temp/cache.txt", "src/main.R"))) + + # Test directory-only patterns + writeLines("logs/", file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + expect_true("temp/cache.txt" %in% result) + expect_true("src/main.R" %in% result) + expect_true("app.R" %in% result) + expect_false("logs/error.log" %in% result) +}) + +test_that("supports gitignore-style negation patterns in .rscignore", { + dir <- local_temp_app() + file.create(file.path(dir, c("app.log", "debug.log", "error.log", "config.txt"))) + + # Test negation patterns + writeLines(c("*.log", "!error.log"), file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + expect_true("error.log" %in% result) + expect_true("config.txt" %in% result) + expect_false("app.log" %in% result) + expect_false("debug.log" %in% result) +}) + +test_that("supports gitignore-style relative path patterns in .rscignore", { + dir <- local_temp_app() + dirCreate(file.path(dir, "src")) + file.create(file.path(dir, c("config.json", "src/config.json", "src/app.R"))) + + # Test relative path patterns + writeLines("/config.json", file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + expect_false("config.json" %in% result) + expect_true("src/config.json" %in% result) + expect_true("src/app.R" %in% result) +}) + +test_that("supports simple gitignore-style double-asterisk patterns in .rscignore", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("logs", "temp"))) + file.create(file.path(dir, c("cache.tmp", "app.R", "logs/other.tmp", "temp/data.txt"))) + + # Test 1: **/pattern (matches anywhere in current directory scope) + writeLines("**/cache.tmp", file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + expect_false("cache.tmp" %in% result) # Ignored at root level + expect_true("logs/other.tmp" %in% result) # Different file in subdirectory + expect_true("app.R" %in% result) + expect_true("temp/data.txt" %in% result) +}) + +test_that("handles comments and empty lines in .rscignore", { + dir <- local_temp_app() + file.create(file.path(dir, c("app.log", "debug.log", "config.txt"))) + + # Test with comments and empty lines + writeLines(c( + "# This is a comment", + "*.log", + "", + "# Another comment", + " # Indented comment" + ), file.path(dir, ".rscignore")) + + result <- bundleFiles(dir) + expect_setequal(result, "config.txt") +}) + +test_that("handles edge cases in gitignore patterns", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("docs", "src"))) + file.create(file.path(dir, c("app.R", "config.txt", "docs/readme.md", "src/main.R"))) + + # Test ** alone (matches everything) + writeLines("**", file.path(dir, ".rscignore")) + expect_length(bundleFiles(dir), 0) + + # Test **/ (matches all directories) + writeLines("**/", file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + expect_true("app.R" %in% result) + expect_true("config.txt" %in% result) + expect_false("docs/readme.md" %in% result) + expect_false("src/main.R" %in% result) +}) + +# ============================================================================= +# HIERARCHICAL BEHAVIOR TESTS +# ============================================================================= + +test_that("supports hierarchical .rscignore behavior with ** patterns", { + dir <- local_temp_app() + dirCreate(file.path(dir, c("logs", "temp"))) + file.create(file.path(dir, c("cache.tmp", "app.R", "logs/other.tmp", "temp/data.txt"))) + + # Test subdirectory .rscignore with ** pattern to ignore everything in temp/ + writeLines("**", file.path(dir, "temp/.rscignore")) # Ignore everything in temp/ + result <- bundleFiles(dir) + expect_false("temp/data.txt" %in% result) # Contents of temp/ are ignored + expect_true("cache.tmp" %in% result) + expect_true("app.R" %in% result) + expect_true("logs/other.tmp" %in% result) + + # Test hierarchical behavior - subdirectory .rscignore with specific ** pattern + writeLines("**/other.tmp", file.path(dir, "logs/.rscignore")) + result <- bundleFiles(dir) + expect_false("logs/other.tmp" %in% result) # Now ignored by subdirectory .rscignore + expect_false("temp/data.txt" %in% result) # Still ignored by temp/.rscignore + expect_true("cache.tmp" %in% result) + expect_true("app.R" %in% result) +}) test_that("hierarchical inheritance works by default", { dir <- local_temp_app() dirCreate(file.path(dir, c("src", "docs"))) file.create(file.path(dir, c("app.log", "config.json", "src/debug.log", "src/config.json", "docs/error.log", "src/main.R"))) - + # Test both wildcard and exact patterns inherit to subdirectories writeLines(c("*.log", "config.json"), file.path(dir, ".rscignore")) result <- bundleFiles(dir) - + # All .log files ignored (wildcard inheritance) expect_false("app.log" %in% result) - expect_false("src/debug.log" %in% result) + expect_false("src/debug.log" %in% result) expect_false("docs/error.log" %in% result) - + # All config.json files ignored (exact pattern inheritance) expect_false("config.json" %in% result) expect_false("src/config.json" %in% result) - + # Non-matching files preserved expect_true("src/main.R" %in% result) }) @@ -26,36 +160,56 @@ test_that("child patterns override parent patterns with proper precedence", { dir <- local_temp_app() dirCreate(file.path(dir, c("src", "src/utils"))) file.create(file.path(dir, c("temp.txt", "src/temp.txt", "src/utils/temp.txt", "src/main.R"))) - + # Root: ignore temp.txt everywhere writeLines("temp.txt", file.path(dir, ".rscignore")) - + # Child: un-ignore temp.txt in src/ writeLines("!temp.txt", file.path(dir, "src/.rscignore")) - + # Grandchild: re-ignore temp.txt in src/utils/ writeLines("temp.txt", file.path(dir, "src/utils/.rscignore")) - + result <- bundleFiles(dir) - + expect_false("temp.txt" %in% result) # Root: ignored expect_true("src/temp.txt" %in% result) # Child: un-ignored (overrides parent) expect_false("src/utils/temp.txt" %in% result) # Grandchild: re-ignored (overrides parent negation) expect_true("src/main.R" %in% result) # Unaffected }) +test_that("maintains backward compatibility with simple .rscignore patterns", { + dir <- local_temp_app() + dirCreate(file.path(dir, "a")) + file.create(file.path(dir, c("simple_file.txt", "a/another_file.R"))) + + # Test that simple string matching still works + writeLines("simple_file.txt", file.path(dir, ".rscignore")) + result <- bundleFiles(dir) + expect_false("simple_file.txt" %in% result) + expect_true("a/another_file.R" %in% result) + + # Test hierarchical behavior is preserved + writeLines("another_file.R", file.path(dir, "a/.rscignore")) + expect_length(bundleFiles(dir), 0) +}) + +# ============================================================================= +# LEGACY MODE AND BEHAVIORAL COMPARISON TESTS +# ============================================================================= + test_that("legacy vs hierarchical mode behavioral differences", { dir <- local_temp_app() dirCreate(file.path(dir, "src")) file.create(file.path(dir, c("debug.log", "src/debug.log", "src/main.R"))) writeLines("*.log", file.path(dir, ".rscignore")) - + # LEGACY MODE: only affects same directory withr::local_options(rsconnect.rscignore.legacy = TRUE) result_legacy <- suppressWarnings(bundleFiles(dir)) expect_false("debug.log" %in% result_legacy) expect_true("src/debug.log" %in% result_legacy) # NOT inherited - + # HIERARCHICAL MODE: affects subdirectories too withr::local_options(rsconnect.rscignore.legacy = FALSE) result_hierarchical <- bundleFiles(dir) @@ -63,16 +217,16 @@ test_that("legacy vs hierarchical mode behavioral differences", { expect_false("src/debug.log" %in% result_hierarchical) # Inherited }) -test_that("gitignore-style patterns work correctly", { +test_that("gitignore-style patterns work correctly in hierarchical mode", { dir <- local_temp_app() dirCreate(file.path(dir, c("src", "logs"))) file.create(file.path(dir, c("config.json", "src/config.json", "src/app.R"))) file.create(file.path(dir, c("logs/debug.log", "logs/access.log"))) - + # Test relative path patterns (should only affect same directory) writeLines(c("/config.json", "logs/"), file.path(dir, ".rscignore")) result <- bundleFiles(dir) - + expect_false("config.json" %in% result) # Root config.json ignored by /config.json expect_true("src/config.json" %in% result) # Subdirectory config.json NOT ignored by /config.json expect_false("logs/debug.log" %in% result) # Directory pattern ignores contents @@ -80,49 +234,18 @@ test_that("gitignore-style patterns work correctly", { expect_true("src/app.R" %in% result) # Unaffected file }) -test_that("error handling and edge cases", { - dir <- local_temp_app() - dirCreate(file.path(dir, "src")) - file.create(file.path(dir, c("test.txt", "src/test.txt"))) - - # Test empty .rscignore file - writeLines("", file.path(dir, ".rscignore")) - expect_no_error(result1 <- bundleFiles(dir)) - expect_true("test.txt" %in% result1) - expect_true("src/test.txt" %in% result1) - - # Test missing bundle_root (should fallback gracefully) - contents <- c("test.txt", "src/test.txt") - expect_no_error(result2 <- applyRscignorePatterns(contents, dir, bundle_root = NULL)) - - # Test with mocked error in hierarchical processing - with_mocked_bindings( - collectHierarchicalPatterns = function(...) stop("Test error"), - { - expect_warning( - result3 <- applyRscignorePatterns("test.txt", dir, dir), - "Error in hierarchical pattern processing" - ) - expect_warning( - result3 <- applyRscignorePatterns("test.txt", dir, dir), - "Falling back to directory-scoped patterns" - ) - } - ) -}) - # ============================================================================= -# CONSOLIDATED BREAKING CHANGE TESTS (was 5 tests, now 3 tests) +# BREAKING CHANGE DOCUMENTATION TESTS # ============================================================================= test_that("BREAKING CHANGE: parent patterns now inherit to subdirectories", { dir <- local_temp_app() dirCreate(file.path(dir, c("src", "docs"))) file.create(file.path(dir, c("debug.log", "config.json", "src/debug.log", "src/config.json", "docs/readme.md"))) - + # Root patterns for both wildcard and exact matching writeLines(c("*.log", "config.json"), file.path(dir, ".rscignore")) - + # LEGACY MODE: Patterns only affect same directory withr::local_options(rsconnect.rscignore.legacy = TRUE) # Suppress warnings since lifecycle may have already emitted them @@ -131,15 +254,15 @@ test_that("BREAKING CHANGE: parent patterns now inherit to subdirectories", { legacy_inherited <- sum(!c("src/debug.log", "src/config.json") %in% result_legacy) # Subdir files ignored expect_equal(legacy_affected, 2) # Root files ignored expect_equal(legacy_inherited, 0) # Subdir files NOT ignored (old behavior) - - # HIERARCHICAL MODE: Patterns inherit to subdirectories + + # HIERARCHICAL MODE: Patterns inherit to subdirectories withr::local_options(rsconnect.rscignore.legacy = FALSE) result_hierarchical <- bundleFiles(dir) hierarchical_affected <- sum(!c("debug.log", "config.json") %in% result_hierarchical) # Root files ignored hierarchical_inherited <- sum(!c("src/debug.log", "src/config.json") %in% result_hierarchical) # Subdir files ignored expect_equal(hierarchical_affected, 2) # Root files ignored expect_equal(hierarchical_inherited, 2) # Subdir files NOW ignored (new behavior) - + # Document the breaking change scope expect_gt(hierarchical_inherited, legacy_inherited) # More files ignored in hierarchical mode }) @@ -148,27 +271,27 @@ test_that("BREAKING CHANGE: negation patterns now work across directory boundari dir <- local_temp_app() dirCreate(file.path(dir, c("src", "important"))) file.create(file.path(dir, c("temp.txt", "src/temp.txt", "important/temp.txt", "important/critical.R"))) - + # Root: ignore all temp.txt files writeLines("temp.txt", file.path(dir, ".rscignore")) - - # Subdirectory: selectively un-ignore temp.txt + + # Subdirectory: selectively un-ignore temp.txt writeLines("!temp.txt", file.path(dir, "important/.rscignore")) - + # LEGACY MODE: Negation only works locally, parent patterns don't inherit withr::local_options(rsconnect.rscignore.legacy = TRUE) result_legacy <- suppressWarnings(bundleFiles(dir)) expect_false("temp.txt" %in% result_legacy) # Root ignored expect_true("src/temp.txt" %in% result_legacy) # OLD: Not affected by root pattern expect_true("important/temp.txt" %in% result_legacy) # OLD: Negation works but parent didn't apply - + # HIERARCHICAL MODE: Negation overrides inherited parent patterns withr::local_options(rsconnect.rscignore.legacy = FALSE) result_hierarchical <- bundleFiles(dir) expect_false("temp.txt" %in% result_hierarchical) # Root ignored expect_false("src/temp.txt" %in% result_hierarchical) # NEW: Ignored by inherited root pattern expect_true("important/temp.txt" %in% result_hierarchical) # NEW: Un-ignored by child negation - + # Verify non-matching files unaffected expect_true("important/critical.R" %in% result_legacy) expect_true("important/critical.R" %in% result_hierarchical) @@ -178,79 +301,118 @@ test_that("BREAKING CHANGE: pattern scope and precedence differences", { dir <- local_temp_app() dirCreate(file.path(dir, c("logs", "backup", "src"))) file.create(file.path(dir, c("app.log", "logs/access.log", "backup/old.log", "src/error.log", "src/main.R"))) - + # Root wildcard pattern writeLines("*.log", file.path(dir, ".rscignore")) - + # LEGACY MODE: Wildcard only affects same directory withr::local_options(rsconnect.rscignore.legacy = TRUE) result_legacy <- suppressWarnings(bundleFiles(dir)) legacy_logs <- length(result_legacy[grepl("\\.log$", result_legacy)]) expect_gt(legacy_logs, 0) # Some .log files survive in subdirectories - + # HIERARCHICAL MODE: Wildcard affects all subdirectories withr::local_options(rsconnect.rscignore.legacy = FALSE) result_hierarchical <- bundleFiles(dir) hierarchical_logs <- length(result_hierarchical[grepl("\\.log$", result_hierarchical)]) expect_equal(hierarchical_logs, 0) # No .log files survive anywhere - + # Document the scope expansion expect_gt(legacy_logs, hierarchical_logs) # Hierarchical ignores more files - + # Verify non-matching files unaffected in both modes expect_true("src/main.R" %in% result_legacy) expect_true("src/main.R" %in% result_hierarchical) }) +# ============================================================================= +# COMPLEX INTEGRATION TESTS +# ============================================================================= + test_that("complex scenarios work correctly", { # Test multiple inheritance levels with various pattern types dir <- local_temp_app() dirCreate(file.path(dir, c("src", "src/utils", "tests"))) file.create(file.path(dir, c("app.log", "src/debug.log", "src/utils/trace.log", "tests/unit.log"))) file.create(file.path(dir, c("src/main.R", "src/utils/helper.R", "tests/test.R"))) - + # Root: ignore all .log files writeLines("*.log", file.path(dir, ".rscignore")) - + # Subdirectory: allow debug.log specifically writeLines("!debug.log", file.path(dir, "src/.rscignore")) - + result <- bundleFiles(dir) - + # Complex inheritance and precedence expect_false("app.log" %in% result) # Root .log ignored expect_true("src/debug.log" %in% result) # Un-ignored by child negation expect_false("src/utils/trace.log" %in% result) # Ignored by inherited root pattern (no local override) expect_false("tests/unit.log" %in% result) # Ignored by inherited root pattern - + # Non-.log files preserved expect_true("src/main.R" %in% result) - expect_true("src/utils/helper.R" %in% result) + expect_true("src/utils/helper.R" %in% result) expect_true("tests/test.R" %in% result) }) +# ============================================================================= +# ERROR HANDLING AND VALIDATION TESTS +# ============================================================================= + +test_that("error handling and edge cases", { + dir <- local_temp_app() + dirCreate(file.path(dir, "src")) + file.create(file.path(dir, c("test.txt", "src/test.txt"))) + + # Test empty .rscignore file + writeLines("", file.path(dir, ".rscignore")) + expect_no_error(result1 <- bundleFiles(dir)) + expect_true("test.txt" %in% result1) + expect_true("src/test.txt" %in% result1) + + # Test missing bundle_root (should fallback gracefully) + contents <- c("test.txt", "src/test.txt") + expect_no_error(result2 <- applyRscignorePatterns(contents, dir, bundle_root = NULL)) + + # Test with mocked error in hierarchical processing + with_mocked_bindings( + collectHierarchicalPatterns = function(...) stop("Test error"), + { + expect_warning( + result3 <- applyRscignorePatterns("test.txt", dir, dir), + "Error in hierarchical pattern processing" + ) + expect_warning( + result3 <- applyRscignorePatterns("test.txt", dir, dir), + "Falling back to directory-scoped patterns" + ) + } + ) +}) + test_that("parameter validation and option handling", { dir <- local_temp_app() file.create(file.path(dir, "test.txt")) - + # Test bundle_root parameter validation expect_no_error(applyRscignorePatterns("test.txt", dir, bundle_root = dir)) expect_no_error(applyRscignorePatterns("test.txt", dir, bundle_root = NULL)) - + # Test option validation withr::local_options(rsconnect.rscignore.legacy = NULL) expect_no_error(bundleFiles(dir)) # NULL should default to FALSE - + withr::local_options(rsconnect.rscignore.legacy = FALSE) expect_no_error(bundleFiles(dir)) - + withr::local_options(rsconnect.rscignore.legacy = TRUE) - suppressWarnings(bundleFiles(dir)) # Test that legacy mode works without error - + expect_no_error(suppressWarnings(bundleFiles(dir))) # Test that legacy mode works without error + # Test invalid option values withr::local_options(rsconnect.rscignore.legacy = "invalid") expect_error(bundleFiles(dir), "must be TRUE, FALSE, or NULL") - + withr::local_options(rsconnect.rscignore.legacy = 42) - suppressWarnings(bundleFiles(dir)) # Should convert to TRUE and work + expect_no_error(suppressWarnings(bundleFiles(dir))) # Should convert to TRUE and work }) \ No newline at end of file From bb478f6c0971031a927788b394ed4683b9971d62 Mon Sep 17 00:00:00 2001 From: BrianLang Date: Sat, 26 Jul 2025 16:26:39 +0200 Subject: [PATCH 4/4] Update main documentation for bundleFiles.R Update to be more specific about what patterns are and are not supported in the new implementation. Refresh package documentation. --- R/bundleFiles.R | 119 ++++++++++++++-------------- man/applyDirectoryScopedPatterns.Rd | 20 +++++ man/applyRscignorePatternsLegacy.Rd | 19 ----- man/listDeploymentFiles.Rd | 9 ++- man/matchPatternHierarchical.Rd | 21 ----- 5 files changed, 85 insertions(+), 103 deletions(-) create mode 100644 man/applyDirectoryScopedPatterns.Rd delete mode 100644 man/applyRscignorePatternsLegacy.Rd delete mode 100644 man/matchPatternHierarchical.Rd diff --git a/R/bundleFiles.R b/R/bundleFiles.R index 7d271777..ea59a15b 100644 --- a/R/bundleFiles.R +++ b/R/bundleFiles.R @@ -13,11 +13,12 @@ #' version control directories, internal config files, and RStudio state, #' are automatically excluded. #' -#' * You can exclude additional files by listing them in in a `.rscignore` +#' * You can exclude additional files by listing them in a `.rscignore` #' file. This file follows .gitignore-style syntax with one pattern per line. -#' Patterns support wildcards (*, ?, []), directory patterns (dir/), and -#' negation (!pattern). Patterns in parent directories affect subdirectories -#' hierarchically. +#' Patterns support wildcards (* and ?), directory patterns (dir/), and +#' negation (!pattern). Character classes ([abc], [0-9]) and brace expansion +#' ({a,b,c}, {1..3}) are not currently supported. Patterns in parent +#' directories affect subdirectories hierarchically. #' #' `listDeploymentFiles()` will throw an error if the total file size exceeds #' the maximum bundle size (as controlled by option `rsconnect.max.bundle.size`), @@ -300,27 +301,27 @@ detectLongNames <- function(bundleDir, lengthLimit = 32) { applyRscignorePatterns <- function(contents, dir, bundle_root = NULL) { # Check for legacy mode (deprecated behavior) legacy_mode <- getOption("rsconnect.rscignore.legacy", FALSE) - + # Validate option value if (!is.logical(legacy_mode) && !is.null(legacy_mode)) { # Try to convert to logical converted <- suppressWarnings(as.logical(legacy_mode)) if (is.na(converted)) { - stop("Option 'rsconnect.rscignore.legacy' must be TRUE, FALSE, or NULL. Got: ", + stop("Option 'rsconnect.rscignore.legacy' must be TRUE, FALSE, or NULL. Got: ", paste(deparse(getOption("rsconnect.rscignore.legacy")), collapse = "")) } legacy_mode <- converted } - + # Handle NULL case if (is.null(legacy_mode)) { legacy_mode <- FALSE } - + if (legacy_mode) { # Issue deprecation warning for legacy behavior lifecycle::deprecate_warn( - when = "1.6.0", + when = "1.6.0", what = I("Legacy .rscignore behavior"), details = c( "Directory-scoped .rscignore patterns are deprecated.", @@ -332,22 +333,22 @@ applyRscignorePatterns <- function(contents, dir, bundle_root = NULL) { # Use directory-scoped behavior return(applyDirectoryScopedPatterns(contents, dir)) } - + # NEW DEFAULT: Use hierarchical behavior if (is.null(bundle_root)) { bundle_root <- dir # Fallback for backward compatibility } - + tryCatch({ patterns <- collectHierarchicalPatterns(dir, bundle_root) if (length(patterns) > 0) { contents <- applyIgnorePatterns(contents, patterns, dir) } - + # Always exclude .rscignore files themselves contents <- setdiff(contents, ".rscignore") return(contents) - + }, error = function(e) { # Fallback to directory-scoped behavior on error warning("Error in hierarchical pattern processing: ", e$message, call. = FALSE) @@ -357,10 +358,10 @@ applyRscignorePatterns <- function(contents, dir, bundle_root = NULL) { } #' Directory-scoped .rscignore pattern application -#' +#' #' Applies .rscignore patterns only from the current directory, #' without hierarchical inheritance from parent directories. -#' +#' #' @param contents File contents to filter #' @param dir Directory to check for .rscignore #' @return Filtered contents @@ -370,7 +371,7 @@ applyDirectoryScopedPatterns <- function(contents, dir) { if (!file.exists(rscignore_path)) { return(contents) } - + # Simple, robust directory-scoped pattern application tryCatch({ patterns <- parseIgnoreFile(dir) @@ -378,16 +379,16 @@ applyDirectoryScopedPatterns <- function(contents, dir) { # Apply patterns only from this directory (no hierarchical inheritance) contents <- applyIgnorePatterns(contents, patterns, dir) } - + # Always exclude the .rscignore file itself contents <- setdiff(contents, ".rscignore") return(contents) - + }, error = function(e) { # Simple fallback: read lines and filter directly warning("Error processing .rscignore patterns: ", e$message, call. = FALSE) warning("Using simple line-based filtering", call. = FALSE) - + tryCatch({ ignoreContents <- readLines(rscignore_path, warn = FALSE) # Remove empty lines and comments @@ -416,38 +417,38 @@ collectHierarchicalPatterns <- function(current_dir, bundle_root) { if (!dir.exists(current_dir)) { stop("Current directory does not exist: ", current_dir) } - + if (!dir.exists(bundle_root)) { stop("Bundle root does not exist: ", bundle_root) } - + # Ensure paths are normalized for comparison current_dir <- normalizePath(current_dir) bundle_root <- normalizePath(bundle_root) - + # Collect directories from current to root directories <- character() search_dir <- current_dir - + while (TRUE) { directories <- c(directories, search_dir) - + # Stop if we've reached the bundle root if (search_dir == bundle_root) { break } - + # Move up one level parent_dir <- dirname(search_dir) - + # Stop if we can't go higher (filesystem root) if (parent_dir == search_dir) { break } - + search_dir <- parent_dir } - + # Process directories from parent to child (reverse order) # This ensures we get parent patterns first, child patterns last patterns <- list() @@ -461,7 +462,7 @@ collectHierarchicalPatterns <- function(current_dir, bundle_root) { } } } - + # Return patterns in processing order (parent first, child last) return(patterns) } @@ -475,18 +476,18 @@ parseIgnoreFile <- function(directory_path) { if (!file.exists(rscignore_path)) { return(list()) } - + tryCatch({ lines <- readLines(rscignore_path, warn = FALSE) patterns <- list() - + for (line in lines) { pattern_obj <- parseSinglePattern(line) if (!is.null(pattern_obj)) { patterns <- append(patterns, list(pattern_obj)) } } - + return(patterns) }, error = function(e) { warning("Error reading .rscignore file: ", e$message) @@ -501,26 +502,26 @@ parseIgnoreFile <- function(directory_path) { parseSinglePattern <- function(line) { original <- line line <- trimws(line) - + # Skip empty lines and comments if (nchar(line) == 0 || startsWith(line, "#")) { return(NULL) } - + # Handle negation negation <- FALSE if (startsWith(line, "!")) { negation <- TRUE line <- substring(line, 2) } - + # Handle directory-only patterns dir_only <- FALSE if (endsWith(line, "/")) { dir_only <- TRUE line <- substring(line, 1, nchar(line) - 1) } - + # Handle relative vs anywhere patterns relative <- FALSE if (startsWith(line, "/")) { @@ -529,12 +530,12 @@ parseSinglePattern <- function(line) { } else if (grepl("/", line)) { relative <- TRUE } - + # Validate pattern after processing if (nchar(line) == 0) { return(NULL) } - + # Handle special double-asterisk edge cases warning_msg <- NULL if (line == "**") { @@ -549,14 +550,14 @@ parseSinglePattern <- function(line) { dir_only <- TRUE line <- "*" } - + # Issue warning if needed if (!is.null(warning_msg)) { warning(warning_msg) } - + pattern_type <- if (negation) "negation" else if (relative) "relative" else "anywhere" - + list( raw = original, pattern = line, @@ -576,17 +577,17 @@ parseSinglePattern <- function(line) { matchPattern <- function(file_path, pattern, current_dir) { full_path <- file.path(current_dir, file_path) is_directory <- dir.exists(full_path) - + # Handle directory-only restriction if (pattern$dir_only && !is_directory) { return(FALSE) } - + # Handle simple double-asterisk patterns if (grepl("\\*\\*/", pattern$pattern) || grepl("/\\*\\*$", pattern$pattern)) { return(matchDoubleAsteriskPattern(file_path, pattern)) } - + # Regular glob matching return(matchGlobPattern(file_path, pattern)) } @@ -600,14 +601,14 @@ matchGlobPattern <- function(file_path, pattern) { tryCatch({ # Convert glob to regex regex_pattern <- glob2rx(pattern$pattern) - + # Get target string for matching if (pattern$relative) { target <- file_path # Full relative path } else { target <- basename(file_path) # Just the filename } - + # Perform match grepl(regex_pattern, target) }, error = function(e) { @@ -618,12 +619,12 @@ matchGlobPattern <- function(file_path, pattern) { #' Match simple double-asterisk patterns #' -#' @param file_path File path to match against -#' @param pattern Pattern object containing ** +#' @param file_path File path to match against +#' @param pattern Pattern object containing ** #' @return TRUE if pattern matches, FALSE otherwise matchDoubleAsteriskPattern <- function(file_path, pattern) { pattern_str <- pattern$pattern - + if (startsWith(pattern_str, "**/")) { # Case 1: **/foo -> matches foo anywhere (equivalent to just "foo") sub_pattern <- substring(pattern_str, 4) # Remove "**/"" @@ -631,13 +632,13 @@ matchDoubleAsteriskPattern <- function(file_path, pattern) { anywhere_pattern$pattern <- sub_pattern anywhere_pattern$relative <- FALSE return(matchGlobPattern(file_path, anywhere_pattern)) - + } else if (endsWith(pattern_str, "/**")) { # Case 2: abc/** -> everything under abc/ directory prefix <- substring(pattern_str, 1, nchar(pattern_str) - 3) # Remove "/**" return(startsWith(file_path, paste0(prefix, "/"))) } - + # For more complex ** patterns, fall back to basic matching for now return(FALSE) } @@ -652,34 +653,34 @@ applyIgnorePatterns <- function(file_list, patterns, current_dir) { if (length(patterns) == 0) { return(file_list) } - + # Track which files are ignored file_status <- setNames(rep(FALSE, length(file_list)), file_list) - + # Process patterns in order (parent to child, within-file order preserved) # Later patterns override earlier patterns for (pattern in patterns) { for (file in file_list) { # Hierarchical pattern matching logic (formerly in matchPatternHierarchical) matches <- FALSE - + # For relative patterns (starting with /), only match files in the same directory # as the .rscignore file that contains the pattern if (pattern$relative && startsWith(pattern$raw, "/")) { # Get the directory containing this pattern's .rscignore file pattern_dir <- pattern$source_dir - + # Get the directory containing the current file if (grepl("/", file)) { file_dir <- file.path(current_dir, dirname(file)) } else { file_dir <- current_dir } - + # Normalize paths for comparison pattern_dir <- normalizePath(pattern_dir, mustWork = FALSE) file_dir <- normalizePath(file_dir, mustWork = FALSE) - + # If directories match, compare just the filename if (pattern_dir == file_dir) { file_basename <- basename(file) @@ -689,7 +690,7 @@ applyIgnorePatterns <- function(file_list, patterns, current_dir) { # For non-relative patterns, use normal matching matches <- matchPattern(file, pattern, current_dir) } - + if (matches) { if (pattern$negation) { # Negation pattern: un-ignore the file @@ -701,7 +702,7 @@ applyIgnorePatterns <- function(file_list, patterns, current_dir) { } } } - + # Return files that are not ignored file_list[!file_status] } diff --git a/man/applyDirectoryScopedPatterns.Rd b/man/applyDirectoryScopedPatterns.Rd new file mode 100644 index 00000000..13d9fbaa --- /dev/null +++ b/man/applyDirectoryScopedPatterns.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bundleFiles.R +\name{applyDirectoryScopedPatterns} +\alias{applyDirectoryScopedPatterns} +\title{Directory-scoped .rscignore pattern application} +\usage{ +applyDirectoryScopedPatterns(contents, dir) +} +\arguments{ +\item{contents}{File contents to filter} + +\item{dir}{Directory to check for .rscignore} +} +\value{ +Filtered contents +} +\description{ +Applies .rscignore patterns only from the current directory, +without hierarchical inheritance from parent directories. +} diff --git a/man/applyRscignorePatternsLegacy.Rd b/man/applyRscignorePatternsLegacy.Rd deleted file mode 100644 index c3c14c18..00000000 --- a/man/applyRscignorePatternsLegacy.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/bundleFiles.R -\name{applyRscignorePatternsLegacy} -\alias{applyRscignorePatternsLegacy} -\title{Legacy .rscignore pattern application (deprecated)} -\usage{ -applyRscignorePatternsLegacy(contents, dir) -} -\arguments{ -\item{contents}{File contents to filter} - -\item{dir}{Directory to check for .rscignore} -} -\value{ -Filtered contents -} -\description{ -Legacy .rscignore pattern application (deprecated) -} diff --git a/man/listDeploymentFiles.Rd b/man/listDeploymentFiles.Rd index 794288e3..b400c471 100644 --- a/man/listDeploymentFiles.Rd +++ b/man/listDeploymentFiles.Rd @@ -40,11 +40,12 @@ from the following: \item Certain files and folders that don't need to be bundled, such as version control directories, internal config files, and RStudio state, are automatically excluded. -\item You can exclude additional files by listing them in in a \code{.rscignore} +\item You can exclude additional files by listing them in a \code{.rscignore} file. This file follows .gitignore-style syntax with one pattern per line. -Patterns support wildcards (*, ?, []), directory patterns (dir/), and -negation (!pattern). Patterns in parent directories affect subdirectories -hierarchically. +Patterns support wildcards (* and ?), directory patterns (dir/), and +negation (!pattern). Character classes (\link{abc}, \link{0-9}) and brace expansion +({a,b,c}, {1..3}) are not currently supported. Patterns in parent +directories affect subdirectories hierarchically. } \code{listDeploymentFiles()} will throw an error if the total file size exceeds diff --git a/man/matchPatternHierarchical.Rd b/man/matchPatternHierarchical.Rd deleted file mode 100644 index dc5ff6c7..00000000 --- a/man/matchPatternHierarchical.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/bundleFiles.R -\name{matchPatternHierarchical} -\alias{matchPatternHierarchical} -\title{Match a file path against a pattern with hierarchical awareness} -\usage{ -matchPatternHierarchical(file_path, pattern, current_dir) -} -\arguments{ -\item{file_path}{File path relative to current directory} - -\item{pattern}{Pattern object from parseSinglePattern} - -\item{current_dir}{Current directory path (for file info)} -} -\value{ -TRUE if pattern matches, FALSE otherwise -} -\description{ -Match a file path against a pattern with hierarchical awareness -}