From 39d8d52db554957a7f8e4b3371cc7df35f55a8e3 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Wed, 12 Nov 2025 17:44:36 +0100 Subject: [PATCH 01/28] First draft --- NAMESPACE | 7 + R/src.R | 790 +++++++++++++++++++++++ R/tree.R | 4 +- man/ast.Rd | 1 + man/ref.Rd | 1 + man/src.Rd | 77 +++ man/sxp.Rd | 3 +- man/tree.Rd | 1 + tests/testthat/_snaps/src-snapshots.md | 786 +++++++++++++++++++++++ tests/testthat/helper-src.R | 94 +++ tests/testthat/test-src-snapshots.R | 251 ++++++++ tests/testthat/test-src.R | 829 +++++++++++++++++++++++++ 12 files changed, 2842 insertions(+), 2 deletions(-) create mode 100644 R/src.R create mode 100644 man/src.Rd create mode 100644 tests/testthat/_snaps/src-snapshots.md create mode 100644 tests/testthat/helper-src.R create mode 100644 tests/testthat/test-src-snapshots.R create mode 100644 tests/testthat/test-src.R diff --git a/NAMESPACE b/NAMESPACE index ddf8065..ce28f19 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,11 +7,17 @@ S3method(format,lobstr_inspector) S3method(print,lobstr_bytes) S3method(print,lobstr_inspector) S3method(print,lobstr_raw) +S3method(print,lobstr_srcref) S3method(tree_label,"NULL") S3method(tree_label,"function") S3method(tree_label,character) S3method(tree_label,default) S3method(tree_label,environment) +S3method(tree_label,lobstr_srcfile_ref) +S3method(tree_label,lobstr_srcref) +S3method(tree_label,lobstr_srcref_location) +S3method(tree_label,srcfile) +S3method(tree_label,srcref) export(ast) export(cst) export(mem_used) @@ -20,6 +26,7 @@ export(obj_addrs) export(obj_size) export(obj_sizes) export(ref) +export(src) export(sxp) export(tree) export(tree_label) diff --git a/R/src.R b/R/src.R new file mode 100644 index 0000000..d49a630 --- /dev/null +++ b/R/src.R @@ -0,0 +1,790 @@ +#' Display tree of source references +#' +#' Visualizes source reference metadata attached to R objects in a tree structure. +#' Shows source file information, line/column locations, and optionally the +#' actual source code. +#' +#' @param x An R object with source references. Can be: +#' - A `srcref` object +#' - A list of `srcref` objects +#' - A function (closure) with source references +#' - An expression with source references +#' - A primitive/builtin function (will show informative message) +#' @param max_depth Maximum depth to traverse nested structures (default 5) +#' @param max_lines_preview Maximum lines of source to show per srcref (default 3) +#' @param max_length Maximum number of srcref nodes to display (default 100) +#' @param ... Additional arguments passed to [tree()] +#' +#' @return Invisibly returns a structured list containing the source reference +#' information. The list has components: +#' - `type`: Type of input object +#' - `name`: Name of object if applicable +#' - `srcfile`: Source file information +#' - `srcrefs`: List of source reference details +#' +#' @export +#' @family object inspectors +#' @examples +#' # Create a function with source references +#' f <- function(x) { +#' x + 1 +#' } +#' +#' # Display source reference information +#' src(f) +#' +#' # Limit source preview +#' src(f, max_lines_preview = 1) +src <- function( + x, + max_depth = 5L, + max_lines_preview = 3L, + max_length = 100L, + max_vec_len = 3L, + ... +) { + # Initialize environment to track seen srcfiles for deduplication + seen_srcfiles <- new.env(parent = emptyenv()) + + # Detect input type and extract data + result <- extract_src_data( + x, + max_lines_preview, + seen_srcfiles = seen_srcfiles + ) + + if (is.null(result)) { + return(invisible(NULL)) + } + + structure( + result, + max_depth = max_depth, + max_length = max_length, + max_vec_len = max_vec_len, + tree_args = list(...), + class = c("lobstr_srcref", class(result)) + ) +} + +#' @export +print.lobstr_srcref <- function(x, ...) { + max_depth <- max_depth(x) %||% 5L + max_length <- max_length(x) %||% 100L + max_vec_len <- max_vec_len(x) %||% 3L + tree_args <- tree_args(x) %||% list() + + # Remove our attributes before printing but keep class for labelling + attr(x, "max_depth") <- NULL + attr(x, "max_length") <- NULL + attr(x, "max_vec_len") <- NULL + attr(x, "tree_args") <- NULL + + # Print using tree infrastructure + inject(tree( + x = x, + max_depth = max_depth, + max_length = max_length, + max_vec_len = max_vec_len, + !!!tree_args + )) + + invisible(x) +} + +extract_src_data <- function( + x, + max_lines_preview, + seen_srcfiles +) { + # srcref object + if (inherits(x, "srcref")) { + return(extract_single_srcref( + x, + max_lines_preview, + seen_srcfiles + )) + } + + # List of srcrefs + if ( + is.list(x) && + length(x) > 0 && + all(vapply(x, inherits, logical(1), "srcref")) + ) { + return(extract_srcref_list( + x, + max_lines_preview, + seen_srcfiles + )) + } + + # Closure + if (is_closure(x)) { + return(extract_function_srcref( + x, + max_lines_preview, + seen_srcfiles + )) + } + + # Handle expressions and language objects (quoted functions, blocks, etc.) + if (is.expression(x) || is.language(x)) { + srcref_attr <- attr(x, "srcref") + whole_srcref <- attr(x, "wholeSrcref") + srcfile_attr <- attr(x, "srcfile") + + if (has_srcref(x)) { + result <- list() + + # Determine type + type_label <- if (is.expression(x)) { + "expression" + } else if ( + is.call(x) && length(x) > 0 && identical(x[[1]], as.symbol("function")) + ) { + "quoted_function" + } else if (is.call(x) && identical(x[[1]], as.symbol("{"))) { + "block" + } else { + "language" + } + + # Add srcref attribute (could be single or list) + if (!is.null(srcref_attr)) { + if (inherits(srcref_attr, "srcref")) { + result$`attr("srcref")` <- extract_single_srcref( + srcref_attr, + max_lines_preview, + seen_srcfiles + ) + } else if (is.list(srcref_attr)) { + srcref_list <- lapply(seq_along(srcref_attr), function(i) { + extract_single_srcref( + srcref_attr[[i]], + max_lines_preview, + seen_srcfiles + ) + }) + # Add index names to show [[1]], [[2]], etc. + names(srcref_list) <- paste0("[[", seq_along(srcref_list), "]]") + # Always show as list to reveal true structure + result$`attr("srcref")` <- new_lobstr_srcref( + srcref_list, + type = "list" + ) + } + } + + # Add wholeSrcref if present + if (!is.null(whole_srcref)) { + result$`attr("wholeSrcref")` <- extract_single_srcref( + whole_srcref, + max_lines_preview, + seen_srcfiles + ) + } + + # Add srcfile if present and not already included + if ( + !is.null(srcfile_attr) && is.null(srcref_attr) && is.null(whole_srcref) + ) { + result$`attr("srcfile")` <- new_lobstr_srcref( + extract_srcfile_info( + srcfile_attr, + NULL, + max_lines_preview, + seen_srcfiles + ) + ) + } + + # For expressions and language objects, recursively extract nested srcrefs + # Use deep traversal to skip intermediate nodes without srcrefs + if ((is.expression(x) || is.call(x)) && length(x) > 0) { + for (i in seq_along(x)) { + nested_results <- extract_nested_srcrefs( + x[[i]], + max_lines_preview, + seen_srcfiles, + path_prefix = paste0("[[", i, "]]") + ) + + if (!is.null(nested_results) && length(nested_results) > 0) { + # If the result is a simple srcref-bearing object, show it directly + if (!is.null(attr(nested_results, "srcref_type"))) { + result[[paste0("[[", i, "]]")]] <- nested_results + } else { + # It's a list of nested paths - merge them in + for (path_name in names(nested_results)) { + result[[path_name]] <- nested_results[[path_name]] + } + } + } + } + } + + return(new_lobstr_srcref(result, type = type_label)) + } + + # No direct srcrefs - recursively search for nested srcref-bearing objects + if (is.call(x) && length(x) > 0) { + # Check if this is a quoted function - if so, look at the body + if (identical(x[[1]], as.symbol("function")) && length(x) >= 3) { + body_result <- extract_src_data( + x[[3]], + max_lines_preview, + seen_srcfiles = seen_srcfiles + ) + if (!is.null(body_result)) { + result <- list() + result$`[[3]]` <- body_result + return(new_lobstr_srcref(result, type = "quoted_function")) + } + } + + # For other calls, recursively check all elements + nested_results <- list() + for (i in seq_along(x)) { + elem_result <- extract_src_data( + x[[i]], + max_lines_preview, + seen_srcfiles = seen_srcfiles + ) + if (!is.null(elem_result)) { + nested_results[[paste0("[[", i, "]]")]] <- elem_result + } + } + + if (length(nested_results) > 0) { + type_label <- if (identical(x[[1]], as.symbol("{"))) { + "block" + } else { + "language" + } + return(new_lobstr_srcref(nested_results, type = type_label)) + } + } + } + + NULL +} + +extract_nested_srcrefs <- function( + x, + max_lines_preview, + seen_srcfiles, + path_prefix = "" +) { + if (has_srcref(x)) { + return(extract_src_data( + x, + max_lines_preview, + seen_srcfiles = seen_srcfiles + )) + } + + # No direct srcrefs - recurse into children to find nested srcref-bearing objects + if (!is.call(x) && !is.pairlist(x)) { + return(NULL) + } + + # Collect results from children + nested_results <- list() + + for (i in seq_along(x)) { + child_result <- extract_nested_srcrefs( + x[[i]], + max_lines_preview, + seen_srcfiles, + path_prefix = paste0(path_prefix, "[[", i, "]]") + ) + + if (!is.null(child_result)) { + # If child has a srcref_type, it's a complete srcref-bearing object + if (!is.null(attr(child_result, "srcref_type"))) { + # Add it with the accumulated path + nested_results[[paste0(path_prefix, "[[", i, "]]")]] <- child_result + } else { + # Child returned a list of nested paths - merge them + for (path_name in names(child_result)) { + nested_results[[path_name]] <- child_result[[path_name]] + } + } + } + } + + if (length(nested_results) > 0) { + return(nested_results) + } + + return(NULL) +} + +extract_single_srcref <- function( + srcref, + max_lines_preview, + seen_srcfiles +) { + info <- extract_srcref_info(srcref) + srcfile <- attr(srcref, "srcfile") + + result <- new_lobstr_srcref( + list( + location = info$location + ), + type = "srcref" + ) + + if (!is.null(info$bytes)) { + result$bytes <- info$bytes + } + + if (!is.null(info$parsed)) { + result$parsed <- info$parsed + } + + if (!is.null(srcfile)) { + srcfile_info <- extract_srcfile_info( + srcfile, + srcref, + max_lines_preview, + seen_srcfiles + ) + # Don't wrap lobstr_srcfile_ref objects (they're already complete) + if (inherits(srcfile_info, "lobstr_srcfile_ref")) { + result$`attr("srcfile")` <- srcfile_info + } else { + result$`attr("srcfile")` <- new_lobstr_srcref(srcfile_info) + } + } + + new_lobstr_srcref(result) +} + +extract_srcref_list <- function( + srcref_list, + max_lines_preview, + seen_srcfiles +) { + srcrefs <- lapply(srcref_list, function(sr) { + extract_single_srcref( + sr, + max_lines_preview, + seen_srcfiles + ) + }) + + result <- new_lobstr_srcref( + list( + count = length(srcref_list), + srcrefs = new_lobstr_srcref(srcrefs, type = "list") + ), + type = "list" + ) + + result +} + +extract_function_srcref <- function( + fun, + max_lines_preview, + seen_srcfiles +) { + srcref_attr <- attr(fun, "srcref") + whole_srcref <- attr(body(fun), "wholeSrcref") + srcfile_attr <- attr(fun, "srcfile") + + if (is.null(srcref_attr) && is.null(whole_srcref) && is.null(srcfile_attr)) { + return(NULL) + } + + result <- list() + + # Add srcref attribute from function + if (!is.null(srcref_attr)) { + if (inherits(srcref_attr, "srcref")) { + # Single srcref for whole function + result$`attr("srcref")` <- extract_single_srcref( + srcref_attr, + max_lines_preview, + seen_srcfiles + ) + } else if (is.list(srcref_attr)) { + # List of statement srcrefs + block <- lapply(srcref_attr, function(sr) { + extract_single_srcref( + sr, + max_lines_preview, + seen_srcfiles + ) + }) + result$`attr("srcref")` <- new_lobstr_srcref(block, type = "block") + } + } + + # Add whole function srcref from body + if (!is.null(whole_srcref)) { + body_node <- list( + `attr("wholeSrcref")` = extract_single_srcref( + whole_srcref, + max_lines_preview, + seen_srcfiles + ) + ) + result$`body()` <- new_lobstr_srcref(body_node, type = "body") + } + + # Recursively extract nested srcrefs from the function body + body_content <- body(fun) + if (!is.null(body_content)) { + body_result <- extract_src_data( + body_content, + max_lines_preview, + seen_srcfiles = seen_srcfiles + ) + + # If we found nested srcrefs in the body, add them + if (!is.null(body_result)) { + # If we already have a body() node from wholeSrcref, merge the nested results into it + if ("body()" %in% names(result)) { + # Add the nested structure to the existing body node + body_names <- names(body_result) + for (name in body_names) { + result$`body()`[[name]] <- body_result[[name]] + } + } else { + # No wholeSrcref, so create a body() node with just the nested results + result$`body()` <- body_result + } + } + } + + # Add srcfile if available and not already included + if (!is.null(srcfile_attr) && is.null(whole_srcref) && is.null(srcref_attr)) { + result$`attr("srcfile")` <- new_lobstr_srcref( + extract_srcfile_info( + srcfile_attr, + NULL, + max_lines_preview, + seen_srcfiles + ) + ) + } + + new_lobstr_srcref(result, type = "closure") +} + +extract_srcref_info <- function(srcref) { + if (!inherits(srcref, "srcref")) { + abort("Expected a srcref object") + } + + len <- length(srcref) + + if (!len %in% c(4, 6, 8)) { + abort( + sprintf("Unexpected srcref length: %d (expected 4, 6, or 8)", len), + srcref = srcref + ) + } + + first_line <- srcref_first_line(srcref) + first_byte <- srcref_first_byte(srcref) + last_line <- srcref_last_line(srcref) + last_byte <- srcref_last_byte(srcref) + first_col <- srcref_first_col(srcref) + last_col <- srcref_last_col(srcref) + first_parsed <- srcref_first_parsed(srcref) + last_parsed <- srcref_last_parsed(srcref) + + info <- list( + first_line = first_line, + first_byte = first_byte, + last_line = last_line, + last_byte = last_byte, + first_col = first_col, + last_col = last_col, + first_parsed = first_parsed, + last_parsed = last_parsed, + location = new_lobstr_srcref_location( + format_location(first_line, first_col, last_line, last_col) + ) + ) + + # Add byte info if different from columns + if (first_byte != first_col || last_byte != last_col) { + info$bytes <- format_bytes(first_byte, last_byte) + } + + # Add parsed info if different from actual lines + if (first_parsed != first_line || last_parsed != last_line) { + info$parsed <- format_parsed(first_parsed, first_col, last_parsed, last_col) + } + + info +} + +extract_srcfile_info <- function( + srcfile, + srcref = NULL, + max_lines_preview = 3L, + seen_srcfiles +) { + if (is.null(srcfile)) { + return(NULL) + } + + addr <- obj_addr(srcfile) + srcfile_class <- class(srcfile)[[1]] + + # Check for deduplication + id <- seen_srcfiles[[addr]] + if (!is_null(id)) { + return(new_lobstr_srcfile_ref(id, srcfile_class)) + } + + # First occurrence - assign ID (first 6 chars of hex address without 0x) + id <- substr(addr, 3, 8) + seen_srcfiles[[addr]] <- id + + # Convert srcfile environment to list showing all fields as-is + info <- as.list.environment(srcfile, all.names = TRUE, sorted = TRUE) + + # Format timestamp if present for more ergonomic display + if (!is.null(info$timestamp)) { + info$timestamp <- format(info$timestamp) + } + + # For plain srcfile (not srcfilecopy), show source lines preview + if (!inherits(srcfile, "srcfilecopy") && !is.null(srcref)) { + snippet <- extract_lines_from_srcfile( + srcfile, + srcref, + max_lines_preview, + embedded = FALSE + ) + if (length(snippet) > 0) { + info$`lines (from file)` <- snippet + } + } + + new_lobstr_srcref( + info, + type = "srcfile", + srcfile_class = srcfile_class %||% "srcfile", + srcfile_id = id + ) +} + +extract_lines_from_srcfile <- function( + srcfile, + srcref, + max_lines = 3L, + embedded = TRUE +) { + if (is.null(srcfile) || is.null(srcref)) { + return(character(0)) + } + + first_line <- srcref_first_line(srcref) + last_line <- srcref_last_line(srcref) + + # Truncate if too many lines + if (last_line - first_line + 1 > max_lines) { + last_line <- first_line + max_lines - 1 + } + + # First check for lines in srcfile (srcfilecopy stores source) + lines <- srcfile$lines + if (!is.null(lines) && length(lines) >= last_line) { + return(lines[first_line:last_line]) + } + + # Now try reading from file + # For srcfilecopy with isFile = TRUE`, or plain srcfile pointing to a real file + filename <- srcfile$filename + directory <- srcfile$wd + + if (!is.null(filename) && !is.null(directory)) { + filepath <- file.path(directory, filename) + + if (file.exists(filepath)) { + encoding <- srcfile$Enc %||% "unknown" + all_lines <- tryCatch( + readLines(filepath, encoding = encoding, warn = FALSE), + error = function(e) NULL + ) + + if (!is.null(all_lines) && length(all_lines) >= last_line) { + return(all_lines[first_line:last_line]) + } + } + } + + # We tried + character(0) +} + +has_srcref <- function(x) { + !is.null(attr(x, "srcref")) || + !is.null(attr(x, "wholeSrcref")) || + !is.null(attr(x, "srcfile")) +} + + +# Formatting --- + +format_location <- function(first_line, first_col, last_line, last_col) { + sprintf("%d:%d-%d:%d", first_line, first_col, last_line, last_col) +} + +format_bytes <- function(first_byte, last_byte) { + sprintf("%d-%d", first_byte, last_byte) +} + +format_parsed <- function(first_parsed, first_col, last_parsed, last_col) { + sprintf("%d:%d-%d:%d", first_parsed, first_col, last_parsed, last_col) +} + +#' @export +tree_label.lobstr_srcref_location <- function(x, opts) { + as.character(x) +} + +#' @export +tree_label.srcref <- function(x, opts) { + location <- format_location(x[1], x[5] %||% x[2], x[3], x[6] %||% x[4]) + paste0("") +} + +#' @export +tree_label.srcfile <- function(x, opts) { + paste0("<", class(x)[1], ": ", getSrcFilename(x), ">") +} + +#' @export +tree_label.lobstr_srcfile_ref <- function(x, opts) { + # Show reference ID + paste0("@", as.character(x)) +} + +#' @export +tree_label.lobstr_srcref <- function(x, opts) { + type <- srcref_type(x) + + label <- switch( + type, + "body" = "", + "block" = "<{>", + "srcfile" = tree_label_srcfile(x), + paste0("<", type, ">") + ) + + label +} + +tree_label_srcfile <- function(x) { + class <- srcfile_class(x) + label <- paste0("<", class, ">") + + id <- srcfile_id(x) + if (!is.null(id)) { + label <- paste0(label, " @", id) + } + + label +} + + +# Helper classes --- + +new_lobstr_srcref <- function(x, type = NULL, ..., class = NULL) { + type <- type %||% srcref_type(x) + type <- arg_match( + type, + c( + "block", + "body", + "closure", + "expression", + "language", + "list", + "quoted_function", + "srcfile", + "srcref" + ) + ) + + structure( + x, + srcref_type = type, + ..., + class = c(class, "lobstr_srcref") + ) +} + +srcref_type <- function(x) { + attr(x, "srcref_type") +} +srcfile_class <- function(x) { + attr(x, "srcfile_class") +} +srcfile_id <- function(x) { + attr(x, "srcfile_id") +} +max_depth <- function(x) { + attr(x, "max_depth") +} +max_length <- function(x) { + attr(x, "max_length") +} +max_vec_len <- function(x) { + attr(x, "max_vec_len") +} +tree_args <- function(x) { + attr(x, "tree_args") +} + +# The goal of this class is to provide a custom `tree_label()` method that shows +# unquoted locations. This way we don't make it seem the location string is +# literally stored in the srcref object. +new_lobstr_srcref_location <- function(x) { + structure(x, class = c("lobstr_srcref_location", "character")) +} + +new_lobstr_srcfile_ref <- function(id, srcfile_class = "srcfile") { + structure( + id, + srcfile_class = srcfile_class, + class = "lobstr_srcfile_ref" + ) +} + + +# srcref accessors --- + +srcref_first_line <- function(x) { + x[[1]] +} +srcref_first_byte <- function(x) { + x[[2]] +} +srcref_last_line <- function(x) { + x[[3]] +} +srcref_last_byte <- function(x) { + x[[4]] +} +srcref_first_col <- function(x) { + if (length(x) >= 6) x[[5]] else x[[2]] +} +srcref_last_col <- function(x) { + if (length(x) >= 6) x[[6]] else x[[4]] +} +srcref_first_parsed <- function(x) { + if (length(x) == 8) x[[7]] else x[[1]] +} +srcref_last_parsed <- function(x) { + if (length(x) == 8) x[[8]] else x[[3]] +} diff --git a/R/tree.R b/R/tree.R index 6510e5a..65ec300 100644 --- a/R/tree.R +++ b/R/tree.R @@ -82,6 +82,7 @@ tree <- function( index_unnamed = FALSE, max_depth = 10L, max_length = 1000L, + max_vec_len = 10L, show_environments = TRUE, hide_scalar_types = TRUE, val_printer = crayon::blue, @@ -99,6 +100,7 @@ tree <- function( index_unnamed = index_unnamed, max_depth = max_depth, max_length = max_length, + max_vec_len = max_vec_len, show_envs = show_environments, hide_scalar_types = hide_scalar_types, val_printer = val_printer, @@ -354,7 +356,7 @@ tree_label.character <- function(x, opts) { #' @export tree_label.default <- function(x, opts) { if (rlang::is_atomic(x)) { - opts$val_printer(collapse_and_truncate_vec(x, 10)) + opts$val_printer(collapse_and_truncate_vec(x, opts$max_vec_len)) } else if (rlang::is_function(x)) { # Lots of times function-like functions don't actually trigger the s3 method # for function because they dont have function in their class-list. This diff --git a/man/ast.Rd b/man/ast.Rd index 8b46d01..9c52ee1 100644 --- a/man/ast.Rd +++ b/man/ast.Rd @@ -43,6 +43,7 @@ ast(!1 + !1) \seealso{ Other object inspectors: \code{\link{ref}()}, +\code{\link{src}()}, \code{\link{sxp}()} } \concept{object inspectors} diff --git a/man/ref.Rd b/man/ref.Rd index 37fc80c..3524c82 100644 --- a/man/ref.Rd +++ b/man/ref.Rd @@ -39,6 +39,7 @@ ref(c("x", "x", "y"), character = TRUE) \seealso{ Other object inspectors: \code{\link{ast}()}, +\code{\link{src}()}, \code{\link{sxp}()} } \concept{object inspectors} diff --git a/man/src.Rd b/man/src.Rd new file mode 100644 index 0000000..e364e40 --- /dev/null +++ b/man/src.Rd @@ -0,0 +1,77 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/src.R +\name{src} +\alias{src} +\title{Display tree of source references} +\usage{ +src( + x, + max_depth = 5L, + show_source_lines = TRUE, + max_lines_preview = 3L, + show_encoding_details = FALSE, + max_length = 100L, + max_vec_len = 3L, + ... +) +} +\arguments{ +\item{x}{An R object with source references. Can be: +\itemize{ +\item A \code{srcref} object +\item A list of \code{srcref} objects +\item A function (closure) with source references +\item An expression with source references +\item A primitive/builtin function (will show informative message) +}} + +\item{max_depth}{Maximum depth to traverse nested structures (default 5)} + +\item{show_source_lines}{Whether to show actual source code snippets (default TRUE)} + +\item{max_lines_preview}{Maximum lines of source to show per srcref (default 3)} + +\item{show_encoding_details}{Show byte-level details when they differ from +columns due to multibyte characters (default FALSE)} + +\item{max_length}{Maximum number of srcref nodes to display (default 100)} + +\item{...}{Additional arguments passed to \code{\link[=tree]{tree()}}} +} +\value{ +Invisibly returns a structured list containing the source reference +information. The list has components: +\itemize{ +\item \code{type}: Type of input object +\item \code{name}: Name of object if applicable +\item \code{srcfile}: Source file information +\item \code{srcrefs}: List of source reference details +} +} +\description{ +Visualizes source reference metadata attached to R objects in a tree structure. +Shows source file information, line/column locations, and optionally the +actual source code. +} +\examples{ +# Create a function with source references +f <- function(x) { + x + 1 +} + +# Display source reference information +src(f) + +# Show encoding details +src(f, show_encoding_details = TRUE) + +# Limit source preview +src(f, max_lines_preview = 1) +} +\seealso{ +Other object inspectors: +\code{\link{ast}()}, +\code{\link{ref}()}, +\code{\link{sxp}()} +} +\concept{object inspectors} diff --git a/man/sxp.Rd b/man/sxp.Rd index 0f5511f..bd70bff 100644 --- a/man/sxp.Rd +++ b/man/sxp.Rd @@ -66,6 +66,7 @@ sxp(e2, expand = "environment") \seealso{ Other object inspectors: \code{\link{ast}()}, -\code{\link{ref}()} +\code{\link{ref}()}, +\code{\link{src}()} } \concept{object inspectors} diff --git a/man/tree.Rd b/man/tree.Rd index 884c0be..5bd4819 100644 --- a/man/tree.Rd +++ b/man/tree.Rd @@ -10,6 +10,7 @@ tree( index_unnamed = FALSE, max_depth = 10L, max_length = 1000L, + max_vec_len = 10L, show_environments = TRUE, hide_scalar_types = TRUE, val_printer = crayon::blue, diff --git a/tests/testthat/_snaps/src-snapshots.md b/tests/testthat/_snaps/src-snapshots.md new file mode 100644 index 0000000..67b7c4b --- /dev/null +++ b/tests/testthat/_snaps/src-snapshots.md @@ -0,0 +1,786 @@ +# src() shows closure with srcref and wholeSrcref + + Code + f <- simple_function_with_srcref() + scrub_src(src(f)) + Output + + ├─attr("srcref"): + │ ├─location: 1:14-3:1 + │ └─attr("srcfile"): @008 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: TRUE + │ ├─lines: "test_func <-...", " x + y", "}" + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─body(): + ├─attr("wholeSrcref"): + │ ├─location: 1:0-3:1 + │ └─attr("srcfile"): @008 + └─attr("srcref"): + ├─[[1]]: + │ ├─location: 1:29-1:29 + │ └─attr("srcfile"): @008 + └─[[2]]: + ├─location: 2:3-2:7 + └─attr("srcfile"): @008 + +# src() shows multi-statement function + + Code + f <- multi_statement_function_with_srcref() + scrub_src(src(f)) + Output + + ├─attr("srcref"): + │ ├─location: 1:15-6:1 + │ └─attr("srcfile"): @009 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: TRUE + │ ├─lines: "multi_func <...", " a <- x + 1", " b <- a * 2", ... + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─body(): + ├─attr("wholeSrcref"): + │ ├─location: 1:0-6:1 + │ └─attr("srcfile"): @009 + └─attr("srcref"): + ├─[[1]]: + │ ├─location: 1:27-1:27 + │ └─attr("srcfile"): @009 + ├─[[2]]: + │ ├─location: 2:3-2:12 + │ └─attr("srcfile"): @009 + ├─[[3]]: + │ ├─location: 3:3-3:12 + │ └─attr("srcfile"): @009 + ├─[[4]]: + │ ├─location: 4:3-4:12 + │ └─attr("srcfile"): @009 + └─[[5]]: + ├─location: 5:3-5:3 + └─attr("srcfile"): @009 + +# src() shows quoted function with nested body + + Code + with_srcref("x <- quote(function() {})") + scrub_src(src(x)) + Output + + └─[[3]]: <{> + ├─attr("srcref"): + │ └─[[1]]: + │ ├─location: 1:23-1:23 + │ └─attr("srcfile"): @010 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: TRUE + │ ├─lines: "x <- quote(function() {})" + │ ├─parseData: 1, 1, 1, ...... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─attr("wholeSrcref"): + ├─location: 1:0-1:24 + └─attr("srcfile"): @010 + +# src() shows quoted function body directly + + Code + with_srcref("x <- quote(function() {})") + scrub_src(src(x[[3]])) + Output + <{> + ├─attr("srcref"): + │ └─[[1]]: + │ ├─location: 1:23-1:23 + │ └─attr("srcfile"): @011 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: TRUE + │ ├─lines: "x <- quote(function() {})" + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─attr("wholeSrcref"): + ├─location: 1:0-1:24 + └─attr("srcfile"): @011 + +# src() shows quoted function with arguments + + Code + with_srcref("x <- quote(function(a, b) { a + b })") + scrub_src(src(x)) + Output + + └─[[3]]: <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:27-1:27 + │ │ └─attr("srcfile"): @012 + │ │ ├─Enc: "unknown" + │ │ ├─filename: "" + │ │ ├─fixedNewlines: TRUE + │ │ ├─isFile: TRUE + │ │ ├─lines: "x <- quote(function(a, b) { a +..." + │ │ ├─parseData: 1, 1, 1, ...... + │ │ ├─timestamp: "" + │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─[[2]]: + │ ├─location: 1:29-1:33 + │ └─attr("srcfile"): @012 + └─attr("wholeSrcref"): + ├─location: 1:0-1:35 + └─attr("srcfile"): @012 + +# src() shows expression with single element + + Code + x <- parse(text = "x + 1", keep.source = TRUE) + scrub_src(src(x)) + Output + + ├─attr("srcref"): + │ └─[[1]]: + │ ├─location: 1:1-1:5 + │ └─attr("srcfile"): @013 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: FALSE + │ ├─lines: "x + 1" + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─attr("wholeSrcref"): + ├─location: 1:0-2:0 + └─attr("srcfile"): @013 + +# src() shows expression with multiple elements + + Code + x <- parse(text = c("x + 1", "y + 2", "z + 3"), keep.source = TRUE) + scrub_src(src(x)) + Output + + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:1-1:5 + │ │ └─attr("srcfile"): @014 + │ │ ├─Enc: "unknown" + │ │ ├─filename: "" + │ │ ├─fixedNewlines: TRUE + │ │ ├─isFile: FALSE + │ │ ├─lines: "x + 1", "y + 2", "z + 3" + │ │ ├─parseData: 1, 1, 1, ... + │ │ ├─timestamp: "" + │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ ├─[[2]]: + │ │ ├─location: 2:1-2:5 + │ │ └─attr("srcfile"): @014 + │ └─[[3]]: + │ ├─location: 3:1-3:5 + │ └─attr("srcfile"): @014 + └─attr("wholeSrcref"): + ├─location: 1:0-4:0 + └─attr("srcfile"): @014 + +# src() shows expression with nested block and wholeSrcref + + Code + x <- parse(text = "{\n 1\n}", keep.source = TRUE) + scrub_src(src(x)) + Output + + ├─attr("srcref"): + │ └─[[1]]: + │ ├─location: 1:1-3:1 + │ └─attr("srcfile"): @015 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: FALSE + │ ├─lines: "{", " 1", "}" + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + ├─attr("wholeSrcref"): + │ ├─location: 1:0-4:0 + │ └─attr("srcfile"): @015 + └─[[1]]: <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:1-1:1 + │ │ └─attr("srcfile"): @015 + │ └─[[2]]: + │ ├─location: 2:3-2:3 + │ └─attr("srcfile"): @015 + └─attr("wholeSrcref"): + ├─location: 1:0-3:1 + └─attr("srcfile"): @015 + +# src() shows nested block element directly + + Code + x <- parse(text = "{\n 1\n}", keep.source = TRUE) + scrub_src(src(x[[1]])) + Output + <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:1-1:1 + │ │ └─attr("srcfile"): @016 + │ │ ├─Enc: "unknown" + │ │ ├─filename: "" + │ │ ├─fixedNewlines: TRUE + │ │ ├─isFile: FALSE + │ │ ├─lines: "{", " 1", "}" + │ │ ├─parseData: 1, 1, 1, ... + │ │ ├─timestamp: "" + │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─[[2]]: + │ ├─location: 2:3-2:3 + │ └─attr("srcfile"): @016 + └─attr("wholeSrcref"): + ├─location: 1:0-3:1 + └─attr("srcfile"): @016 + +# src() shows block with srcref list and wholeSrcref + + Code + x <- parse(text = "{\n a <- 1\n b <- 2\n}", keep.source = TRUE) + scrub_src(src(x[[1]])) + Output + <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:1-1:1 + │ │ └─attr("srcfile"): @017 + │ │ ├─Enc: "unknown" + │ │ ├─filename: "" + │ │ ├─fixedNewlines: TRUE + │ │ ├─isFile: FALSE + │ │ ├─lines: "{", " a <- 1", " b <- 2", ... + │ │ ├─parseData: 1, 1, 1, ... + │ │ ├─timestamp: "" + │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ ├─[[2]]: + │ │ ├─location: 2:3-2:8 + │ │ └─attr("srcfile"): @017 + │ └─[[3]]: + │ ├─location: 3:3-3:8 + │ └─attr("srcfile"): @017 + └─attr("wholeSrcref"): + ├─location: 1:0-4:1 + └─attr("srcfile"): @017 + +# src() shows single srcref + + Code + x <- parse(text = "x + 1", keep.source = TRUE) + sr <- attr(x, "srcref")[[1]] + scrub_src(src(sr)) + Output + + ├─location: 1:1-1:5 + └─attr("srcfile"): @018 + ├─Enc: "unknown" + ├─filename: "" + ├─fixedNewlines: TRUE + ├─isFile: FALSE + ├─lines: "x + 1" + ├─parseData: 1, 1, 1, ... + ├─timestamp: "" + └─wd: "/Users/lionel/Sync/Projects/R/r-..." + +# src() shows list of srcrefs with count + + Code + x <- parse(text = c("x + 1", "y + 2"), keep.source = TRUE) + sr_list <- attr(x, "srcref") + scrub_src(src(sr_list)) + Output + + ├─count: 2 + └─srcrefs: + ├─ + │ ├─location: 1:1-1:5 + │ └─attr("srcfile"): @019 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: FALSE + │ ├─lines: "x + 1", "y + 2" + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─ + ├─location: 2:1-2:5 + └─attr("srcfile"): @019 + +# src() reveals srcref list structure with index notation + + Code + with_srcref("x <- quote(function() { 1 })") + scrub_src(src(x[[3]])) + Output + <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:23-1:23 + │ │ └─attr("srcfile"): @020 + │ │ ├─Enc: "unknown" + │ │ ├─filename: "" + │ │ ├─fixedNewlines: TRUE + │ │ ├─isFile: TRUE + │ │ ├─lines: "x <- quote(function() { 1 })" + │ │ ├─parseData: 1, 1, 1, ... + │ │ ├─timestamp: "" + │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─[[2]]: + │ ├─location: 1:25-1:25 + │ └─attr("srcfile"): @020 + └─attr("wholeSrcref"): + ├─location: 1:0-1:27 + └─attr("srcfile"): @020 + +# src() handles srcrefs nested in language calls + + Code + x <- parse(text = "foo({ if (1) bar({ 2 }) })", keep.source = TRUE) + scrub_src(src(x, max_depth = 10)) + Output + + ├─attr("srcref"): + │ └─[[1]]: + │ ├─location: 1:1-1:26 + │ └─attr("srcfile"): @021 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: FALSE + │ ├─lines: "foo({ if (1) bar({ 2 }) })" + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + ├─attr("wholeSrcref"): + │ ├─location: 1:0-2:0 + │ └─attr("srcfile"): @021 + └─[[1]][[2]]: <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:5-1:5 + │ │ └─attr("srcfile"): @021 + │ └─[[2]]: + │ ├─location: 1:7-1:23 + │ └─attr("srcfile"): @021 + ├─attr("wholeSrcref"): + │ ├─location: 1:0-1:25 + │ └─attr("srcfile"): @021 + └─[[2]][[3]][[2]]: <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:18-1:18 + │ │ └─attr("srcfile"): @021 + │ └─[[2]]: + │ ├─location: 1:20-1:20 + │ └─attr("srcfile"): @021 + └─attr("wholeSrcref"): + ├─location: 1:0-1:22 + └─attr("srcfile"): @021 + +# src() handles srcrefs nested in function bodies + + Code + with_srcref("f <- function() foo({ if (1) bar({ 2 }) })") + scrub_src(src(f, max_depth = 10)) + Output + + ├─attr("srcref"): + │ ├─location: 1:6-1:42 + │ └─attr("srcfile"): @022 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: TRUE + │ ├─lines: "f <- function() foo({ if (1) bar..." + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─body(): + └─[[2]]: <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:21-1:21 + │ │ └─attr("srcfile"): @022 + │ └─[[2]]: + │ ├─location: 1:23-1:39 + │ └─attr("srcfile"): @022 + ├─attr("wholeSrcref"): + │ ├─location: 1:0-1:41 + │ └─attr("srcfile"): @022 + └─[[2]][[3]][[2]]: <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:34-1:34 + │ │ └─attr("srcfile"): @022 + │ └─[[2]]: + │ ├─location: 1:36-1:36 + │ └─attr("srcfile"): @022 + └─attr("wholeSrcref"): + ├─location: 1:0-1:38 + └─attr("srcfile"): @022 + +# src() currently shows duplicate srcfile objects + + Code + f <- simple_function_with_srcref() + scrub_src(src(f)) + Output + + ├─attr("srcref"): + │ ├─location: 1:14-3:1 + │ └─attr("srcfile"): @027 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: TRUE + │ ├─lines: "test_func <-...", " x + y", "}" + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─body(): + ├─attr("wholeSrcref"): + │ ├─location: 1:0-3:1 + │ └─attr("srcfile"): @027 + └─attr("srcref"): + ├─[[1]]: + │ ├─location: 1:29-1:29 + │ └─attr("srcfile"): @027 + └─[[2]]: + ├─location: 2:3-2:7 + └─attr("srcfile"): @027 + +# src() shows many duplicate srcfiles in nested expression + + Code + x <- parse(text = "{\n 1\n 2\n}", keep.source = TRUE) + scrub_src(src(x)) + Output + + ├─attr("srcref"): + │ └─[[1]]: + │ ├─location: 1:1-4:1 + │ └─attr("srcfile"): @028 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: FALSE + │ ├─lines: "{", " 1", " 2", ... + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + ├─attr("wholeSrcref"): + │ ├─location: 1:0-5:0 + │ └─attr("srcfile"): @028 + └─[[1]]: <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:1-1:1 + │ │ └─attr("srcfile"): @028 + │ ├─[[2]]: + │ │ ├─location: 2:3-2:3 + │ │ └─attr("srcfile"): @028 + │ └─[[3]]: + │ ├─location: 3:3-3:3 + │ └─attr("srcfile"): @028 + └─attr("wholeSrcref"): + ├─location: 1:0-4:1 + └─attr("srcfile"): @028 + +# src() handles empty block + + Code + x <- parse(text = "{}", keep.source = TRUE) + scrub_src(src(x[[1]])) + Output + <{> + ├─attr("srcref"): + │ └─[[1]]: + │ ├─location: 1:1-1:1 + │ └─attr("srcfile"): @029 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: FALSE + │ ├─lines: "{}" + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─attr("wholeSrcref"): + ├─location: 1:0-1:2 + └─attr("srcfile"): @029 + +# src() handles function without arguments + + Code + with_srcref("f <- function() { NULL }") + scrub_src(src(f)) + Output + + ├─attr("srcref"): + │ ├─location: 1:6-1:24 + │ └─attr("srcfile"): @030 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: TRUE + │ ├─lines: "f <- function() { NULL }" + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─body(): + ├─attr("wholeSrcref"): + │ ├─location: 1:0-1:24 + │ └─attr("srcfile"): @030 + └─attr("srcref"): + ├─[[1]]: + │ ├─location: 1:17-1:17 + │ └─attr("srcfile"): @030 + └─[[2]]: + ├─location: 1:19-1:22 + └─attr("srcfile"): @030 + +# src() handles if statement with blocks + + Code + x <- parse(text = "if (TRUE) { 1 } else { 2 }", keep.source = TRUE) + scrub_src(src(x)) + Output + + ├─attr("srcref"): + │ └─[[1]]: + │ ├─location: 1:1-1:26 + │ └─attr("srcfile"): @031 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: FALSE + │ ├─lines: "if (TRUE) { 1 } else { 2 }" + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + ├─attr("wholeSrcref"): + │ ├─location: 1:0-2:0 + │ └─attr("srcfile"): @031 + ├─[[1]][[3]]: <{> + │ ├─attr("srcref"): + │ │ ├─[[1]]: + │ │ │ ├─location: 1:11-1:11 + │ │ │ └─attr("srcfile"): @031 + │ │ └─[[2]]: + │ │ ├─location: 1:13-1:13 + │ │ └─attr("srcfile"): @031 + │ └─attr("wholeSrcref"): + │ ├─location: 1:0-1:15 + │ └─attr("srcfile"): @031 + └─[[1]][[4]]: <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:22-1:22 + │ │ └─attr("srcfile"): @031 + │ └─[[2]]: + │ ├─location: 1:24-1:24 + │ └─attr("srcfile"): @031 + └─attr("wholeSrcref"): + ├─location: 1:0-1:26 + └─attr("srcfile"): @031 + +# src() respects max_vec_len parameter + + Code + x <- parse(text = paste(rep("1", 10), collapse = "\n"), keep.source = TRUE) + scrub_src(src(x, max_vec_len = 2)) + Output + + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:1-1:1 + │ │ └─attr("srcfile"): @032 + │ │ ├─Enc: "unknown" + │ │ ├─filename: "" + │ │ ├─fixedNewlines: TRUE + │ │ ├─isFile: FALSE + │ │ ├─lines: "1", "1", ... + │ │ ├─parseData: 1, 1, ... + │ │ ├─timestamp: "" + │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ ├─[[2]]: + │ │ ├─location: 2:1-2:1 + │ │ └─attr("srcfile"): @032 + │ ├─[[3]]: + │ │ ├─location: 3:1-3:1 + │ │ └─attr("srcfile"): @032 + │ ├─[[4]]: + │ │ ├─location: 4:1-4:1 + │ │ └─attr("srcfile"): @032 + │ ├─[[5]]: + │ │ ├─location: 5:1-5:1 + │ │ └─attr("srcfile"): @032 + │ ├─[[6]]: + │ │ ├─location: 6:1-6:1 + │ │ └─attr("srcfile"): @032 + │ ├─[[7]]: + │ │ ├─location: 7:1-7:1 + │ │ └─attr("srcfile"): @032 + │ ├─[[8]]: + │ │ ├─location: 8:1-8:1 + │ │ └─attr("srcfile"): @032 + │ ├─[[9]]: + │ │ ├─location: 9:1-9:1 + │ │ └─attr("srcfile"): @032 + │ └─[[10]]: + │ ├─location: 10:1-10:1 + │ └─attr("srcfile"): @032 + └─attr("wholeSrcref"): + ├─location: 1:0-11:0 + └─attr("srcfile"): @032 + +# src() respects show_source_lines parameter + + Code + f <- simple_function_with_srcref() + scrub_src(src(f)) + Output + + ├─attr("srcref"): + │ ├─location: 1:14-3:1 + │ └─attr("srcfile"): @033 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: TRUE + │ ├─lines: "test_func <-...", " x + y", "}" + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─body(): + ├─attr("wholeSrcref"): + │ ├─location: 1:0-3:1 + │ └─attr("srcfile"): @033 + └─attr("srcref"): + ├─[[1]]: + │ ├─location: 1:29-1:29 + │ └─attr("srcfile"): @033 + └─[[2]]: + ├─location: 2:3-2:7 + └─attr("srcfile"): @033 + +# src() shows expression with multiple nested blocks + + Code + x <- parse(text = "{\n {\n 1\n }\n {\n 2\n }\n}", keep.source = TRUE) + scrub_src(src(x)) + Output + + ├─attr("srcref"): + │ └─[[1]]: + │ ├─location: 1:1-8:1 + │ └─attr("srcfile"): @034 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: FALSE + │ ├─lines: "{", " {", " 1", ... + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + ├─attr("wholeSrcref"): + │ ├─location: 1:0-9:0 + │ └─attr("srcfile"): @034 + └─[[1]]: <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:1-1:1 + │ │ └─attr("srcfile"): @034 + │ ├─[[2]]: + │ │ ├─location: 2:3-4:3 + │ │ └─attr("srcfile"): @034 + │ └─[[3]]: + │ ├─location: 5:3-7:3 + │ └─attr("srcfile"): @034 + ├─attr("wholeSrcref"): + │ ├─location: 1:0-8:1 + │ └─attr("srcfile"): @034 + ├─[[2]]: <{> + │ ├─attr("srcref"): + │ │ ├─[[1]]: + │ │ │ ├─location: 2:3-2:3 + │ │ │ └─attr("srcfile"): @034 + │ │ └─[[2]]: + │ │ ├─location: 3:5-3:5 + │ │ └─attr("srcfile"): @034 + │ └─attr("wholeSrcref"): + │ ├─location: 1:0-4:3 + │ └─attr("srcfile"): @034 + └─[[3]]: <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 5:3-5:3 + │ │ └─attr("srcfile"): @034 + │ └─[[2]]: + │ ├─location: 6:5-6:5 + │ └─attr("srcfile"): @034 + └─attr("wholeSrcref"): + ├─location: 1:0-7:3 + └─attr("srcfile"): @034 + +# src() shows function with nested block in body + + Code + with_srcref("f <- function(x) {\n if (x) {\n 1\n }\n}") + scrub_src(src(f)) + Output + + ├─attr("srcref"): + │ ├─location: 1:6-5:1 + │ └─attr("srcfile"): @035 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: TRUE + │ ├─lines: "f <- functio...", " if (x) {", " 1", ... + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─body(): + ├─attr("wholeSrcref"): + │ ├─location: 1:0-5:1 + │ └─attr("srcfile"): @035 + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:18-1:18 + │ │ └─attr("srcfile"): @035 + │ └─[[2]]: + │ ├─location: 2:3-4:3 + │ └─attr("srcfile"): @035 + └─[[2]][[3]]: <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 2:10-2:10 + │ │ └─attr("srcfile"): @035 + │ └─[[2]]: + │ ├─location: 3:5-3:5 + │ └─attr("srcfile"): @035 + └─attr("wholeSrcref"): + ├─location: 1:0-4:3 + └─attr("srcfile"): @035 + diff --git a/tests/testthat/helper-src.R b/tests/testthat/helper-src.R new file mode 100644 index 0000000..ee661e7 --- /dev/null +++ b/tests/testthat/helper-src.R @@ -0,0 +1,94 @@ +# Helper functions for testing source reference functionality + +#' Create a function or expression with source references +#' +#' This helper writes code to a temporary file, sources it, and returns +#' the result with source references attached. Useful for testing srcref +#' functionality. +#' +#' @param code Character vector of R code +#' @param env Environment to source into (default: caller environment) +#' @param file Optional file path (default: creates temp file) +#' @return The result of sourcing the code with keep.source = TRUE +#' @noRd +with_srcref <- function(code, env = parent.frame(), file = NULL) { + if (is.null(file)) { + file <- tempfile("test_srcref", fileext = ".R") + on.exit(unlink(file), add = TRUE) + } + + writeLines(code, file) + source(file, local = env, keep.source = TRUE) +} + +#' Parse code with source references +#' +#' Creates a parsed expression with source references attached, useful for +#' testing srcref extraction from expressions. +#' +#' @param code Character string of R code +#' @return Parsed expression with srcref attributes +#' @noRd +parse_with_srcref <- function(code) { + parse(text = code, keep.source = TRUE) +} + +#' Create a function with known source references +#' +#' Creates a simple test function with predictable source references. +#' +#' @return A function with source references +#' @noRd +simple_function_with_srcref <- function() { + code <- c( + "test_func <- function(x, y) {", + " x + y", + "}" + ) + + env <- new.env(parent = baseenv()) + with_srcref(code, env = env) + env$test_func +} + +#' Create a multi-statement function with source references +#' +#' Creates a function with multiple statements for testing statement-level +#' srcref handling. +#' +#' @return A function with multiple statements and source references +#' @noRd +multi_statement_function_with_srcref <- function() { + code <- c( + "multi_func <- function(x) {", + " a <- x + 1", + " b <- a * 2", + " c <- b - 3", + " c", + "}" + ) + + env <- new.env(parent = baseenv()) + with_srcref(code, env = env) + env$multi_func +} + +#' Create expression with multibyte characters +#' +#' Creates source code with multibyte characters (e.g., "é") to test +#' byte vs column handling. +#' +#' @return Parsed expression with multibyte characters +#' @noRd +expression_with_multibyte <- function() { + code <- c( + "# Créer une fonction", + "café <- function() {", + " 'résumé'", + "}" + ) + + env <- new.env(parent = baseenv()) + with_srcref(code, env = env) + env$café +} diff --git a/tests/testthat/test-src-snapshots.R b/tests/testthat/test-src-snapshots.R new file mode 100644 index 0000000..68d8361 --- /dev/null +++ b/tests/testthat/test-src-snapshots.R @@ -0,0 +1,251 @@ +# Snapshot tests for src() output +# +# These tests capture the current behavior before implementing Phase 1 +# (srcfile deduplication) and Phase 2 (deep AST walking). + +# Helper to scrub non-deterministic parts from src() output -------------------- + +#' Scrub src() output for deterministic snapshots +#' +#' Replaces filenames, directories, and timestamps with stable values +scrub_src <- function(x) { + # Capture the output as text + output <- capture.output(print(x)) + + # Scrub filenames: replace with generic placeholder + output <- gsub('filename: "[^"]+"', 'filename: ""', output) + + # Scrub directories: replace with ... + output <- gsub('directory: "[^"]+"', 'directory: "..."', output) + + # Scrub timestamps: replace with a fixed value + output <- gsub('timestamp: "[^"]+"', 'timestamp: ""', output) + + # Print the scrubbed output + cat(output, sep = "\n") + + invisible(x) +} + +# Test: Closures (evaluated functions) ------------------------------------------ + +test_that("src() shows closure with srcref and wholeSrcref", { + expect_snapshot({ + f <- simple_function_with_srcref() + scrub_src(src(f)) + }) +}) + +test_that("src() shows multi-statement function", { + expect_snapshot({ + f <- multi_statement_function_with_srcref() + scrub_src(src(f)) + }) +}) + +# Test: Quoted functions -------------------------------------------------------- + +test_that("src() shows quoted function with nested body", { + expect_snapshot({ + with_srcref("x <- quote(function() {})") + scrub_src(src(x)) + }) +}) + +test_that("src() shows quoted function body directly", { + expect_snapshot({ + with_srcref("x <- quote(function() {})") + scrub_src(src(x[[3]])) + }) +}) + +test_that("src() shows quoted function with arguments", { + expect_snapshot({ + with_srcref("x <- quote(function(a, b) { a + b })") + scrub_src(src(x)) + }) +}) + +# Test: Expression objects ------------------------------------------------------ + +test_that("src() shows expression with single element", { + expect_snapshot({ + x <- parse(text = "x + 1", keep.source = TRUE) + scrub_src(src(x)) + }) +}) + +test_that("src() shows expression with multiple elements", { + expect_snapshot({ + x <- parse(text = c("x + 1", "y + 2", "z + 3"), keep.source = TRUE) + scrub_src(src(x)) + }) +}) + +test_that("src() shows expression with nested block and wholeSrcref", { + expect_snapshot({ + x <- parse(text = "{\n 1\n}", keep.source = TRUE) + scrub_src(src(x)) + }) +}) + +test_that("src() shows nested block element directly", { + expect_snapshot({ + x <- parse(text = "{\n 1\n}", keep.source = TRUE) + scrub_src(src(x[[1]])) + }) +}) + +# Test: Blocks with wholeSrcref ------------------------------------------------- + +test_that("src() shows block with srcref list and wholeSrcref", { + expect_snapshot({ + x <- parse(text = "{\n a <- 1\n b <- 2\n}", keep.source = TRUE) + scrub_src(src(x[[1]])) + }) +}) + +# Test: Single srcref objects --------------------------------------------------- + +test_that("src() shows single srcref", { + expect_snapshot({ + x <- parse(text = "x + 1", keep.source = TRUE) + sr <- attr(x, "srcref")[[1]] + scrub_src(src(sr)) + }) +}) + +# Test: List of srcrefs --------------------------------------------------------- + +test_that("src() shows list of srcrefs with count", { + expect_snapshot({ + x <- parse(text = c("x + 1", "y + 2"), keep.source = TRUE) + sr_list <- attr(x, "srcref") + scrub_src(src(sr_list)) + }) +}) + +# Test: Srcref lists shown as with [[1]], [[2]] notation ---------------- + +test_that("src() reveals srcref list structure with index notation", { + expect_snapshot({ + with_srcref("x <- quote(function() { 1 })") + scrub_src(src(x[[3]])) + }) +}) + +test_that("src() handles srcrefs nested in language calls", { + expect_snapshot({ + x <- parse(text = "foo({ if (1) bar({ 2 }) })", keep.source = TRUE) + scrub_src(src(x, max_depth = 10)) + }) +}) + +test_that("src() handles srcrefs nested in function bodies", { + expect_snapshot({ + with_srcref("f <- function() foo({ if (1) bar({ 2 }) })") + scrub_src(src(f, max_depth = 10)) + }) +}) + +# Test: Type labels ------------------------------------------------------------- + +test_that("src() uses correct type labels", { + # Closure + f <- simple_function_with_srcref() + result_closure <- src(f) + expect_equal(attr(result_closure, "srcref_type"), "closure") + + # Quoted function + with_srcref("x <- quote(function() {})") + result_quoted <- src(x) + expect_equal(attr(result_quoted, "srcref_type"), "quoted_function") + + # Expression + expr <- parse(text = "1 + 1", keep.source = TRUE) + result_expr <- src(expr) + expect_equal(attr(result_expr, "srcref_type"), "expression") + + # Block + block <- parse(text = "{1}", keep.source = TRUE)[[1]] + result_block <- src(block) + expect_equal(attr(result_block, "srcref_type"), "block") +}) + +# Test: Srcfile duplication (current behavior - will change in Phase 1) -------- + +test_that("src() currently shows duplicate srcfile objects", { + expect_snapshot({ + # Current behavior: srcfile appears twice (in srcref and wholeSrcref) + # After Phase 1: should use reference notation like @abc123 + f <- simple_function_with_srcref() + scrub_src(src(f)) + }) +}) + +test_that("src() shows many duplicate srcfiles in nested expression", { + expect_snapshot({ + # Current behavior: same srcfile appears many times + # After Phase 1: these should be deduplicated + x <- parse(text = "{\n 1\n 2\n}", keep.source = TRUE) + scrub_src(src(x)) + }) +}) + +# Test: Edge cases -------------------------------------------------------------- + +test_that("src() handles empty block", { + expect_snapshot({ + x <- parse(text = "{}", keep.source = TRUE) + scrub_src(src(x[[1]])) + }) +}) + +test_that("src() handles function without arguments", { + expect_snapshot({ + with_srcref("f <- function() { NULL }") + scrub_src(src(f)) + }) +}) + +test_that("src() handles if statement with blocks", { + expect_snapshot({ + x <- parse(text = "if (TRUE) { 1 } else { 2 }", keep.source = TRUE) + scrub_src(src(x)) + }) +}) + +# Test: Parameters -------------------------------------------------------------- + +test_that("src() respects max_vec_len parameter", { + expect_snapshot({ + x <- parse(text = paste(rep("1", 10), collapse = "\n"), keep.source = TRUE) + scrub_src(src(x, max_vec_len = 2)) + }) +}) + +test_that("src() respects show_source_lines parameter", { + expect_snapshot({ + f <- simple_function_with_srcref() + scrub_src(src(f)) + }) +}) + +# Test: Complex nested structures ----------------------------------------------- + +test_that("src() shows expression with multiple nested blocks", { + expect_snapshot({ + x <- parse( + text = "{\n {\n 1\n }\n {\n 2\n }\n}", + keep.source = TRUE + ) + scrub_src(src(x)) + }) +}) + +test_that("src() shows function with nested block in body", { + expect_snapshot({ + with_srcref("f <- function(x) {\n if (x) {\n 1\n }\n}") + scrub_src(src(f)) + }) +}) diff --git a/tests/testthat/test-src.R b/tests/testthat/test-src.R new file mode 100644 index 0000000..dfc6d9e --- /dev/null +++ b/tests/testthat/test-src.R @@ -0,0 +1,829 @@ +# Tests for src() function and helpers + +# Helper function tests -------------------------------------------------------- + +test_that("extract_srcref_info handles 4-element srcrefs", { + # Create a simple expression with srcref + expr <- parse(text = "x + 1", keep.source = TRUE) + srcref <- attr(expr, "srcref")[[1]] + + # Manually create a 4-element srcref for testing + # Note: In practice, 4-element srcrefs are rare in modern R + srcref_4 <- structure( + c(1L, 1L, 1L, 5L), + class = "srcref", + srcfile = attr(srcref, "srcfile") + ) + + info <- lobstr:::extract_srcref_info(srcref_4) + + expect_equal(info$first_line, 1) + expect_equal(info$first_byte, 1) + expect_equal(info$last_line, 1) + expect_equal(info$last_byte, 5) + expect_equal(info$first_col, 1) # Should equal byte for 4-element + expect_equal(info$last_col, 5) # Should equal byte for 4-element + expect_s3_class(info$location, "lobstr_srcref_location") + expect_equal(as.character(info$location), "1:1-1:5") +}) + +test_that("extract_srcref_info handles 6-element srcrefs", { + # Create a 6-element srcref + expr <- parse(text = "x + 1", keep.source = TRUE) + srcref_base <- attr(expr, "srcref")[[1]] + + srcref_6 <- structure( + c(1L, 1L, 1L, 5L, 1L, 5L), + class = "srcref", + srcfile = attr(srcref_base, "srcfile") + ) + + info <- lobstr:::extract_srcref_info(srcref_6) + + expect_equal(info$first_line, 1) + expect_equal(info$first_col, 1) + expect_equal(info$last_line, 1) + expect_equal(info$last_col, 5) + expect_s3_class(info$location, "lobstr_srcref_location") + expect_equal(as.character(info$location), "1:1-1:5") +}) + +test_that("extract_srcref_info handles 8-element srcrefs", { + expr <- parse(text = "x + 1", keep.source = TRUE) + srcref <- attr(expr, "srcref")[[1]] + + # Most modern srcrefs are 8-element + info <- lobstr:::extract_srcref_info(srcref) + + expect_type(info$first_line, "integer") + expect_type(info$last_line, "integer") + expect_s3_class(info$location, "lobstr_srcref_location") + expect_match(as.character(info$location), "\\d+:\\d+-\\d+:\\d+") +}) + +test_that("extract_srcref_info shows encoding details when requested", { + expr <- parse(text = "x + 1", keep.source = TRUE) + srcref <- attr(expr, "srcref")[[1]] + + info <- lobstr:::extract_srcref_info(srcref) + + # For ASCII, bytes should equal columns, so these might be NULL + # But the function should at least check + expect_true("location" %in% names(info)) +}) + +test_that("extract_srcref_info errors on invalid srcref length", { + # Create an invalid srcref with wrong number of elements + bad_srcref <- structure(c(1L, 2L, 3L), class = "srcref") + + expect_error( + lobstr:::extract_srcref_info(bad_srcref), + "Unexpected srcref length" + ) +}) + +test_that("extract_srcfile_info handles srcfilecopy", { + expr <- parse(text = "x + 1", keep.source = TRUE) + srcfile <- attr(attr(expr, "srcref")[[1]], "srcfile") + seen_srcfiles <- new.env(parent = emptyenv()) + + info <- lobstr:::extract_srcfile_info(srcfile, seen_srcfiles = seen_srcfiles) + + expect_equal(attr(info, "srcfile_class"), class(srcfile)[1]) + expect_type(info$filename, "character") + expect_type(info$Enc, "character") +}) + +test_that("extract_srcfile_info handles NULL gracefully", { + seen_srcfiles <- new.env(parent = emptyenv()) + info <- lobstr:::extract_srcfile_info(NULL, seen_srcfiles = seen_srcfiles) + expect_null(info) +}) + +test_that("extract_lines_from_srcfile extracts from srcfilecopy", { + code <- c("x <- 1", "y <- 2", "z <- 3") + expr <- parse(text = code, keep.source = TRUE) + srcref <- attr(expr, "srcref")[[1]] + srcfile <- attr(srcref, "srcfile") + + snippet <- lobstr:::extract_lines_from_srcfile(srcfile, srcref, max_lines = 3) + + expect_type(snippet, "character") + expect_true(length(snippet) >= 1) +}) + +test_that("extract_lines_from_srcfile respects max_lines", { + code <- c("x <- 1", "y <- 2", "z <- 3", "a <- 4", "b <- 5") + expr <- parse(text = paste(code, collapse = "\n"), keep.source = TRUE) + + # Create a srcref spanning multiple lines + srcfile <- attr(attr(expr, "srcref")[[1]], "srcfile") + # Create a fake srcref for lines 1-5 + srcref <- structure( + c(1L, 1L, 5L, 10L, 1L, 10L, 1L, 5L), + class = "srcref", + srcfile = srcfile + ) + + snippet <- lobstr:::extract_lines_from_srcfile(srcfile, srcref, max_lines = 2) + + expect_true(length(snippet) <= 2) +}) + +test_that("format_location works correctly", { + loc <- lobstr:::format_location(1L, 5L, 3L, 20L) + expect_equal(loc, "1:5-3:20") +}) + +test_that("format_bytes works correctly", { + bytes <- lobstr:::format_bytes(10L, 50L) + expect_equal(bytes, "10-50") +}) + +test_that("format_parsed works correctly", { + parsed <- lobstr:::format_parsed(1L, 1L, 3L, 10L) + expect_equal(parsed, "1:1-3:10") +}) + +# Integration tests for src() -------------------------------------------------- + +test_that("src works with functions with source references", { + fun <- simple_function_with_srcref() + + result <- src(fun) + + expect_type(result, "list") + expect_equal(attr(result, "srcref_type"), "closure") +}) + +test_that("src works with single srcref objects", { + expr <- parse(text = "x + 1", keep.source = TRUE) + srcref <- attr(expr, "srcref")[[1]] + + result <- src(srcref) + + expect_type(result, "list") + expect_equal(attr(result, "srcref_type"), "srcref") + expect_true("location" %in% names(result)) +}) + +test_that("src works with list of srcrefs", { + expr <- parse(text = c("x + 1", "y + 2"), keep.source = TRUE) + srcref_list <- attr(expr, "srcref") + + result <- src(srcref_list) + + expect_type(result, "list") + expect_equal(attr(result, "srcref_type"), "list") + expect_equal(result$count, length(srcref_list)) +}) + +test_that("src works with expressions", { + expr <- parse(text = "x + 1", keep.source = TRUE) + + result <- src(expr) + + expect_type(result, "list") +}) + +test_that("src works for objects without srcrefs", { + fun <- function(x) x + 1 + attr(fun, "srcref") <- NULL + expect_null(src(fun)) + expect_null(src(new.env())) + expect_null(src(list())) + expect_null(src(base::list)) +}) + +test_that("src respects max_lines_preview parameter", { + fun <- multi_statement_function_with_srcref() + + result <- src(fun, max_lines_preview = 1) + + expect_type(result, "list") + expect_equal(attr(result, "srcref_type"), "closure") +}) + +test_that("src handles multibyte characters", { + skip_on_os("windows") # Encoding issues on Windows + + fun <- expression_with_multibyte() + + result <- src(fun) + + expect_type(result, "list") + expect_equal(attr(result, "srcref_type"), "closure") +}) + +test_that("src returns structure and print method works", { + fun <- simple_function_with_srcref() + + # src() returns visibly (with S3 class) + result <- src(fun) + expect_s3_class(result, "lobstr_srcref") + + # print method returns invisibly and outputs to console + expect_output( + expect_invisible(print(result)), + "" + ) +}) + +# S3 method tests -------------------------------------------------------------- + +test_that("tree_label.srcref formats correctly", { + expr <- parse(text = "x + 1", keep.source = TRUE) + srcref <- attr(expr, "srcref")[[1]] + + # Call the method directly since srcref has proper class + label <- lobstr:::tree_label.srcref(srcref, list()) + + expect_type(label, "character") + expect_match(label, "= 1) # Should be hex ID (up to 6 chars) + expect_true(nchar(id) <= 6) + + # Check that wholeSrcref uses a reference + whole_srcfile <- result$`body()`$`attr("wholeSrcref")`$`attr("srcfile")` + expect_s3_class(whole_srcfile, "lobstr_srcfile_ref") + expect_equal(as.character(whole_srcfile), id) +}) + +test_that("srcfile deduplication - multiple statement srcrefs share one srcfile", { + # Create a function with multiple statements + code <- parse( + text = "f <- function(x) { a <- x + 1; b <- a * 2; b }", + keep.source = TRUE + ) + f <- eval(code[[1]]) + + result <- src(f) + + # Get the ID from the first occurrence + first_srcfile <- result$`attr("srcref")`$`attr("srcfile")` + id <- attr(first_srcfile, "srcfile_id") + + # Check that all statement srcrefs use references + stmt_list <- result$`body()`$`attr("srcref")` + + for (i in seq_along(stmt_list)) { + stmt_name <- paste0("[[", i, "]]") + stmt_srcfile <- stmt_list[[stmt_name]]$`attr("srcfile")` + + # Should be a reference + expect_s3_class(stmt_srcfile, "lobstr_srcfile_ref") + expect_equal(as.character(stmt_srcfile), id) + } +}) + +test_that("srcfile deduplication - IDs are stable within a single src() call", { + # Parse the same code twice to get two different srcfile objects + code1 <- parse(text = "f <- function(x) { x + 1 }", keep.source = TRUE) + code2 <- parse(text = "g <- function(y) { y * 2 }", keep.source = TRUE) + + f <- eval(code1[[1]]) + g <- eval(code2[[1]]) + + # Call src() on first function + result_f <- src(f) + id_f <- attr(result_f$`attr("srcref")`$`attr("srcfile")`, "srcfile_id") + + # Call src() on second function (different call, different seen_srcfiles) + result_g <- src(g) + id_g <- attr(result_g$`attr("srcref")`$`attr("srcfile")`, "srcfile_id") + + # IDs should be different because they're from different src() calls + # and different srcfile objects + expect_type(id_f, "character") + expect_type(id_g, "character") + + # Both should be hex IDs (up to 6 chars) + expect_true(nchar(id_f) >= 1 && nchar(id_f) <= 6) + expect_true(nchar(id_g) >= 1 && nchar(id_g) <= 6) +}) + +test_that("srcfile deduplication - multiple files means no cross-file deduplication", { + # Parse two separate code snippets (different srcfile objects) + code1 <- parse(text = "f <- function(x) { x + 1 }", keep.source = TRUE) + code2 <- parse(text = "g <- function(y) { y * 2 }", keep.source = TRUE) + + f <- eval(code1[[1]]) + g <- eval(code2[[1]]) + + # Get the srcfile addresses + srcfile_f <- attr(attr(f, "srcref"), "srcfile") + srcfile_g <- attr(attr(g, "srcref"), "srcfile") + + addr_f <- lobstr::obj_addr(srcfile_f) + addr_g <- lobstr::obj_addr(srcfile_g) + + # Different srcfiles should have different addresses + expect_false(addr_f == addr_g) + + # If we call src() on each separately, they each get their own ID + result_f <- src(f) + result_g <- src(g) + + id_f <- attr(result_f$`attr("srcref")`$`attr("srcfile")`, "srcfile_id") + id_g <- attr(result_g$`attr("srcref")`$`attr("srcfile")`, "srcfile_id") + + # IDs are derived from addresses, so different addresses = different IDs + expect_false(id_f == id_g) +}) + +test_that("srcfile deduplication - nested functions from same file", { + # Create code with a nested function + code <- " + outer <- function() { + inner <- function(x) { x + 1 } + inner(5) + } + " + parsed <- parse(text = code, keep.source = TRUE) + eval(parsed[[1]]) + + result <- src(outer) + + # The outer function should have a srcfile with an ID + outer_srcfile <- result$`attr("srcref")`$`attr("srcfile")` + expect_true(!is.null(attr(outer_srcfile, "srcfile_id"))) + + # All other references should use the same ID + id <- attr(outer_srcfile, "srcfile_id") + + # Check wholeSrcref reference + whole_srcfile <- result$`body()`$`attr("wholeSrcref")`$`attr("srcfile")` + expect_s3_class(whole_srcfile, "lobstr_srcfile_ref") + expect_equal(as.character(whole_srcfile), id) +}) + +test_that("srcfile deduplication - reference notation displays correctly", { + code <- parse(text = "f <- function(x) { x + 1 }", keep.source = TRUE) + f <- eval(code[[1]]) + + # Capture the output + output <- capture.output(print(src(f))) + + # Should see the full srcfile once with @id notation + full_srcfile_lines <- grep(" @[0-9a-f]+", output) + expect_true(length(full_srcfile_lines) >= 1) + + # Should see reference notation (just @id without class) + ref_lines <- grep("^[^<]*@[0-9a-f]+\\s*$", output, perl = TRUE) + expect_true(length(ref_lines) >= 1) + + # Extract the ID from both to verify they match + full_line <- output[full_srcfile_lines[1]] + id_from_full <- regmatches(full_line, regexpr("@[0-9a-f]+", full_line)) + + ref_line <- output[ref_lines[1]] + id_from_ref <- regmatches(ref_line, regexpr("@[0-9a-f]+", ref_line)) + + expect_equal(id_from_full, id_from_ref) +}) + +test_that("lobstr_srcfile_ref class has correct structure", { + # Create a reference object directly + ref <- lobstr:::new_lobstr_srcfile_ref("abc123", "srcfilecopy") + + expect_s3_class(ref, "lobstr_srcfile_ref") + expect_equal(as.character(ref), "abc123") + expect_equal(attr(ref, "srcfile_class"), "srcfilecopy") + + # Tree label should show just @id + label <- lobstr:::tree_label.lobstr_srcfile_ref(ref, list()) + expect_equal(label, "@abc123") +}) + +test_that("srcfile deduplication - expression with multiple elements", { + # Parse an expression with multiple top-level elements + code <- parse(text = c("x <- 1", "y <- 2", "z <- 3"), keep.source = TRUE) + + result <- src(code) + + # The expression should have an srcref list + srcref_list <- result$`attr("srcref")` + + # Get the first srcfile + first_srcfile <- srcref_list$`[[1]]`$`attr("srcfile")` + id <- attr(first_srcfile, "srcfile_id") + expect_type(id, "character") + + # Other elements should reference the same srcfile + second_srcfile <- srcref_list$`[[2]]`$`attr("srcfile")` + expect_s3_class(second_srcfile, "lobstr_srcfile_ref") + expect_equal(as.character(second_srcfile), id) + + third_srcfile <- srcref_list$`[[3]]`$`attr("srcfile")` + expect_s3_class(third_srcfile, "lobstr_srcfile_ref") + expect_equal(as.character(third_srcfile), id) +}) + +# Deep nesting tests ---------------------------------------------------------- + +test_that("deep nesting - for loop with nested block", { + code <- parse( + text = " + f <- function(x) { + for (i in 1:x) { + print(i) + } + } + ", + keep.source = TRUE + ) + + eval(code[[1]]) + result <- src(f) + + # Should have body with nested block + expect_true("body()" %in% names(result)) + + # Should show nested block with path notation [[2]][[4]] + # (element 2 of body is the for loop, element 4 is the body block) + nested_block_path <- grep( + "^\\[\\[2\\]\\]\\[\\[4\\]\\]", + names(result$`body()`), + value = TRUE + ) + expect_true(length(nested_block_path) >= 1) + + # The nested block should have srcref attributes + nested_block <- result$`body()`[[nested_block_path[1]]] + expect_s3_class(nested_block, "lobstr_srcref") + expect_true( + !is.null(nested_block$`attr("srcref")`) || + !is.null(nested_block$`attr("wholeSrcref")`) + ) +}) + +test_that("deep nesting - if/else with blocks", { + code <- parse( + text = " + g <- function(x) { + if (x > 0) { + y <- x + 1 + } else { + y <- x - 1 + } + y + } + ", + keep.source = TRUE + ) + + eval(code[[1]]) + result <- src(g) + + # Should show both if and else blocks with path notation + body_names <- names(result$`body()`) + + # Look for nested blocks (should be [[2]][[3]] and [[2]][[4]]) + if_block_paths <- grep( + "^\\[\\[2\\]\\]\\[\\[3\\]\\]", + body_names, + value = TRUE + ) + else_block_paths <- grep( + "^\\[\\[2\\]\\]\\[\\[4\\]\\]", + body_names, + value = TRUE + ) + + expect_true(length(if_block_paths) >= 1) + expect_true(length(else_block_paths) >= 1) + + # Both blocks should be srcref objects + if_block <- result$`body()`[[if_block_paths[1]]] + expect_s3_class(if_block, "lobstr_srcref") + + else_block <- result$`body()`[[else_block_paths[1]]] + expect_s3_class(else_block, "lobstr_srcref") +}) + +test_that("deep nesting - nested blocks { { { } } }", { + code <- parse( + text = " + h <- function() { + { + { + x <- 1 + } + } + } + ", + keep.source = TRUE + ) + + eval(code[[1]]) + result <- src(h) + + # Should have nested blocks + expect_true("body()" %in% names(result)) + + # Should have at least one nested [[2]] block + expect_true("[[2]]" %in% names(result$`body()`)) + + # That nested block should have further nesting + nested_block <- result$`body()`$`[[2]]` + expect_s3_class(nested_block, "lobstr_srcref") + expect_true("[[2]]" %in% names(nested_block)) +}) + +test_that("deep nesting - multiple top-level statements", { + code <- parse( + text = " + f <- function(x) { + a <- x + 1 + b <- a * 2 + for (i in 1:b) { + print(i) + } + b + } + ", + keep.source = TRUE + ) + + eval(code[[1]]) + result <- src(f) + + # Should have body with statement srcrefs + expect_true("body()" %in% names(result)) + expect_true("attr(\"srcref\")" %in% names(result$`body()`)) + + # Should show the nested for loop block + body_names <- names(result$`body()`) + for_block_paths <- grep( + "\\[\\[4\\]\\]\\[\\[4\\]\\]", + body_names, + value = TRUE + ) + expect_true(length(for_block_paths) >= 1) +}) + +test_that("deep nesting - empty function", { + code <- parse(text = "f <- function() {}", keep.source = TRUE) + + eval(code[[1]]) + result <- src(f) + + # Should still have structure + expect_type(result, "list") + expect_s3_class(result, "lobstr_srcref") + expect_true("attr(\"srcref\")" %in% names(result)) +}) + +test_that("deep nesting - very deep structure respects max_depth", { + # Create deeply nested structure + code <- parse( + text = " + f <- function(x) { + for (i in 1:x) { + if (i > 0) { + while (i < 10) { + for (j in 1:i) { + print(j) + } + break + } + } + } + } + ", + keep.source = TRUE + ) + + eval(code[[1]]) + + # With low max_depth, should truncate + result_shallow <- src(f, max_depth = 2) + expect_type(result_shallow, "list") + + # With high max_depth, should show more nesting + result_deep <- src(f, max_depth = 10) + expect_type(result_deep, "list") + + # Deep version should have more nested paths + shallow_paths <- names(result_shallow) + deep_paths <- names(result_deep) + + # Both should be valid results + expect_true(length(shallow_paths) > 0) + expect_true(length(deep_paths) > 0) +}) + +test_that("deep nesting - intermediate calls without srcrefs are omitted", { + code <- parse( + text = " + f <- function(x) { + for (i in 1:x) { + print(i) + } + } + ", + keep.source = TRUE + ) + + eval(code[[1]]) + + # Capture output + output <- capture.output(print(src(f))) + + # Should NOT see intermediate nodes + language_nodes <- grep("", output, value = TRUE) + expect_equal(length(language_nodes), 0) + + # Should see collapsed path notation + collapsed_paths <- grep( + "\\[\\[\\d+\\]\\]\\[\\[\\d+\\]\\]", + output, + value = TRUE + ) + expect_true(length(collapsed_paths) > 0) +}) + +test_that("deep nesting - while loop with nested block", { + code <- parse( + text = " + f <- function(x) { + i <- 0 + while (i < x) { + print(i) + i <- i + 1 + } + } + ", + keep.source = TRUE + ) + + eval(code[[1]]) + result <- src(f) + + # Should have nested block for while body + body_names <- names(result$`body()`) + while_block_paths <- grep( + "\\[\\[3\\]\\]\\[\\[3\\]\\]", + body_names, + value = TRUE + ) + expect_true(length(while_block_paths) >= 1) +}) + +test_that("deep nesting - repeat loop with nested block", { + code <- parse( + text = " + f <- function(x) { + repeat { + print(x) + break + } + } + ", + keep.source = TRUE + ) + + eval(code[[1]]) + result <- src(f) + + # Should have nested block for repeat body + expect_true("body()" %in% names(result)) + body_names <- names(result$`body()`) + + # Look for nested block path + nested_paths <- grep("^\\[\\[2\\]\\]\\[\\[2\\]\\]", body_names, value = TRUE) + expect_true(length(nested_paths) >= 1) +}) + +test_that("deep nesting - switch statement with blocks", { + code <- parse( + text = ' + f <- function(x) { + switch(x, + a = { + print("a") + }, + b = { + print("b") + } + ) + } + ', + keep.source = TRUE + ) + + eval(code[[1]]) + result <- src(f) + + # Should have structure + expect_type(result, "list") + expect_s3_class(result, "lobstr_srcref") +}) + +test_that("deep nesting - quoted expressions with nested blocks", { + code <- parse( + text = " + x <- quote({ + for (i in 1:3) { + print(i) + } + }) + ", + keep.source = TRUE + ) + + eval(code[[1]]) + result <- src(x) + + # Should show nested structure + expect_type(result, "list") + + # Should have nested block paths + if (!is.null(result) && length(result) > 0) { + all_names <- names(unlist(result, recursive = TRUE)) + nested_paths <- grep( + "\\[\\[\\d+\\]\\]\\[\\[\\d+\\]\\]", + all_names, + value = TRUE + ) + # Might or might not have nested paths depending on how quote() preserves srcrefs + expect_true(length(nested_paths) >= 0) + } +}) From e34dd5e87eeb3940dbf09012284bc2f394e5157b Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Thu, 13 Nov 2025 17:52:11 +0100 Subject: [PATCH 02/28] Refactor --- R/src.R | 789 ++++++++----------------- tests/testthat/_snaps/src-snapshots.md | 245 ++++---- tests/testthat/test-src.R | 76 +-- 3 files changed, 430 insertions(+), 680 deletions(-) diff --git a/R/src.R b/R/src.R index d49a630..0d1fe84 100644 --- a/R/src.R +++ b/R/src.R @@ -16,11 +16,7 @@ #' @param ... Additional arguments passed to [tree()] #' #' @return Invisibly returns a structured list containing the source reference -#' information. The list has components: -#' - `type`: Type of input object -#' - `name`: Name of object if applicable -#' - `srcfile`: Source file information -#' - `srcrefs`: List of source reference details +#' information #' #' @export #' @family object inspectors @@ -43,20 +39,18 @@ src <- function( max_vec_len = 3L, ... ) { - # Initialize environment to track seen srcfiles for deduplication seen_srcfiles <- new.env(parent = emptyenv()) - # Detect input type and extract data - result <- extract_src_data( - x, - max_lines_preview, - seen_srcfiles = seen_srcfiles - ) - + result <- src_extract(x, max_lines_preview, seen_srcfiles) if (is.null(result)) { return(invisible(NULL)) } + # Ensure result has proper type for tree display + if (is.null(attr(result, "srcref_type"))) { + result <- as_srcref_tree(result, from = x) + } + structure( result, max_depth = max_depth, @@ -69,18 +63,17 @@ src <- function( #' @export print.lobstr_srcref <- function(x, ...) { - max_depth <- max_depth(x) %||% 5L - max_length <- max_length(x) %||% 100L - max_vec_len <- max_vec_len(x) %||% 3L - tree_args <- tree_args(x) %||% list() + max_depth <- attr(x, "max_depth") %||% 5L + max_length <- attr(x, "max_length") %||% 100L + max_vec_len <- attr(x, "max_vec_len") %||% 3L + tree_args <- attr(x, "tree_args") %||% list() - # Remove our attributes before printing but keep class for labelling + # Strip attributes before printing attr(x, "max_depth") <- NULL attr(x, "max_length") <- NULL attr(x, "max_vec_len") <- NULL attr(x, "tree_args") <- NULL - # Print using tree infrastructure inject(tree( x = x, max_depth = max_depth, @@ -92,18 +85,47 @@ print.lobstr_srcref <- function(x, ...) { invisible(x) } -extract_src_data <- function( - x, - max_lines_preview, - seen_srcfiles -) { - # srcref object +#' @export +tree_label.lobstr_srcref <- function(x, opts) { + type <- attr(x, "srcref_type") + + switch( + type, + body = "", + block = "<{>", + srcfile = srcfile_label(x), + paste0("<", type, ">") + ) +} + +#' @export +tree_label.lobstr_srcref_location <- function(x, opts) { + as.character(x) +} + +#' @export +tree_label.srcref <- function(x, opts) { + loc <- srcref_location(x) + paste0("") +} + +#' @export +tree_label.srcfile <- function(x, opts) { + paste0("<", class(x)[1], ": ", getSrcFilename(x), ">") +} + +#' @export +tree_label.lobstr_srcfile_ref <- function(x, opts) { + paste0("@", as.character(x)) +} + + +# Main extraction logic -------------------------------------------------------- + +src_extract <- function(x, max_lines, seen_srcfiles) { + # Srcref object if (inherits(x, "srcref")) { - return(extract_single_srcref( - x, - max_lines_preview, - seen_srcfiles - )) + return(srcref_node(x, max_lines, seen_srcfiles)) } # List of srcrefs @@ -112,425 +134,199 @@ extract_src_data <- function( length(x) > 0 && all(vapply(x, inherits, logical(1), "srcref")) ) { - return(extract_srcref_list( - x, - max_lines_preview, - seen_srcfiles - )) + return(srcref_list_node(x, max_lines, seen_srcfiles)) } - # Closure + # Evaluated closures if (is_closure(x)) { - return(extract_function_srcref( - x, - max_lines_preview, - seen_srcfiles - )) + return(function_node(x, max_lines, seen_srcfiles)) } - # Handle expressions and language objects (quoted functions, blocks, etc.) + # Expressions and language objects if (is.expression(x) || is.language(x)) { - srcref_attr <- attr(x, "srcref") - whole_srcref <- attr(x, "wholeSrcref") - srcfile_attr <- attr(x, "srcfile") - - if (has_srcref(x)) { - result <- list() - - # Determine type - type_label <- if (is.expression(x)) { - "expression" - } else if ( - is.call(x) && length(x) > 0 && identical(x[[1]], as.symbol("function")) - ) { - "quoted_function" - } else if (is.call(x) && identical(x[[1]], as.symbol("{"))) { - "block" - } else { - "language" - } - - # Add srcref attribute (could be single or list) - if (!is.null(srcref_attr)) { - if (inherits(srcref_attr, "srcref")) { - result$`attr("srcref")` <- extract_single_srcref( - srcref_attr, - max_lines_preview, - seen_srcfiles - ) - } else if (is.list(srcref_attr)) { - srcref_list <- lapply(seq_along(srcref_attr), function(i) { - extract_single_srcref( - srcref_attr[[i]], - max_lines_preview, - seen_srcfiles - ) - }) - # Add index names to show [[1]], [[2]], etc. - names(srcref_list) <- paste0("[[", seq_along(srcref_list), "]]") - # Always show as list to reveal true structure - result$`attr("srcref")` <- new_lobstr_srcref( - srcref_list, - type = "list" - ) - } - } - - # Add wholeSrcref if present - if (!is.null(whole_srcref)) { - result$`attr("wholeSrcref")` <- extract_single_srcref( - whole_srcref, - max_lines_preview, - seen_srcfiles - ) - } - - # Add srcfile if present and not already included - if ( - !is.null(srcfile_attr) && is.null(srcref_attr) && is.null(whole_srcref) - ) { - result$`attr("srcfile")` <- new_lobstr_srcref( - extract_srcfile_info( - srcfile_attr, - NULL, - max_lines_preview, - seen_srcfiles - ) - ) - } - - # For expressions and language objects, recursively extract nested srcrefs - # Use deep traversal to skip intermediate nodes without srcrefs - if ((is.expression(x) || is.call(x)) && length(x) > 0) { - for (i in seq_along(x)) { - nested_results <- extract_nested_srcrefs( - x[[i]], - max_lines_preview, - seen_srcfiles, - path_prefix = paste0("[[", i, "]]") - ) - - if (!is.null(nested_results) && length(nested_results) > 0) { - # If the result is a simple srcref-bearing object, show it directly - if (!is.null(attr(nested_results, "srcref_type"))) { - result[[paste0("[[", i, "]]")]] <- nested_results - } else { - # It's a list of nested paths - merge them in - for (path_name in names(nested_results)) { - result[[path_name]] <- nested_results[[path_name]] - } - } - } - } - } - - return(new_lobstr_srcref(result, type = type_label)) - } - - # No direct srcrefs - recursively search for nested srcref-bearing objects - if (is.call(x) && length(x) > 0) { - # Check if this is a quoted function - if so, look at the body - if (identical(x[[1]], as.symbol("function")) && length(x) >= 3) { - body_result <- extract_src_data( - x[[3]], - max_lines_preview, - seen_srcfiles = seen_srcfiles - ) - if (!is.null(body_result)) { - result <- list() - result$`[[3]]` <- body_result - return(new_lobstr_srcref(result, type = "quoted_function")) - } - } - - # For other calls, recursively check all elements - nested_results <- list() - for (i in seq_along(x)) { - elem_result <- extract_src_data( - x[[i]], - max_lines_preview, - seen_srcfiles = seen_srcfiles - ) - if (!is.null(elem_result)) { - nested_results[[paste0("[[", i, "]]")]] <- elem_result - } - } - - if (length(nested_results) > 0) { - type_label <- if (identical(x[[1]], as.symbol("{"))) { - "block" - } else { - "language" - } - return(new_lobstr_srcref(nested_results, type = type_label)) - } - } + return(expr_node(x, max_lines, seen_srcfiles)) } NULL } -extract_nested_srcrefs <- function( - x, - max_lines_preview, - seen_srcfiles, - path_prefix = "" -) { - if (has_srcref(x)) { - return(extract_src_data( - x, - max_lines_preview, - seen_srcfiles = seen_srcfiles - )) +# Extract standard srcref-related attributes from any object +extract_srcref_attrs <- function(x, max_lines, seen_srcfiles) { + attrs <- list() + + if (!is.null(srcref <- attr(x, "srcref"))) { + attrs$`attr("srcref")` <- process_srcref_attr( + srcref, + max_lines, + seen_srcfiles + ) } - # No direct srcrefs - recurse into children to find nested srcref-bearing objects - if (!is.call(x) && !is.pairlist(x)) { - return(NULL) + if (!is.null(srcfile <- attr(x, "srcfile"))) { + attrs$`attr("srcfile")` <- srcfile_node( + srcfile, + NULL, + max_lines, + seen_srcfiles + ) } - # Collect results from children - nested_results <- list() + if (!is.null(whole <- attr(x, "wholeSrcref"))) { + attrs$`attr("wholeSrcref")` <- srcref_node(whole, max_lines, seen_srcfiles) + } - for (i in seq_along(x)) { - child_result <- extract_nested_srcrefs( - x[[i]], - max_lines_preview, - seen_srcfiles, - path_prefix = paste0(path_prefix, "[[", i, "]]") - ) + attrs +} - if (!is.null(child_result)) { - # If child has a srcref_type, it's a complete srcref-bearing object - if (!is.null(attr(child_result, "srcref_type"))) { - # Add it with the accumulated path - nested_results[[paste0(path_prefix, "[[", i, "]]")]] <- child_result - } else { - # Child returned a list of nested paths - merge them - for (path_name in names(child_result)) { - nested_results[[path_name]] <- child_result[[path_name]] - } - } - } +process_srcref_attr <- function(srcref_attr, max_lines, seen_srcfiles) { + if (inherits(srcref_attr, "srcref")) { + return(srcref_node(srcref_attr, max_lines, seen_srcfiles)) } - if (length(nested_results) > 0) { - return(nested_results) + if (is.list(srcref_attr)) { + srcrefs <- lapply(seq_along(srcref_attr), function(i) { + srcref_node(srcref_attr[[i]], max_lines, seen_srcfiles) + }) + names(srcrefs) <- paste0("[[", seq_along(srcrefs), "]]") + return(new_srcref_tree(srcrefs, type = "list")) } - return(NULL) + stop("unreachable") } -extract_single_srcref <- function( - srcref, - max_lines_preview, - seen_srcfiles -) { - info <- extract_srcref_info(srcref) - srcfile <- attr(srcref, "srcfile") - - result <- new_lobstr_srcref( - list( - location = info$location - ), - type = "srcref" - ) +srcref_node <- function(srcref, max_lines, seen_srcfiles) { + info <- srcref_info(srcref) + node <- list(location = info$location) if (!is.null(info$bytes)) { - result$bytes <- info$bytes + node$bytes <- info$bytes } - if (!is.null(info$parsed)) { - result$parsed <- info$parsed + node$parsed <- info$parsed } - if (!is.null(srcfile)) { - srcfile_info <- extract_srcfile_info( - srcfile, - srcref, - max_lines_preview, - seen_srcfiles - ) - # Don't wrap lobstr_srcfile_ref objects (they're already complete) - if (inherits(srcfile_info, "lobstr_srcfile_ref")) { - result$`attr("srcfile")` <- srcfile_info - } else { - result$`attr("srcfile")` <- new_lobstr_srcref(srcfile_info) - } - } + # Just for completeness but we really don't expect srcref attributes on srcrefs + attrs <- extract_srcref_attrs(srcref, max_lines, seen_srcfiles) + node <- c(node, attrs) - new_lobstr_srcref(result) + new_srcref_tree(node, type = "srcref") } -extract_srcref_list <- function( - srcref_list, - max_lines_preview, - seen_srcfiles -) { - srcrefs <- lapply(srcref_list, function(sr) { - extract_single_srcref( - sr, - max_lines_preview, - seen_srcfiles - ) - }) - - result <- new_lobstr_srcref( - list( - count = length(srcref_list), - srcrefs = new_lobstr_srcref(srcrefs, type = "list") - ), - type = "list" +srcref_list_node <- function(srcref_list, max_lines, seen_srcfiles) { + srcrefs <- lapply(srcref_list, srcref_node, max_lines, seen_srcfiles) + + node <- list( + count = length(srcref_list), + srcrefs = new_srcref_tree(srcrefs, type = "list") ) - result + attrs <- extract_srcref_attrs(srcref_list, max_lines, seen_srcfiles) + node <- c(node, attrs) + + new_srcref_tree(node, type = "list") } -extract_function_srcref <- function( - fun, - max_lines_preview, - seen_srcfiles -) { - srcref_attr <- attr(fun, "srcref") - whole_srcref <- attr(body(fun), "wholeSrcref") - srcfile_attr <- attr(fun, "srcfile") +function_node <- function(fun, max_lines, seen_srcfiles) { + node <- extract_srcref_attrs(fun, max_lines, seen_srcfiles) + body <- src_extract(body(fun), max_lines, seen_srcfiles) - if (is.null(srcref_attr) && is.null(whole_srcref) && is.null(srcfile_attr)) { - return(NULL) + if (!is.null(body)) { + node$`body()` <- as_srcref_tree(body, from = body(fun)) } - result <- list() - - # Add srcref attribute from function - if (!is.null(srcref_attr)) { - if (inherits(srcref_attr, "srcref")) { - # Single srcref for whole function - result$`attr("srcref")` <- extract_single_srcref( - srcref_attr, - max_lines_preview, - seen_srcfiles - ) - } else if (is.list(srcref_attr)) { - # List of statement srcrefs - block <- lapply(srcref_attr, function(sr) { - extract_single_srcref( - sr, - max_lines_preview, - seen_srcfiles - ) - }) - result$`attr("srcref")` <- new_lobstr_srcref(block, type = "block") - } + if (length(node) == 0) { + return(NULL) } - # Add whole function srcref from body - if (!is.null(whole_srcref)) { - body_node <- list( - `attr("wholeSrcref")` = extract_single_srcref( - whole_srcref, - max_lines_preview, - seen_srcfiles - ) - ) - result$`body()` <- new_lobstr_srcref(body_node, type = "body") - } + new_srcref_tree(node, type = "closure") +} - # Recursively extract nested srcrefs from the function body - body_content <- body(fun) - if (!is.null(body_content)) { - body_result <- extract_src_data( - body_content, - max_lines_preview, - seen_srcfiles = seen_srcfiles - ) +expr_node <- function(x, max_lines, seen_srcfiles) { + attrs <- extract_srcref_attrs(x, max_lines, seen_srcfiles) + nested <- extract_nested_srcrefs(x, max_lines, seen_srcfiles) - # If we found nested srcrefs in the body, add them - if (!is.null(body_result)) { - # If we already have a body() node from wholeSrcref, merge the nested results into it - if ("body()" %in% names(result)) { - # Add the nested structure to the existing body node - body_names <- names(body_result) - for (name in body_names) { - result$`body()`[[name]] <- body_result[[name]] - } - } else { - # No wholeSrcref, so create a body() node with just the nested results - result$`body()` <- body_result - } - } + if (length(attrs) > 0) { + # Node has attributes: wrap with proper type + node <- c(attrs, nested) + return(new_srcref_tree(node, type = node_type(x))) } - # Add srcfile if available and not already included - if (!is.null(srcfile_attr) && is.null(whole_srcref) && is.null(srcref_attr)) { - result$`attr("srcfile")` <- new_lobstr_srcref( - extract_srcfile_info( - srcfile_attr, - NULL, - max_lines_preview, - seen_srcfiles - ) - ) + # No attributes: return bare list for path collapsing, or NULL if empty + if (length(nested) > 0) { + nested + } else { + NULL } - - new_lobstr_srcref(result, type = "closure") } -extract_srcref_info <- function(srcref) { - if (!inherits(srcref, "srcref")) { - abort("Expected a srcref object") +extract_nested_srcrefs <- function(x, max_lines, seen_srcfiles) { + if (!is_traversable(x)) { + return(list()) } - len <- length(srcref) + nested <- list() + for (i in seq_along(x)) { + child <- src_extract(x[[i]], max_lines, seen_srcfiles) - if (!len %in% c(4, 6, 8)) { - abort( - sprintf("Unexpected srcref length: %d (expected 4, 6, or 8)", len), - srcref = srcref - ) + if (!is.null(child)) { + nested <- merge_child_result(nested, child, i) + } } - first_line <- srcref_first_line(srcref) - first_byte <- srcref_first_byte(srcref) - last_line <- srcref_last_line(srcref) - last_byte <- srcref_last_byte(srcref) - first_col <- srcref_first_col(srcref) - last_col <- srcref_last_col(srcref) - first_parsed <- srcref_first_parsed(srcref) - last_parsed <- srcref_last_parsed(srcref) + nested +} - info <- list( - first_line = first_line, - first_byte = first_byte, - last_line = last_line, - last_byte = last_byte, - first_col = first_col, - last_col = last_col, - first_parsed = first_parsed, - last_parsed = last_parsed, - location = new_lobstr_srcref_location( - format_location(first_line, first_col, last_line, last_col) - ) - ) +merge_child_result <- function(nested, child, index) { + path <- paste0("[[", index, "]]") - # Add byte info if different from columns - if (first_byte != first_col || last_byte != last_col) { - info$bytes <- format_bytes(first_byte, last_byte) + if (is_wrapped_node(child)) { + nested[[path]] <- child + } else { + # Collapse paths for bare lists + for (name in names(child)) { + nested[[paste0(path, name)]] <- child[[name]] + } } - # Add parsed info if different from actual lines - if (first_parsed != first_line || last_parsed != last_line) { - info$parsed <- format_parsed(first_parsed, first_col, last_parsed, last_col) + nested +} + +is_traversable <- function(x) { + (is.expression(x) || is.call(x)) && length(x) > 0 +} + +is_wrapped_node <- function(x) { + !is.null(attr(x, "srcref_type")) +} + +node_type <- function(x) { + if (is.expression(x)) { + "expression" + } else if (is.call(x) && length(x) > 0) { + if (identical(x[[1]], as.symbol("function"))) { + "quoted_function" + } else if (identical(x[[1]], as.symbol("{"))) { + "block" + } else { + "language" + } + } else { + "language" } +} - info +as_srcref_tree <- function(data, ..., from) { + if (is_wrapped_node(data)) { + data + } else { + new_srcref_tree(data, type = node_type(from)) + } } -extract_srcfile_info <- function( - srcfile, - srcref = NULL, - max_lines_preview = 3L, - seen_srcfiles -) { + +# Srcfile handling ------------------------------------------------------------- + +srcfile_node <- function(srcfile, srcref, max_lines, seen_srcfiles) { if (is.null(srcfile)) { return(NULL) } @@ -538,38 +334,36 @@ extract_srcfile_info <- function( addr <- obj_addr(srcfile) srcfile_class <- class(srcfile)[[1]] - # Check for deduplication + # Check if already seen id <- seen_srcfiles[[addr]] if (!is_null(id)) { - return(new_lobstr_srcfile_ref(id, srcfile_class)) + return(new_srcfile_ref(id, srcfile_class)) } - # First occurrence - assign ID (first 6 chars of hex address without 0x) + # First occurrence - assign ID id <- substr(addr, 3, 8) seen_srcfiles[[addr]] <- id - # Convert srcfile environment to list showing all fields as-is info <- as.list.environment(srcfile, all.names = TRUE, sorted = TRUE) - # Format timestamp if present for more ergonomic display + # Format timestamp for readability if (!is.null(info$timestamp)) { info$timestamp <- format(info$timestamp) } - # For plain srcfile (not srcfilecopy), show source lines preview + # Add source preview for plain srcfiles if (!inherits(srcfile, "srcfilecopy") && !is.null(srcref)) { - snippet <- extract_lines_from_srcfile( - srcfile, - srcref, - max_lines_preview, - embedded = FALSE - ) + snippet <- srcfile_lines(srcfile, srcref, max_lines) if (length(snippet) > 0) { info$`lines (from file)` <- snippet } } - new_lobstr_srcref( + # Check for srcref attributes even on srcfile objects + attrs <- extract_srcref_attrs(srcfile, max_lines, seen_srcfiles) + info <- c(info, attrs) + + new_srcref_tree( info, type = "srcfile", srcfile_class = srcfile_class %||% "srcfile", @@ -577,32 +371,21 @@ extract_srcfile_info <- function( ) } -extract_lines_from_srcfile <- function( - srcfile, - srcref, - max_lines = 3L, - embedded = TRUE -) { +srcfile_lines <- function(srcfile, srcref, max_lines) { if (is.null(srcfile) || is.null(srcref)) { return(character(0)) } - first_line <- srcref_first_line(srcref) - last_line <- srcref_last_line(srcref) - - # Truncate if too many lines - if (last_line - first_line + 1 > max_lines) { - last_line <- first_line + max_lines - 1 - } + first_line <- srcref[[1]] + last_line <- min(srcref[[3]], first_line + max_lines - 1) - # First check for lines in srcfile (srcfilecopy stores source) + # Try embedded lines first lines <- srcfile$lines if (!is.null(lines) && length(lines) >= last_line) { return(lines[first_line:last_line]) } - # Now try reading from file - # For srcfilecopy with isFile = TRUE`, or plain srcfile pointing to a real file + # Try reading from file filename <- srcfile$filename directory <- srcfile$wd @@ -622,85 +405,86 @@ extract_lines_from_srcfile <- function( } } - # We tried character(0) } -has_srcref <- function(x) { - !is.null(attr(x, "srcref")) || - !is.null(attr(x, "wholeSrcref")) || - !is.null(attr(x, "srcfile")) -} - +srcfile_label <- function(x) { + class <- attr(x, "srcfile_class") + label <- paste0("<", class, ">") -# Formatting --- + id <- attr(x, "srcfile_id") + if (!is.null(id)) { + label <- paste0(label, " @", id) + } -format_location <- function(first_line, first_col, last_line, last_col) { - sprintf("%d:%d-%d:%d", first_line, first_col, last_line, last_col) + label } -format_bytes <- function(first_byte, last_byte) { - sprintf("%d-%d", first_byte, last_byte) -} -format_parsed <- function(first_parsed, first_col, last_parsed, last_col) { - sprintf("%d:%d-%d:%d", first_parsed, first_col, last_parsed, last_col) -} +# Srcref information extraction ------------------------------------------------ -#' @export -tree_label.lobstr_srcref_location <- function(x, opts) { - as.character(x) -} +srcref_info <- function(srcref) { + if (!inherits(srcref, "srcref")) { + abort("Expected a srcref object") + } -#' @export -tree_label.srcref <- function(x, opts) { - location <- format_location(x[1], x[5] %||% x[2], x[3], x[6] %||% x[4]) - paste0("") -} + len <- length(srcref) + if (!len %in% c(4, 6, 8)) { + abort(sprintf("Unexpected srcref length: %d", len)) + } -#' @export -tree_label.srcfile <- function(x, opts) { - paste0("<", class(x)[1], ": ", getSrcFilename(x), ">") -} + first_line <- srcref[[1]] + first_byte <- srcref[[2]] + last_line <- srcref[[3]] + last_byte <- srcref[[4]] + first_col <- if (len >= 6) srcref[[5]] else first_byte + last_col <- if (len >= 6) srcref[[6]] else last_byte + first_parsed <- if (len == 8) srcref[[7]] else first_line + last_parsed <- if (len == 8) srcref[[8]] else last_line -#' @export -tree_label.lobstr_srcfile_ref <- function(x, opts) { - # Show reference ID - paste0("@", as.character(x)) -} + info <- list( + location = new_srcref_location(srcref_location(srcref)) + ) -#' @export -tree_label.lobstr_srcref <- function(x, opts) { - type <- srcref_type(x) + # Add byte info if different from columns + if (first_byte != first_col || last_byte != last_col) { + info$bytes <- sprintf("%d-%d", first_byte, last_byte) + } - label <- switch( - type, - "body" = "", - "block" = "<{>", - "srcfile" = tree_label_srcfile(x), - paste0("<", type, ">") - ) + # Add parsed info if different from actual lines + if (first_parsed != first_line || last_parsed != last_line) { + info$parsed <- sprintf( + "%d:%d-%d:%d", + first_parsed, + first_col, + last_parsed, + last_col + ) + } - label + info } -tree_label_srcfile <- function(x) { - class <- srcfile_class(x) - label <- paste0("<", class, ">") - - id <- srcfile_id(x) - if (!is.null(id)) { - label <- paste0(label, " @", id) - } +srcref_location <- function(x) { + first_line <- x[[1]] + last_line <- x[[3]] + first_col <- if (length(x) >= 6) x[[5]] else x[[2]] + last_col <- if (length(x) >= 6) x[[6]] else x[[4]] - label + sprintf("%d:%d-%d:%d", first_line, first_col, last_line, last_col) } -# Helper classes --- +# Helper functions ------------------------------------------------------------- + +has_srcref <- function(x) { + !is.null(attr(x, "srcref")) || + !is.null(attr(x, "wholeSrcref")) || + !is.null(attr(x, "srcfile")) +} -new_lobstr_srcref <- function(x, type = NULL, ..., class = NULL) { - type <- type %||% srcref_type(x) +new_srcref_tree <- function(x, type = NULL, ..., class = NULL) { + type <- type %||% attr(x, "srcref_type") type <- arg_match( type, c( @@ -724,67 +508,14 @@ new_lobstr_srcref <- function(x, type = NULL, ..., class = NULL) { ) } -srcref_type <- function(x) { - attr(x, "srcref_type") -} -srcfile_class <- function(x) { - attr(x, "srcfile_class") -} -srcfile_id <- function(x) { - attr(x, "srcfile_id") -} -max_depth <- function(x) { - attr(x, "max_depth") -} -max_length <- function(x) { - attr(x, "max_length") -} -max_vec_len <- function(x) { - attr(x, "max_vec_len") -} -tree_args <- function(x) { - attr(x, "tree_args") -} - -# The goal of this class is to provide a custom `tree_label()` method that shows -# unquoted locations. This way we don't make it seem the location string is -# literally stored in the srcref object. -new_lobstr_srcref_location <- function(x) { +new_srcref_location <- function(x) { structure(x, class = c("lobstr_srcref_location", "character")) } -new_lobstr_srcfile_ref <- function(id, srcfile_class = "srcfile") { +new_srcfile_ref <- function(id, srcfile_class = "srcfile") { structure( id, srcfile_class = srcfile_class, class = "lobstr_srcfile_ref" ) } - - -# srcref accessors --- - -srcref_first_line <- function(x) { - x[[1]] -} -srcref_first_byte <- function(x) { - x[[2]] -} -srcref_last_line <- function(x) { - x[[3]] -} -srcref_last_byte <- function(x) { - x[[4]] -} -srcref_first_col <- function(x) { - if (length(x) >= 6) x[[5]] else x[[2]] -} -srcref_last_col <- function(x) { - if (length(x) >= 6) x[[6]] else x[[4]] -} -srcref_first_parsed <- function(x) { - if (length(x) == 8) x[[7]] else x[[1]] -} -srcref_last_parsed <- function(x) { - if (length(x) == 8) x[[8]] else x[[3]] -} diff --git a/tests/testthat/_snaps/src-snapshots.md b/tests/testthat/_snaps/src-snapshots.md index 67b7c4b..d726d0d 100644 --- a/tests/testthat/_snaps/src-snapshots.md +++ b/tests/testthat/_snaps/src-snapshots.md @@ -16,17 +16,18 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - └─body(): - ├─attr("wholeSrcref"): - │ ├─location: 1:0-3:1 - │ └─attr("srcfile"): @008 - └─attr("srcref"): - ├─[[1]]: - │ ├─location: 1:29-1:29 - │ └─attr("srcfile"): @008 - └─[[2]]: - ├─location: 2:3-2:7 - └─attr("srcfile"): @008 + └─body(): <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:29-1:29 + │ │ └─attr("srcfile"): @008 + │ └─[[2]]: + │ ├─location: 2:3-2:7 + │ └─attr("srcfile"): @008 + ├─attr("srcfile"): @008 + └─attr("wholeSrcref"): + ├─location: 1:0-3:1 + └─attr("srcfile"): @008 # src() shows multi-statement function @@ -46,26 +47,27 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - └─body(): - ├─attr("wholeSrcref"): - │ ├─location: 1:0-6:1 - │ └─attr("srcfile"): @009 - └─attr("srcref"): - ├─[[1]]: - │ ├─location: 1:27-1:27 - │ └─attr("srcfile"): @009 - ├─[[2]]: - │ ├─location: 2:3-2:12 - │ └─attr("srcfile"): @009 - ├─[[3]]: - │ ├─location: 3:3-3:12 - │ └─attr("srcfile"): @009 - ├─[[4]]: - │ ├─location: 4:3-4:12 - │ └─attr("srcfile"): @009 - └─[[5]]: - ├─location: 5:3-5:3 - └─attr("srcfile"): @009 + └─body(): <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:27-1:27 + │ │ └─attr("srcfile"): @009 + │ ├─[[2]]: + │ │ ├─location: 2:3-2:12 + │ │ └─attr("srcfile"): @009 + │ ├─[[3]]: + │ │ ├─location: 3:3-3:12 + │ │ └─attr("srcfile"): @009 + │ ├─[[4]]: + │ │ ├─location: 4:3-4:12 + │ │ └─attr("srcfile"): @009 + │ └─[[5]]: + │ ├─location: 5:3-5:3 + │ └─attr("srcfile"): @009 + ├─attr("srcfile"): @009 + └─attr("wholeSrcref"): + ├─location: 1:0-6:1 + └─attr("srcfile"): @009 # src() shows quoted function with nested body @@ -74,22 +76,26 @@ scrub_src(src(x)) Output - └─[[3]]: <{> - ├─attr("srcref"): - │ └─[[1]]: - │ ├─location: 1:23-1:23 - │ └─attr("srcfile"): @010 - │ ├─Enc: "unknown" - │ ├─filename: "" - │ ├─fixedNewlines: TRUE - │ ├─isFile: TRUE - │ ├─lines: "x <- quote(function() {})" - │ ├─parseData: 1, 1, 1, ...... - │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - └─attr("wholeSrcref"): - ├─location: 1:0-1:24 - └─attr("srcfile"): @010 + ├─[[3]]: <{> + │ ├─attr("srcref"): + │ │ └─[[1]]: + │ │ ├─location: 1:23-1:23 + │ │ └─attr("srcfile"): @010 + │ │ ├─Enc: "unknown" + │ │ ├─filename: "" + │ │ ├─fixedNewlines: TRUE + │ │ ├─isFile: TRUE + │ │ ├─lines: "x <- quote(function() {})" + │ │ ├─parseData: 1, 1, 1, ...... + │ │ ├─timestamp: "" + │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ ├─attr("srcfile"): @010 + │ └─attr("wholeSrcref"): + │ ├─location: 1:0-1:24 + │ └─attr("srcfile"): @010 + └─[[4]]: + ├─location: 1:12-1:24 + └─attr("srcfile"): @010 # src() shows quoted function body directly @@ -110,6 +116,7 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + ├─attr("srcfile"): @011 └─attr("wholeSrcref"): ├─location: 1:0-1:24 └─attr("srcfile"): @011 @@ -121,25 +128,29 @@ scrub_src(src(x)) Output - └─[[3]]: <{> - ├─attr("srcref"): - │ ├─[[1]]: - │ │ ├─location: 1:27-1:27 - │ │ └─attr("srcfile"): @012 - │ │ ├─Enc: "unknown" - │ │ ├─filename: "" - │ │ ├─fixedNewlines: TRUE - │ │ ├─isFile: TRUE - │ │ ├─lines: "x <- quote(function(a, b) { a +..." - │ │ ├─parseData: 1, 1, 1, ...... - │ │ ├─timestamp: "" - │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - │ └─[[2]]: - │ ├─location: 1:29-1:33 - │ └─attr("srcfile"): @012 - └─attr("wholeSrcref"): - ├─location: 1:0-1:35 - └─attr("srcfile"): @012 + ├─[[3]]: <{> + │ ├─attr("srcref"): + │ │ ├─[[1]]: + │ │ │ ├─location: 1:27-1:27 + │ │ │ └─attr("srcfile"): @012 + │ │ │ ├─Enc: "unknown" + │ │ │ ├─filename: "" + │ │ │ ├─fixedNewlines: TRUE + │ │ │ ├─isFile: TRUE + │ │ │ ├─lines: "x <- quote(function(a, b) { a +..." + │ │ │ ├─parseData: 1, 1, 1, ...... + │ │ │ ├─timestamp: "" + │ │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ │ └─[[2]]: + │ │ ├─location: 1:29-1:33 + │ │ └─attr("srcfile"): @012 + │ ├─attr("srcfile"): @012 + │ └─attr("wholeSrcref"): + │ ├─location: 1:0-1:35 + │ └─attr("srcfile"): @012 + └─[[4]]: + ├─location: 1:12-1:35 + └─attr("srcfile"): @012 # src() shows expression with single element @@ -160,6 +171,7 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + ├─attr("srcfile"): @013 └─attr("wholeSrcref"): ├─location: 1:0-2:0 └─attr("srcfile"): @013 @@ -189,6 +201,7 @@ │ └─[[3]]: │ ├─location: 3:1-3:5 │ └─attr("srcfile"): @014 + ├─attr("srcfile"): @014 └─attr("wholeSrcref"): ├─location: 1:0-4:0 └─attr("srcfile"): @014 @@ -212,6 +225,7 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + ├─attr("srcfile"): @015 ├─attr("wholeSrcref"): │ ├─location: 1:0-4:0 │ └─attr("srcfile"): @015 @@ -223,6 +237,7 @@ │ └─[[2]]: │ ├─location: 2:3-2:3 │ └─attr("srcfile"): @015 + ├─attr("srcfile"): @015 └─attr("wholeSrcref"): ├─location: 1:0-3:1 └─attr("srcfile"): @015 @@ -249,6 +264,7 @@ │ └─[[2]]: │ ├─location: 2:3-2:3 │ └─attr("srcfile"): @016 + ├─attr("srcfile"): @016 └─attr("wholeSrcref"): ├─location: 1:0-3:1 └─attr("srcfile"): @016 @@ -278,6 +294,7 @@ │ └─[[3]]: │ ├─location: 3:3-3:8 │ └─attr("srcfile"): @017 + ├─attr("srcfile"): @017 └─attr("wholeSrcref"): ├─location: 1:0-4:1 └─attr("srcfile"): @017 @@ -348,6 +365,7 @@ │ └─[[2]]: │ ├─location: 1:25-1:25 │ └─attr("srcfile"): @020 + ├─attr("srcfile"): @020 └─attr("wholeSrcref"): ├─location: 1:0-1:27 └─attr("srcfile"): @020 @@ -371,6 +389,7 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + ├─attr("srcfile"): @021 ├─attr("wholeSrcref"): │ ├─location: 1:0-2:0 │ └─attr("srcfile"): @021 @@ -382,6 +401,7 @@ │ └─[[2]]: │ ├─location: 1:7-1:23 │ └─attr("srcfile"): @021 + ├─attr("srcfile"): @021 ├─attr("wholeSrcref"): │ ├─location: 1:0-1:25 │ └─attr("srcfile"): @021 @@ -393,6 +413,7 @@ │ └─[[2]]: │ ├─location: 1:20-1:20 │ └─attr("srcfile"): @021 + ├─attr("srcfile"): @021 └─attr("wholeSrcref"): ├─location: 1:0-1:22 └─attr("srcfile"): @021 @@ -424,6 +445,7 @@ │ └─[[2]]: │ ├─location: 1:23-1:39 │ └─attr("srcfile"): @022 + ├─attr("srcfile"): @022 ├─attr("wholeSrcref"): │ ├─location: 1:0-1:41 │ └─attr("srcfile"): @022 @@ -435,6 +457,7 @@ │ └─[[2]]: │ ├─location: 1:36-1:36 │ └─attr("srcfile"): @022 + ├─attr("srcfile"): @022 └─attr("wholeSrcref"): ├─location: 1:0-1:38 └─attr("srcfile"): @022 @@ -457,17 +480,18 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - └─body(): - ├─attr("wholeSrcref"): - │ ├─location: 1:0-3:1 - │ └─attr("srcfile"): @027 - └─attr("srcref"): - ├─[[1]]: - │ ├─location: 1:29-1:29 - │ └─attr("srcfile"): @027 - └─[[2]]: - ├─location: 2:3-2:7 - └─attr("srcfile"): @027 + └─body(): <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:29-1:29 + │ │ └─attr("srcfile"): @027 + │ └─[[2]]: + │ ├─location: 2:3-2:7 + │ └─attr("srcfile"): @027 + ├─attr("srcfile"): @027 + └─attr("wholeSrcref"): + ├─location: 1:0-3:1 + └─attr("srcfile"): @027 # src() shows many duplicate srcfiles in nested expression @@ -488,6 +512,7 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + ├─attr("srcfile"): @028 ├─attr("wholeSrcref"): │ ├─location: 1:0-5:0 │ └─attr("srcfile"): @028 @@ -502,6 +527,7 @@ │ └─[[3]]: │ ├─location: 3:3-3:3 │ └─attr("srcfile"): @028 + ├─attr("srcfile"): @028 └─attr("wholeSrcref"): ├─location: 1:0-4:1 └─attr("srcfile"): @028 @@ -525,6 +551,7 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + ├─attr("srcfile"): @029 └─attr("wholeSrcref"): ├─location: 1:0-1:2 └─attr("srcfile"): @029 @@ -547,17 +574,18 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - └─body(): - ├─attr("wholeSrcref"): - │ ├─location: 1:0-1:24 - │ └─attr("srcfile"): @030 - └─attr("srcref"): - ├─[[1]]: - │ ├─location: 1:17-1:17 - │ └─attr("srcfile"): @030 - └─[[2]]: - ├─location: 1:19-1:22 - └─attr("srcfile"): @030 + └─body(): <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:17-1:17 + │ │ └─attr("srcfile"): @030 + │ └─[[2]]: + │ ├─location: 1:19-1:22 + │ └─attr("srcfile"): @030 + ├─attr("srcfile"): @030 + └─attr("wholeSrcref"): + ├─location: 1:0-1:24 + └─attr("srcfile"): @030 # src() handles if statement with blocks @@ -578,6 +606,7 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + ├─attr("srcfile"): @031 ├─attr("wholeSrcref"): │ ├─location: 1:0-2:0 │ └─attr("srcfile"): @031 @@ -589,6 +618,7 @@ │ │ └─[[2]]: │ │ ├─location: 1:13-1:13 │ │ └─attr("srcfile"): @031 + │ ├─attr("srcfile"): @031 │ └─attr("wholeSrcref"): │ ├─location: 1:0-1:15 │ └─attr("srcfile"): @031 @@ -600,6 +630,7 @@ │ └─[[2]]: │ ├─location: 1:24-1:24 │ └─attr("srcfile"): @031 + ├─attr("srcfile"): @031 └─attr("wholeSrcref"): ├─location: 1:0-1:26 └─attr("srcfile"): @031 @@ -650,6 +681,7 @@ │ └─[[10]]: │ ├─location: 10:1-10:1 │ └─attr("srcfile"): @032 + ├─attr("srcfile"): @032 └─attr("wholeSrcref"): ├─location: 1:0-11:0 └─attr("srcfile"): @032 @@ -672,17 +704,18 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - └─body(): - ├─attr("wholeSrcref"): - │ ├─location: 1:0-3:1 - │ └─attr("srcfile"): @033 - └─attr("srcref"): - ├─[[1]]: - │ ├─location: 1:29-1:29 - │ └─attr("srcfile"): @033 - └─[[2]]: - ├─location: 2:3-2:7 - └─attr("srcfile"): @033 + └─body(): <{> + ├─attr("srcref"): + │ ├─[[1]]: + │ │ ├─location: 1:29-1:29 + │ │ └─attr("srcfile"): @033 + │ └─[[2]]: + │ ├─location: 2:3-2:7 + │ └─attr("srcfile"): @033 + ├─attr("srcfile"): @033 + └─attr("wholeSrcref"): + ├─location: 1:0-3:1 + └─attr("srcfile"): @033 # src() shows expression with multiple nested blocks @@ -703,6 +736,7 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + ├─attr("srcfile"): @034 ├─attr("wholeSrcref"): │ ├─location: 1:0-9:0 │ └─attr("srcfile"): @034 @@ -717,6 +751,7 @@ │ └─[[3]]: │ ├─location: 5:3-7:3 │ └─attr("srcfile"): @034 + ├─attr("srcfile"): @034 ├─attr("wholeSrcref"): │ ├─location: 1:0-8:1 │ └─attr("srcfile"): @034 @@ -728,6 +763,7 @@ │ │ └─[[2]]: │ │ ├─location: 3:5-3:5 │ │ └─attr("srcfile"): @034 + │ ├─attr("srcfile"): @034 │ └─attr("wholeSrcref"): │ ├─location: 1:0-4:3 │ └─attr("srcfile"): @034 @@ -739,6 +775,7 @@ │ └─[[2]]: │ ├─location: 6:5-6:5 │ └─attr("srcfile"): @034 + ├─attr("srcfile"): @034 └─attr("wholeSrcref"): ├─location: 1:0-7:3 └─attr("srcfile"): @034 @@ -761,10 +798,7 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - └─body(): - ├─attr("wholeSrcref"): - │ ├─location: 1:0-5:1 - │ └─attr("srcfile"): @035 + └─body(): <{> ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:18-1:18 @@ -772,6 +806,10 @@ │ └─[[2]]: │ ├─location: 2:3-4:3 │ └─attr("srcfile"): @035 + ├─attr("srcfile"): @035 + ├─attr("wholeSrcref"): + │ ├─location: 1:0-5:1 + │ └─attr("srcfile"): @035 └─[[2]][[3]]: <{> ├─attr("srcref"): │ ├─[[1]]: @@ -780,6 +818,7 @@ │ └─[[2]]: │ ├─location: 3:5-3:5 │ └─attr("srcfile"): @035 + ├─attr("srcfile"): @035 └─attr("wholeSrcref"): ├─location: 1:0-4:3 └─attr("srcfile"): @035 diff --git a/tests/testthat/test-src.R b/tests/testthat/test-src.R index dfc6d9e..534a2e2 100644 --- a/tests/testthat/test-src.R +++ b/tests/testthat/test-src.R @@ -15,14 +15,8 @@ test_that("extract_srcref_info handles 4-element srcrefs", { srcfile = attr(srcref, "srcfile") ) - info <- lobstr:::extract_srcref_info(srcref_4) - - expect_equal(info$first_line, 1) - expect_equal(info$first_byte, 1) - expect_equal(info$last_line, 1) - expect_equal(info$last_byte, 5) - expect_equal(info$first_col, 1) # Should equal byte for 4-element - expect_equal(info$last_col, 5) # Should equal byte for 4-element + info <- lobstr:::srcref_info(srcref_4) + expect_s3_class(info$location, "lobstr_srcref_location") expect_equal(as.character(info$location), "1:1-1:5") }) @@ -38,12 +32,8 @@ test_that("extract_srcref_info handles 6-element srcrefs", { srcfile = attr(srcref_base, "srcfile") ) - info <- lobstr:::extract_srcref_info(srcref_6) + info <- lobstr:::srcref_info(srcref_6) - expect_equal(info$first_line, 1) - expect_equal(info$first_col, 1) - expect_equal(info$last_line, 1) - expect_equal(info$last_col, 5) expect_s3_class(info$location, "lobstr_srcref_location") expect_equal(as.character(info$location), "1:1-1:5") }) @@ -53,10 +43,8 @@ test_that("extract_srcref_info handles 8-element srcrefs", { srcref <- attr(expr, "srcref")[[1]] # Most modern srcrefs are 8-element - info <- lobstr:::extract_srcref_info(srcref) + info <- lobstr:::srcref_info(srcref) - expect_type(info$first_line, "integer") - expect_type(info$last_line, "integer") expect_s3_class(info$location, "lobstr_srcref_location") expect_match(as.character(info$location), "\\d+:\\d+-\\d+:\\d+") }) @@ -65,10 +53,8 @@ test_that("extract_srcref_info shows encoding details when requested", { expr <- parse(text = "x + 1", keep.source = TRUE) srcref <- attr(expr, "srcref")[[1]] - info <- lobstr:::extract_srcref_info(srcref) + info <- lobstr:::srcref_info(srcref) - # For ASCII, bytes should equal columns, so these might be NULL - # But the function should at least check expect_true("location" %in% names(info)) }) @@ -77,74 +63,67 @@ test_that("extract_srcref_info errors on invalid srcref length", { bad_srcref <- structure(c(1L, 2L, 3L), class = "srcref") expect_error( - lobstr:::extract_srcref_info(bad_srcref), + lobstr:::srcref_info(bad_srcref), "Unexpected srcref length" ) }) -test_that("extract_srcfile_info handles srcfilecopy", { +test_that("srcfile_node handles srcfilecopy", { expr <- parse(text = "x + 1", keep.source = TRUE) srcfile <- attr(attr(expr, "srcref")[[1]], "srcfile") + srcref <- attr(expr, "srcref")[[1]] seen_srcfiles <- new.env(parent = emptyenv()) - info <- lobstr:::extract_srcfile_info(srcfile, seen_srcfiles = seen_srcfiles) + info <- lobstr:::srcfile_node(srcfile, srcref, 3, seen_srcfiles) expect_equal(attr(info, "srcfile_class"), class(srcfile)[1]) expect_type(info$filename, "character") expect_type(info$Enc, "character") }) -test_that("extract_srcfile_info handles NULL gracefully", { +test_that("srcfile_node handles NULL gracefully", { seen_srcfiles <- new.env(parent = emptyenv()) - info <- lobstr:::extract_srcfile_info(NULL, seen_srcfiles = seen_srcfiles) + info <- lobstr:::srcfile_node(NULL, NULL, 3, seen_srcfiles) expect_null(info) }) -test_that("extract_lines_from_srcfile extracts from srcfilecopy", { +test_that("srcfile_lines extracts from srcfilecopy", { code <- c("x <- 1", "y <- 2", "z <- 3") expr <- parse(text = code, keep.source = TRUE) srcref <- attr(expr, "srcref")[[1]] srcfile <- attr(srcref, "srcfile") - snippet <- lobstr:::extract_lines_from_srcfile(srcfile, srcref, max_lines = 3) + snippet <- lobstr:::srcfile_lines(srcfile, srcref, max_lines = 3) expect_type(snippet, "character") expect_true(length(snippet) >= 1) }) -test_that("extract_lines_from_srcfile respects max_lines", { +test_that("srcfile_lines respects max_lines", { code <- c("x <- 1", "y <- 2", "z <- 3", "a <- 4", "b <- 5") expr <- parse(text = paste(code, collapse = "\n"), keep.source = TRUE) - # Create a srcref spanning multiple lines srcfile <- attr(attr(expr, "srcref")[[1]], "srcfile") - # Create a fake srcref for lines 1-5 srcref <- structure( c(1L, 1L, 5L, 10L, 1L, 10L, 1L, 5L), class = "srcref", srcfile = srcfile ) - snippet <- lobstr:::extract_lines_from_srcfile(srcfile, srcref, max_lines = 2) + snippet <- lobstr:::srcfile_lines(srcfile, srcref, max_lines = 2) expect_true(length(snippet) <= 2) }) -test_that("format_location works correctly", { - loc <- lobstr:::format_location(1L, 5L, 3L, 20L) +test_that("srcref_location works correctly", { + srcref <- structure( + c(1L, 5L, 3L, 20L, 5L, 20L, 1L, 3L), + class = "srcref" + ) + loc <- lobstr:::srcref_location(srcref) expect_equal(loc, "1:5-3:20") }) -test_that("format_bytes works correctly", { - bytes <- lobstr:::format_bytes(10L, 50L) - expect_equal(bytes, "10-50") -}) - -test_that("format_parsed works correctly", { - parsed <- lobstr:::format_parsed(1L, 1L, 3L, 10L) - expect_equal(parsed, "1:1-3:10") -}) - # Integration tests for src() -------------------------------------------------- test_that("src works with functions with source references", { @@ -192,7 +171,7 @@ test_that("src works for objects without srcrefs", { expect_null(src(fun)) expect_null(src(new.env())) expect_null(src(list())) - expect_null(src(base::list)) + expect_null(src(sum)) }) test_that("src respects max_lines_preview parameter", { @@ -288,18 +267,19 @@ test_that("src handles functions with only wholeSrcref (no srcref attr)", { expect_true("attr(\"wholeSrcref\")" %in% names(result$`body()`)) }) -test_that("extract_lines_from_srcfile handles missing files gracefully", { +test_that("srcfile_lines handles missing files gracefully", { expr <- parse(text = "x + 1", keep.source = TRUE) srcref <- attr(expr, "srcref")[[1]] srcfile <- attr(srcref, "srcfile") # Point to a non-existent file - attr(srcfile, "filename") <- "nonexistent_file.R" + srcfile$filename <- "nonexistent_file.R" - # Should return empty or handle gracefully - snippet <- lobstr:::extract_lines_from_srcfile(srcfile, srcref, max_lines = 3) + snippet <- lobstr:::srcfile_lines(srcfile, srcref, max_lines = 3) expect_type(snippet, "character") + # May still have cached lines, so just check it's character + expect_true(length(snippet) >= 0) }) # Srcfile deduplication tests -------------------------------------------------- @@ -461,7 +441,7 @@ test_that("srcfile deduplication - reference notation displays correctly", { test_that("lobstr_srcfile_ref class has correct structure", { # Create a reference object directly - ref <- lobstr:::new_lobstr_srcfile_ref("abc123", "srcfilecopy") + ref <- lobstr:::new_srcfile_ref("abc123", "srcfilecopy") expect_s3_class(ref, "lobstr_srcfile_ref") expect_equal(as.character(ref), "abc123") From 8271e0a7a5adb30bdb7614eeda78e828bfc99e5c Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Fri, 14 Nov 2025 14:29:24 +0100 Subject: [PATCH 03/28] More space around locations --- R/src.R | 10 +- tests/testthat/_snaps/src-snapshots.md | 528 +++++++++++++------------ tests/testthat/test-src-snapshots.R | 30 +- tests/testthat/test-src.R | 10 +- 4 files changed, 312 insertions(+), 266 deletions(-) diff --git a/R/src.R b/R/src.R index 0d1fe84..9a247d9 100644 --- a/R/src.R +++ b/R/src.R @@ -448,18 +448,18 @@ srcref_info <- function(srcref) { # Add byte info if different from columns if (first_byte != first_col || last_byte != last_col) { - info$bytes <- sprintf("%d-%d", first_byte, last_byte) + info$bytes <- sprintf("%d - %d", first_byte, last_byte) } # Add parsed info if different from actual lines if (first_parsed != first_line || last_parsed != last_line) { - info$parsed <- sprintf( - "%d:%d-%d:%d", + info$parsed <- new_srcref_location(sprintf( + "%d:%d - %d:%d", first_parsed, first_col, last_parsed, last_col - ) + )) } info @@ -471,7 +471,7 @@ srcref_location <- function(x) { first_col <- if (length(x) >= 6) x[[5]] else x[[2]] last_col <- if (length(x) >= 6) x[[6]] else x[[4]] - sprintf("%d:%d-%d:%d", first_line, first_col, last_line, last_col) + sprintf("%d:%d - %d:%d", first_line, first_col, last_line, last_col) } diff --git a/tests/testthat/_snaps/src-snapshots.md b/tests/testthat/_snaps/src-snapshots.md index d726d0d..c37f56b 100644 --- a/tests/testthat/_snaps/src-snapshots.md +++ b/tests/testthat/_snaps/src-snapshots.md @@ -6,7 +6,7 @@ Output ├─attr("srcref"): - │ ├─location: 1:14-3:1 + │ ├─location: 1:14 - 3:1 │ └─attr("srcfile"): @008 │ ├─Enc: "unknown" │ ├─filename: "" @@ -19,14 +19,14 @@ └─body(): <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:29-1:29 + │ │ ├─location: 1:29 - 1:29 │ │ └─attr("srcfile"): @008 │ └─[[2]]: - │ ├─location: 2:3-2:7 + │ ├─location: 2:3 - 2:7 │ └─attr("srcfile"): @008 ├─attr("srcfile"): @008 └─attr("wholeSrcref"): - ├─location: 1:0-3:1 + ├─location: 1:0 - 3:1 └─attr("srcfile"): @008 # src() shows multi-statement function @@ -37,7 +37,7 @@ Output ├─attr("srcref"): - │ ├─location: 1:15-6:1 + │ ├─location: 1:15 - 6:1 │ └─attr("srcfile"): @009 │ ├─Enc: "unknown" │ ├─filename: "" @@ -50,23 +50,23 @@ └─body(): <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:27-1:27 + │ │ ├─location: 1:27 - 1:27 │ │ └─attr("srcfile"): @009 │ ├─[[2]]: - │ │ ├─location: 2:3-2:12 + │ │ ├─location: 2:3 - 2:12 │ │ └─attr("srcfile"): @009 │ ├─[[3]]: - │ │ ├─location: 3:3-3:12 + │ │ ├─location: 3:3 - 3:12 │ │ └─attr("srcfile"): @009 │ ├─[[4]]: - │ │ ├─location: 4:3-4:12 + │ │ ├─location: 4:3 - 4:12 │ │ └─attr("srcfile"): @009 │ └─[[5]]: - │ ├─location: 5:3-5:3 + │ ├─location: 5:3 - 5:3 │ └─attr("srcfile"): @009 ├─attr("srcfile"): @009 └─attr("wholeSrcref"): - ├─location: 1:0-6:1 + ├─location: 1:0 - 6:1 └─attr("srcfile"): @009 # src() shows quoted function with nested body @@ -79,7 +79,7 @@ ├─[[3]]: <{> │ ├─attr("srcref"): │ │ └─[[1]]: - │ │ ├─location: 1:23-1:23 + │ │ ├─location: 1:23 - 1:23 │ │ └─attr("srcfile"): @010 │ │ ├─Enc: "unknown" │ │ ├─filename: "" @@ -91,10 +91,10 @@ │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." │ ├─attr("srcfile"): @010 │ └─attr("wholeSrcref"): - │ ├─location: 1:0-1:24 + │ ├─location: 1:0 - 1:24 │ └─attr("srcfile"): @010 └─[[4]]: - ├─location: 1:12-1:24 + ├─location: 1:12 - 1:24 └─attr("srcfile"): @010 # src() shows quoted function body directly @@ -106,7 +106,7 @@ <{> ├─attr("srcref"): │ └─[[1]]: - │ ├─location: 1:23-1:23 + │ ├─location: 1:23 - 1:23 │ └─attr("srcfile"): @011 │ ├─Enc: "unknown" │ ├─filename: "" @@ -118,40 +118,58 @@ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." ├─attr("srcfile"): @011 └─attr("wholeSrcref"): - ├─location: 1:0-1:24 + ├─location: 1:0 - 1:24 └─attr("srcfile"): @011 # src() shows quoted function with arguments Code - with_srcref("x <- quote(function(a, b) { a + b })") + with_srcref("x <- quote(function(a, b) {})") scrub_src(src(x)) Output ├─[[3]]: <{> │ ├─attr("srcref"): - │ │ ├─[[1]]: - │ │ │ ├─location: 1:27-1:27 - │ │ │ └─attr("srcfile"): @012 - │ │ │ ├─Enc: "unknown" - │ │ │ ├─filename: "" - │ │ │ ├─fixedNewlines: TRUE - │ │ │ ├─isFile: TRUE - │ │ │ ├─lines: "x <- quote(function(a, b) { a +..." - │ │ │ ├─parseData: 1, 1, 1, ...... - │ │ │ ├─timestamp: "" - │ │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - │ │ └─[[2]]: - │ │ ├─location: 1:29-1:33 - │ │ └─attr("srcfile"): @012 + │ │ └─[[1]]: + │ │ ├─location: 1:27 - 1:27 + │ │ └─attr("srcfile"): @012 + │ │ ├─Enc: "unknown" + │ │ ├─filename: "" + │ │ ├─fixedNewlines: TRUE + │ │ ├─isFile: TRUE + │ │ ├─lines: "x <- quote(function(a, b) {})" + │ │ ├─parseData: 1, 1, 1, ...... + │ │ ├─timestamp: "" + │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." │ ├─attr("srcfile"): @012 │ └─attr("wholeSrcref"): - │ ├─location: 1:0-1:35 + │ ├─location: 1:0 - 1:28 │ └─attr("srcfile"): @012 └─[[4]]: - ├─location: 1:12-1:35 + ├─location: 1:12 - 1:28 └─attr("srcfile"): @012 +# src() shows srcref with parsed field when positions differ + + Code + srcfile <- srcfilecopy("test.R", c("x <- function() {", + " # A long comment that spans", " # multiple lines", " y <- 1", "}")) + synthetic_srcref <- structure(c(2L, 3L, 4L, 8L, 3L, 8L, 1L, 5L), class = "srcref", + srcfile = srcfile) + scrub_src(src(synthetic_srcref)) + Output + + ├─location: 2:3 - 4:8 + ├─parsed: 1:3 - 5:8 + └─attr("srcfile"): @013 + ├─Enc: "unknown" + ├─filename: "" + ├─fixedNewlines: TRUE + ├─isFile: FALSE + ├─lines: "x <- functio...", " # A long c...", " # multiple...", ... + ├─timestamp: "" + └─wd: "/Users/lionel/Sync/Projects/R/r-..." + # src() shows expression with single element Code @@ -161,8 +179,8 @@ ├─attr("srcref"): │ └─[[1]]: - │ ├─location: 1:1-1:5 - │ └─attr("srcfile"): @013 + │ ├─location: 1:1 - 1:5 + │ └─attr("srcfile"): @014 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -171,10 +189,10 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @013 + ├─attr("srcfile"): @014 └─attr("wholeSrcref"): - ├─location: 1:0-2:0 - └─attr("srcfile"): @013 + ├─location: 1:0 - 2:0 + └─attr("srcfile"): @014 # src() shows expression with multiple elements @@ -185,8 +203,8 @@ ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:1-1:5 - │ │ └─attr("srcfile"): @014 + │ │ ├─location: 1:1 - 1:5 + │ │ └─attr("srcfile"): @015 │ │ ├─Enc: "unknown" │ │ ├─filename: "" │ │ ├─fixedNewlines: TRUE @@ -196,15 +214,15 @@ │ │ ├─timestamp: "" │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." │ ├─[[2]]: - │ │ ├─location: 2:1-2:5 - │ │ └─attr("srcfile"): @014 + │ │ ├─location: 2:1 - 2:5 + │ │ └─attr("srcfile"): @015 │ └─[[3]]: - │ ├─location: 3:1-3:5 - │ └─attr("srcfile"): @014 - ├─attr("srcfile"): @014 + │ ├─location: 3:1 - 3:5 + │ └─attr("srcfile"): @015 + ├─attr("srcfile"): @015 └─attr("wholeSrcref"): - ├─location: 1:0-4:0 - └─attr("srcfile"): @014 + ├─location: 1:0 - 4:0 + └─attr("srcfile"): @015 # src() shows expression with nested block and wholeSrcref @@ -215,8 +233,8 @@ ├─attr("srcref"): │ └─[[1]]: - │ ├─location: 1:1-3:1 - │ └─attr("srcfile"): @015 + │ ├─location: 1:1 - 3:1 + │ └─attr("srcfile"): @016 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -225,22 +243,22 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @015 + ├─attr("srcfile"): @016 ├─attr("wholeSrcref"): - │ ├─location: 1:0-4:0 - │ └─attr("srcfile"): @015 + │ ├─location: 1:0 - 4:0 + │ └─attr("srcfile"): @016 └─[[1]]: <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:1-1:1 - │ │ └─attr("srcfile"): @015 + │ │ ├─location: 1:1 - 1:1 + │ │ └─attr("srcfile"): @016 │ └─[[2]]: - │ ├─location: 2:3-2:3 - │ └─attr("srcfile"): @015 - ├─attr("srcfile"): @015 + │ ├─location: 2:3 - 2:3 + │ └─attr("srcfile"): @016 + ├─attr("srcfile"): @016 └─attr("wholeSrcref"): - ├─location: 1:0-3:1 - └─attr("srcfile"): @015 + ├─location: 1:0 - 3:1 + └─attr("srcfile"): @016 # src() shows nested block element directly @@ -251,8 +269,8 @@ <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:1-1:1 - │ │ └─attr("srcfile"): @016 + │ │ ├─location: 1:1 - 1:1 + │ │ └─attr("srcfile"): @017 │ │ ├─Enc: "unknown" │ │ ├─filename: "" │ │ ├─fixedNewlines: TRUE @@ -262,12 +280,12 @@ │ │ ├─timestamp: "" │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." │ └─[[2]]: - │ ├─location: 2:3-2:3 - │ └─attr("srcfile"): @016 - ├─attr("srcfile"): @016 + │ ├─location: 2:3 - 2:3 + │ └─attr("srcfile"): @017 + ├─attr("srcfile"): @017 └─attr("wholeSrcref"): - ├─location: 1:0-3:1 - └─attr("srcfile"): @016 + ├─location: 1:0 - 3:1 + └─attr("srcfile"): @017 # src() shows block with srcref list and wholeSrcref @@ -278,8 +296,8 @@ <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:1-1:1 - │ │ └─attr("srcfile"): @017 + │ │ ├─location: 1:1 - 1:1 + │ │ └─attr("srcfile"): @018 │ │ ├─Enc: "unknown" │ │ ├─filename: "" │ │ ├─fixedNewlines: TRUE @@ -289,15 +307,15 @@ │ │ ├─timestamp: "" │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." │ ├─[[2]]: - │ │ ├─location: 2:3-2:8 - │ │ └─attr("srcfile"): @017 + │ │ ├─location: 2:3 - 2:8 + │ │ └─attr("srcfile"): @018 │ └─[[3]]: - │ ├─location: 3:3-3:8 - │ └─attr("srcfile"): @017 - ├─attr("srcfile"): @017 + │ ├─location: 3:3 - 3:8 + │ └─attr("srcfile"): @018 + ├─attr("srcfile"): @018 └─attr("wholeSrcref"): - ├─location: 1:0-4:1 - └─attr("srcfile"): @017 + ├─location: 1:0 - 4:1 + └─attr("srcfile"): @018 # src() shows single srcref @@ -307,8 +325,8 @@ scrub_src(src(sr)) Output - ├─location: 1:1-1:5 - └─attr("srcfile"): @018 + ├─location: 1:1 - 1:5 + └─attr("srcfile"): @019 ├─Enc: "unknown" ├─filename: "" ├─fixedNewlines: TRUE @@ -329,8 +347,8 @@ ├─count: 2 └─srcrefs: ├─ - │ ├─location: 1:1-1:5 - │ └─attr("srcfile"): @019 + │ ├─location: 1:1 - 1:5 + │ └─attr("srcfile"): @020 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -340,8 +358,8 @@ │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." └─ - ├─location: 2:1-2:5 - └─attr("srcfile"): @019 + ├─location: 2:1 - 2:5 + └─attr("srcfile"): @020 # src() reveals srcref list structure with index notation @@ -352,8 +370,8 @@ <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:23-1:23 - │ │ └─attr("srcfile"): @020 + │ │ ├─location: 1:23 - 1:23 + │ │ └─attr("srcfile"): @021 │ │ ├─Enc: "unknown" │ │ ├─filename: "" │ │ ├─fixedNewlines: TRUE @@ -363,12 +381,12 @@ │ │ ├─timestamp: "" │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." │ └─[[2]]: - │ ├─location: 1:25-1:25 - │ └─attr("srcfile"): @020 - ├─attr("srcfile"): @020 + │ ├─location: 1:25 - 1:25 + │ └─attr("srcfile"): @021 + ├─attr("srcfile"): @021 └─attr("wholeSrcref"): - ├─location: 1:0-1:27 - └─attr("srcfile"): @020 + ├─location: 1:0 - 1:27 + └─attr("srcfile"): @021 # src() handles srcrefs nested in language calls @@ -379,8 +397,8 @@ ├─attr("srcref"): │ └─[[1]]: - │ ├─location: 1:1-1:26 - │ └─attr("srcfile"): @021 + │ ├─location: 1:1 - 1:26 + │ └─attr("srcfile"): @022 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -389,34 +407,34 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @021 + ├─attr("srcfile"): @022 ├─attr("wholeSrcref"): - │ ├─location: 1:0-2:0 - │ └─attr("srcfile"): @021 + │ ├─location: 1:0 - 2:0 + │ └─attr("srcfile"): @022 └─[[1]][[2]]: <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:5-1:5 - │ │ └─attr("srcfile"): @021 + │ │ ├─location: 1:5 - 1:5 + │ │ └─attr("srcfile"): @022 │ └─[[2]]: - │ ├─location: 1:7-1:23 - │ └─attr("srcfile"): @021 - ├─attr("srcfile"): @021 + │ ├─location: 1:7 - 1:23 + │ └─attr("srcfile"): @022 + ├─attr("srcfile"): @022 ├─attr("wholeSrcref"): - │ ├─location: 1:0-1:25 - │ └─attr("srcfile"): @021 + │ ├─location: 1:0 - 1:25 + │ └─attr("srcfile"): @022 └─[[2]][[3]][[2]]: <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:18-1:18 - │ │ └─attr("srcfile"): @021 + │ │ ├─location: 1:18 - 1:18 + │ │ └─attr("srcfile"): @022 │ └─[[2]]: - │ ├─location: 1:20-1:20 - │ └─attr("srcfile"): @021 - ├─attr("srcfile"): @021 + │ ├─location: 1:20 - 1:20 + │ └─attr("srcfile"): @022 + ├─attr("srcfile"): @022 └─attr("wholeSrcref"): - ├─location: 1:0-1:22 - └─attr("srcfile"): @021 + ├─location: 1:0 - 1:22 + └─attr("srcfile"): @022 # src() handles srcrefs nested in function bodies @@ -426,8 +444,8 @@ Output ├─attr("srcref"): - │ ├─location: 1:6-1:42 - │ └─attr("srcfile"): @022 + │ ├─location: 1:6 - 1:42 + │ └─attr("srcfile"): @023 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -440,27 +458,27 @@ └─[[2]]: <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:21-1:21 - │ │ └─attr("srcfile"): @022 + │ │ ├─location: 1:21 - 1:21 + │ │ └─attr("srcfile"): @023 │ └─[[2]]: - │ ├─location: 1:23-1:39 - │ └─attr("srcfile"): @022 - ├─attr("srcfile"): @022 + │ ├─location: 1:23 - 1:39 + │ └─attr("srcfile"): @023 + ├─attr("srcfile"): @023 ├─attr("wholeSrcref"): - │ ├─location: 1:0-1:41 - │ └─attr("srcfile"): @022 + │ ├─location: 1:0 - 1:41 + │ └─attr("srcfile"): @023 └─[[2]][[3]][[2]]: <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:34-1:34 - │ │ └─attr("srcfile"): @022 + │ │ ├─location: 1:34 - 1:34 + │ │ └─attr("srcfile"): @023 │ └─[[2]]: - │ ├─location: 1:36-1:36 - │ └─attr("srcfile"): @022 - ├─attr("srcfile"): @022 + │ ├─location: 1:36 - 1:36 + │ └─attr("srcfile"): @023 + ├─attr("srcfile"): @023 └─attr("wholeSrcref"): - ├─location: 1:0-1:38 - └─attr("srcfile"): @022 + ├─location: 1:0 - 1:38 + └─attr("srcfile"): @023 # src() currently shows duplicate srcfile objects @@ -470,8 +488,8 @@ Output ├─attr("srcref"): - │ ├─location: 1:14-3:1 - │ └─attr("srcfile"): @027 + │ ├─location: 1:14 - 3:1 + │ └─attr("srcfile"): @028 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -483,15 +501,15 @@ └─body(): <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:29-1:29 - │ │ └─attr("srcfile"): @027 + │ │ ├─location: 1:29 - 1:29 + │ │ └─attr("srcfile"): @028 │ └─[[2]]: - │ ├─location: 2:3-2:7 - │ └─attr("srcfile"): @027 - ├─attr("srcfile"): @027 + │ ├─location: 2:3 - 2:7 + │ └─attr("srcfile"): @028 + ├─attr("srcfile"): @028 └─attr("wholeSrcref"): - ├─location: 1:0-3:1 - └─attr("srcfile"): @027 + ├─location: 1:0 - 3:1 + └─attr("srcfile"): @028 # src() shows many duplicate srcfiles in nested expression @@ -502,8 +520,8 @@ ├─attr("srcref"): │ └─[[1]]: - │ ├─location: 1:1-4:1 - │ └─attr("srcfile"): @028 + │ ├─location: 1:1 - 4:1 + │ └─attr("srcfile"): @029 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -512,25 +530,25 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @028 + ├─attr("srcfile"): @029 ├─attr("wholeSrcref"): - │ ├─location: 1:0-5:0 - │ └─attr("srcfile"): @028 + │ ├─location: 1:0 - 5:0 + │ └─attr("srcfile"): @029 └─[[1]]: <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:1-1:1 - │ │ └─attr("srcfile"): @028 + │ │ ├─location: 1:1 - 1:1 + │ │ └─attr("srcfile"): @029 │ ├─[[2]]: - │ │ ├─location: 2:3-2:3 - │ │ └─attr("srcfile"): @028 + │ │ ├─location: 2:3 - 2:3 + │ │ └─attr("srcfile"): @029 │ └─[[3]]: - │ ├─location: 3:3-3:3 - │ └─attr("srcfile"): @028 - ├─attr("srcfile"): @028 + │ ├─location: 3:3 - 3:3 + │ └─attr("srcfile"): @029 + ├─attr("srcfile"): @029 └─attr("wholeSrcref"): - ├─location: 1:0-4:1 - └─attr("srcfile"): @028 + ├─location: 1:0 - 4:1 + └─attr("srcfile"): @029 # src() handles empty block @@ -541,8 +559,8 @@ <{> ├─attr("srcref"): │ └─[[1]]: - │ ├─location: 1:1-1:1 - │ └─attr("srcfile"): @029 + │ ├─location: 1:1 - 1:1 + │ └─attr("srcfile"): @030 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -551,10 +569,10 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @029 + ├─attr("srcfile"): @030 └─attr("wholeSrcref"): - ├─location: 1:0-1:2 - └─attr("srcfile"): @029 + ├─location: 1:0 - 1:2 + └─attr("srcfile"): @030 # src() handles function without arguments @@ -564,8 +582,8 @@ Output ├─attr("srcref"): - │ ├─location: 1:6-1:24 - │ └─attr("srcfile"): @030 + │ ├─location: 1:6 - 1:24 + │ └─attr("srcfile"): @031 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -577,15 +595,15 @@ └─body(): <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:17-1:17 - │ │ └─attr("srcfile"): @030 + │ │ ├─location: 1:17 - 1:17 + │ │ └─attr("srcfile"): @031 │ └─[[2]]: - │ ├─location: 1:19-1:22 - │ └─attr("srcfile"): @030 - ├─attr("srcfile"): @030 + │ ├─location: 1:19 - 1:22 + │ └─attr("srcfile"): @031 + ├─attr("srcfile"): @031 └─attr("wholeSrcref"): - ├─location: 1:0-1:24 - └─attr("srcfile"): @030 + ├─location: 1:0 - 1:24 + └─attr("srcfile"): @031 # src() handles if statement with blocks @@ -596,8 +614,8 @@ ├─attr("srcref"): │ └─[[1]]: - │ ├─location: 1:1-1:26 - │ └─attr("srcfile"): @031 + │ ├─location: 1:1 - 1:26 + │ └─attr("srcfile"): @032 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -606,34 +624,34 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @031 + ├─attr("srcfile"): @032 ├─attr("wholeSrcref"): - │ ├─location: 1:0-2:0 - │ └─attr("srcfile"): @031 + │ ├─location: 1:0 - 2:0 + │ └─attr("srcfile"): @032 ├─[[1]][[3]]: <{> │ ├─attr("srcref"): │ │ ├─[[1]]: - │ │ │ ├─location: 1:11-1:11 - │ │ │ └─attr("srcfile"): @031 + │ │ │ ├─location: 1:11 - 1:11 + │ │ │ └─attr("srcfile"): @032 │ │ └─[[2]]: - │ │ ├─location: 1:13-1:13 - │ │ └─attr("srcfile"): @031 - │ ├─attr("srcfile"): @031 + │ │ ├─location: 1:13 - 1:13 + │ │ └─attr("srcfile"): @032 + │ ├─attr("srcfile"): @032 │ └─attr("wholeSrcref"): - │ ├─location: 1:0-1:15 - │ └─attr("srcfile"): @031 + │ ├─location: 1:0 - 1:15 + │ └─attr("srcfile"): @032 └─[[1]][[4]]: <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:22-1:22 - │ │ └─attr("srcfile"): @031 + │ │ ├─location: 1:22 - 1:22 + │ │ └─attr("srcfile"): @032 │ └─[[2]]: - │ ├─location: 1:24-1:24 - │ └─attr("srcfile"): @031 - ├─attr("srcfile"): @031 + │ ├─location: 1:24 - 1:24 + │ └─attr("srcfile"): @032 + ├─attr("srcfile"): @032 └─attr("wholeSrcref"): - ├─location: 1:0-1:26 - └─attr("srcfile"): @031 + ├─location: 1:0 - 1:26 + └─attr("srcfile"): @032 # src() respects max_vec_len parameter @@ -644,8 +662,8 @@ ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:1-1:1 - │ │ └─attr("srcfile"): @032 + │ │ ├─location: 1:1 - 1:1 + │ │ └─attr("srcfile"): @033 │ │ ├─Enc: "unknown" │ │ ├─filename: "" │ │ ├─fixedNewlines: TRUE @@ -655,36 +673,36 @@ │ │ ├─timestamp: "" │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." │ ├─[[2]]: - │ │ ├─location: 2:1-2:1 - │ │ └─attr("srcfile"): @032 + │ │ ├─location: 2:1 - 2:1 + │ │ └─attr("srcfile"): @033 │ ├─[[3]]: - │ │ ├─location: 3:1-3:1 - │ │ └─attr("srcfile"): @032 + │ │ ├─location: 3:1 - 3:1 + │ │ └─attr("srcfile"): @033 │ ├─[[4]]: - │ │ ├─location: 4:1-4:1 - │ │ └─attr("srcfile"): @032 + │ │ ├─location: 4:1 - 4:1 + │ │ └─attr("srcfile"): @033 │ ├─[[5]]: - │ │ ├─location: 5:1-5:1 - │ │ └─attr("srcfile"): @032 + │ │ ├─location: 5:1 - 5:1 + │ │ └─attr("srcfile"): @033 │ ├─[[6]]: - │ │ ├─location: 6:1-6:1 - │ │ └─attr("srcfile"): @032 + │ │ ├─location: 6:1 - 6:1 + │ │ └─attr("srcfile"): @033 │ ├─[[7]]: - │ │ ├─location: 7:1-7:1 - │ │ └─attr("srcfile"): @032 + │ │ ├─location: 7:1 - 7:1 + │ │ └─attr("srcfile"): @033 │ ├─[[8]]: - │ │ ├─location: 8:1-8:1 - │ │ └─attr("srcfile"): @032 + │ │ ├─location: 8:1 - 8:1 + │ │ └─attr("srcfile"): @033 │ ├─[[9]]: - │ │ ├─location: 9:1-9:1 - │ │ └─attr("srcfile"): @032 + │ │ ├─location: 9:1 - 9:1 + │ │ └─attr("srcfile"): @033 │ └─[[10]]: - │ ├─location: 10:1-10:1 - │ └─attr("srcfile"): @032 - ├─attr("srcfile"): @032 + │ ├─location: 10:1 - 10:1 + │ └─attr("srcfile"): @033 + ├─attr("srcfile"): @033 └─attr("wholeSrcref"): - ├─location: 1:0-11:0 - └─attr("srcfile"): @032 + ├─location: 1:0 - 11:0 + └─attr("srcfile"): @033 # src() respects show_source_lines parameter @@ -694,8 +712,8 @@ Output ├─attr("srcref"): - │ ├─location: 1:14-3:1 - │ └─attr("srcfile"): @033 + │ ├─location: 1:14 - 3:1 + │ └─attr("srcfile"): @034 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -707,15 +725,15 @@ └─body(): <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:29-1:29 - │ │ └─attr("srcfile"): @033 + │ │ ├─location: 1:29 - 1:29 + │ │ └─attr("srcfile"): @034 │ └─[[2]]: - │ ├─location: 2:3-2:7 - │ └─attr("srcfile"): @033 - ├─attr("srcfile"): @033 + │ ├─location: 2:3 - 2:7 + │ └─attr("srcfile"): @034 + ├─attr("srcfile"): @034 └─attr("wholeSrcref"): - ├─location: 1:0-3:1 - └─attr("srcfile"): @033 + ├─location: 1:0 - 3:1 + └─attr("srcfile"): @034 # src() shows expression with multiple nested blocks @@ -726,8 +744,8 @@ ├─attr("srcref"): │ └─[[1]]: - │ ├─location: 1:1-8:1 - │ └─attr("srcfile"): @034 + │ ├─location: 1:1 - 8:1 + │ └─attr("srcfile"): @035 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -736,49 +754,49 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @034 + ├─attr("srcfile"): @035 ├─attr("wholeSrcref"): - │ ├─location: 1:0-9:0 - │ └─attr("srcfile"): @034 + │ ├─location: 1:0 - 9:0 + │ └─attr("srcfile"): @035 └─[[1]]: <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:1-1:1 - │ │ └─attr("srcfile"): @034 + │ │ ├─location: 1:1 - 1:1 + │ │ └─attr("srcfile"): @035 │ ├─[[2]]: - │ │ ├─location: 2:3-4:3 - │ │ └─attr("srcfile"): @034 + │ │ ├─location: 2:3 - 4:3 + │ │ └─attr("srcfile"): @035 │ └─[[3]]: - │ ├─location: 5:3-7:3 - │ └─attr("srcfile"): @034 - ├─attr("srcfile"): @034 + │ ├─location: 5:3 - 7:3 + │ └─attr("srcfile"): @035 + ├─attr("srcfile"): @035 ├─attr("wholeSrcref"): - │ ├─location: 1:0-8:1 - │ └─attr("srcfile"): @034 + │ ├─location: 1:0 - 8:1 + │ └─attr("srcfile"): @035 ├─[[2]]: <{> │ ├─attr("srcref"): │ │ ├─[[1]]: - │ │ │ ├─location: 2:3-2:3 - │ │ │ └─attr("srcfile"): @034 + │ │ │ ├─location: 2:3 - 2:3 + │ │ │ └─attr("srcfile"): @035 │ │ └─[[2]]: - │ │ ├─location: 3:5-3:5 - │ │ └─attr("srcfile"): @034 - │ ├─attr("srcfile"): @034 + │ │ ├─location: 3:5 - 3:5 + │ │ └─attr("srcfile"): @035 + │ ├─attr("srcfile"): @035 │ └─attr("wholeSrcref"): - │ ├─location: 1:0-4:3 - │ └─attr("srcfile"): @034 + │ ├─location: 1:0 - 4:3 + │ └─attr("srcfile"): @035 └─[[3]]: <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 5:3-5:3 - │ │ └─attr("srcfile"): @034 + │ │ ├─location: 5:3 - 5:3 + │ │ └─attr("srcfile"): @035 │ └─[[2]]: - │ ├─location: 6:5-6:5 - │ └─attr("srcfile"): @034 - ├─attr("srcfile"): @034 + │ ├─location: 6:5 - 6:5 + │ └─attr("srcfile"): @035 + ├─attr("srcfile"): @035 └─attr("wholeSrcref"): - ├─location: 1:0-7:3 - └─attr("srcfile"): @034 + ├─location: 1:0 - 7:3 + └─attr("srcfile"): @035 # src() shows function with nested block in body @@ -788,8 +806,8 @@ Output ├─attr("srcref"): - │ ├─location: 1:6-5:1 - │ └─attr("srcfile"): @035 + │ ├─location: 1:6 - 5:1 + │ └─attr("srcfile"): @036 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -801,25 +819,25 @@ └─body(): <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 1:18-1:18 - │ │ └─attr("srcfile"): @035 + │ │ ├─location: 1:18 - 1:18 + │ │ └─attr("srcfile"): @036 │ └─[[2]]: - │ ├─location: 2:3-4:3 - │ └─attr("srcfile"): @035 - ├─attr("srcfile"): @035 + │ ├─location: 2:3 - 4:3 + │ └─attr("srcfile"): @036 + ├─attr("srcfile"): @036 ├─attr("wholeSrcref"): - │ ├─location: 1:0-5:1 - │ └─attr("srcfile"): @035 + │ ├─location: 1:0 - 5:1 + │ └─attr("srcfile"): @036 └─[[2]][[3]]: <{> ├─attr("srcref"): │ ├─[[1]]: - │ │ ├─location: 2:10-2:10 - │ │ └─attr("srcfile"): @035 + │ │ ├─location: 2:10 - 2:10 + │ │ └─attr("srcfile"): @036 │ └─[[2]]: - │ ├─location: 3:5-3:5 - │ └─attr("srcfile"): @035 - ├─attr("srcfile"): @035 + │ ├─location: 3:5 - 3:5 + │ └─attr("srcfile"): @036 + ├─attr("srcfile"): @036 └─attr("wholeSrcref"): - ├─location: 1:0-4:3 - └─attr("srcfile"): @035 + ├─location: 1:0 - 4:3 + └─attr("srcfile"): @036 diff --git a/tests/testthat/test-src-snapshots.R b/tests/testthat/test-src-snapshots.R index 68d8361..b815c33 100644 --- a/tests/testthat/test-src-snapshots.R +++ b/tests/testthat/test-src-snapshots.R @@ -61,11 +61,39 @@ test_that("src() shows quoted function body directly", { test_that("src() shows quoted function with arguments", { expect_snapshot({ - with_srcref("x <- quote(function(a, b) { a + b })") + with_srcref("x <- quote(function(a, b) {})") scrub_src(src(x)) }) }) +test_that("src() shows srcref with parsed field when positions differ", { + expect_snapshot({ + # Create a synthetic 8-element srcref where parsed positions differ + # Format: c(first_line, first_byte, last_line, last_byte, + # first_col, last_col, first_parsed, last_parsed) + # This simulates a case where R's parser reports different positions + # than the actual source locations (e.g., due to string continuations) + srcfile <- srcfilecopy( + "test.R", + c( + "x <- function() {", + " # A long comment that spans", + " # multiple lines", + " y <- 1", + "}" + ) + ) + + synthetic_srcref <- structure( + c(2L, 3L, 4L, 8L, 3L, 8L, 1L, 5L), + class = "srcref", + srcfile = srcfile + ) + + scrub_src(src(synthetic_srcref)) + }) +}) + # Test: Expression objects ------------------------------------------------------ test_that("src() shows expression with single element", { diff --git a/tests/testthat/test-src.R b/tests/testthat/test-src.R index 534a2e2..22286dc 100644 --- a/tests/testthat/test-src.R +++ b/tests/testthat/test-src.R @@ -18,7 +18,7 @@ test_that("extract_srcref_info handles 4-element srcrefs", { info <- lobstr:::srcref_info(srcref_4) expect_s3_class(info$location, "lobstr_srcref_location") - expect_equal(as.character(info$location), "1:1-1:5") + expect_equal(as.character(info$location), "1:1 - 1:5") }) test_that("extract_srcref_info handles 6-element srcrefs", { @@ -35,7 +35,7 @@ test_that("extract_srcref_info handles 6-element srcrefs", { info <- lobstr:::srcref_info(srcref_6) expect_s3_class(info$location, "lobstr_srcref_location") - expect_equal(as.character(info$location), "1:1-1:5") + expect_equal(as.character(info$location), "1:1 - 1:5") }) test_that("extract_srcref_info handles 8-element srcrefs", { @@ -46,7 +46,7 @@ test_that("extract_srcref_info handles 8-element srcrefs", { info <- lobstr:::srcref_info(srcref) expect_s3_class(info$location, "lobstr_srcref_location") - expect_match(as.character(info$location), "\\d+:\\d+-\\d+:\\d+") + expect_match(as.character(info$location), "\\d+:\\d+ - \\d+:\\d+") }) test_that("extract_srcref_info shows encoding details when requested", { @@ -121,7 +121,7 @@ test_that("srcref_location works correctly", { class = "srcref" ) loc <- lobstr:::srcref_location(srcref) - expect_equal(loc, "1:5-3:20") + expect_equal(loc, "1:5 - 3:20") }) # Integration tests for src() -------------------------------------------------- @@ -219,7 +219,7 @@ test_that("tree_label.srcref formats correctly", { expect_type(label, "character") expect_match(label, " Date: Fri, 14 Nov 2025 14:41:04 +0100 Subject: [PATCH 04/28] Stable srcfile IDs --- R/src.R | 6 +- tests/testthat/_snaps/src-snapshots.md | 300 ++++++++++++------------- tests/testthat/test-src.R | 15 +- 3 files changed, 162 insertions(+), 159 deletions(-) diff --git a/R/src.R b/R/src.R index 9a247d9..88ad209 100644 --- a/R/src.R +++ b/R/src.R @@ -40,6 +40,7 @@ src <- function( ... ) { seen_srcfiles <- new.env(parent = emptyenv()) + seen_srcfiles$.counter <- 0L result <- src_extract(x, max_lines_preview, seen_srcfiles) if (is.null(result)) { @@ -340,8 +341,9 @@ srcfile_node <- function(srcfile, srcref, max_lines, seen_srcfiles) { return(new_srcfile_ref(id, srcfile_class)) } - # First occurrence - assign ID - id <- substr(addr, 3, 8) + # First occurrence - assign sequential ID + seen_srcfiles$.counter <- seen_srcfiles$.counter + 1L + id <- sprintf("%03d", seen_srcfiles$.counter) seen_srcfiles[[addr]] <- id info <- as.list.environment(srcfile, all.names = TRUE, sorted = TRUE) diff --git a/tests/testthat/_snaps/src-snapshots.md b/tests/testthat/_snaps/src-snapshots.md index c37f56b..5ddbeb8 100644 --- a/tests/testthat/_snaps/src-snapshots.md +++ b/tests/testthat/_snaps/src-snapshots.md @@ -7,7 +7,7 @@ ├─attr("srcref"): │ ├─location: 1:14 - 3:1 - │ └─attr("srcfile"): @008 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -20,14 +20,14 @@ ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:29 - 1:29 - │ │ └─attr("srcfile"): @008 + │ │ └─attr("srcfile"): @001 │ └─[[2]]: │ ├─location: 2:3 - 2:7 - │ └─attr("srcfile"): @008 - ├─attr("srcfile"): @008 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 3:1 - └─attr("srcfile"): @008 + └─attr("srcfile"): @001 # src() shows multi-statement function @@ -38,7 +38,7 @@ ├─attr("srcref"): │ ├─location: 1:15 - 6:1 - │ └─attr("srcfile"): @009 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -51,23 +51,23 @@ ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:27 - 1:27 - │ │ └─attr("srcfile"): @009 + │ │ └─attr("srcfile"): @001 │ ├─[[2]]: │ │ ├─location: 2:3 - 2:12 - │ │ └─attr("srcfile"): @009 + │ │ └─attr("srcfile"): @001 │ ├─[[3]]: │ │ ├─location: 3:3 - 3:12 - │ │ └─attr("srcfile"): @009 + │ │ └─attr("srcfile"): @001 │ ├─[[4]]: │ │ ├─location: 4:3 - 4:12 - │ │ └─attr("srcfile"): @009 + │ │ └─attr("srcfile"): @001 │ └─[[5]]: │ ├─location: 5:3 - 5:3 - │ └─attr("srcfile"): @009 - ├─attr("srcfile"): @009 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 6:1 - └─attr("srcfile"): @009 + └─attr("srcfile"): @001 # src() shows quoted function with nested body @@ -80,7 +80,7 @@ │ ├─attr("srcref"): │ │ └─[[1]]: │ │ ├─location: 1:23 - 1:23 - │ │ └─attr("srcfile"): @010 + │ │ └─attr("srcfile"): @001 │ │ ├─Enc: "unknown" │ │ ├─filename: "" │ │ ├─fixedNewlines: TRUE @@ -89,13 +89,13 @@ │ │ ├─parseData: 1, 1, 1, ...... │ │ ├─timestamp: "" │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - │ ├─attr("srcfile"): @010 + │ ├─attr("srcfile"): @001 │ └─attr("wholeSrcref"): │ ├─location: 1:0 - 1:24 - │ └─attr("srcfile"): @010 + │ └─attr("srcfile"): @001 └─[[4]]: ├─location: 1:12 - 1:24 - └─attr("srcfile"): @010 + └─attr("srcfile"): @001 # src() shows quoted function body directly @@ -107,7 +107,7 @@ ├─attr("srcref"): │ └─[[1]]: │ ├─location: 1:23 - 1:23 - │ └─attr("srcfile"): @011 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -116,10 +116,10 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @011 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 1:24 - └─attr("srcfile"): @011 + └─attr("srcfile"): @001 # src() shows quoted function with arguments @@ -132,7 +132,7 @@ │ ├─attr("srcref"): │ │ └─[[1]]: │ │ ├─location: 1:27 - 1:27 - │ │ └─attr("srcfile"): @012 + │ │ └─attr("srcfile"): @001 │ │ ├─Enc: "unknown" │ │ ├─filename: "" │ │ ├─fixedNewlines: TRUE @@ -141,13 +141,13 @@ │ │ ├─parseData: 1, 1, 1, ...... │ │ ├─timestamp: "" │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - │ ├─attr("srcfile"): @012 + │ ├─attr("srcfile"): @001 │ └─attr("wholeSrcref"): │ ├─location: 1:0 - 1:28 - │ └─attr("srcfile"): @012 + │ └─attr("srcfile"): @001 └─[[4]]: ├─location: 1:12 - 1:28 - └─attr("srcfile"): @012 + └─attr("srcfile"): @001 # src() shows srcref with parsed field when positions differ @@ -161,7 +161,7 @@ ├─location: 2:3 - 4:8 ├─parsed: 1:3 - 5:8 - └─attr("srcfile"): @013 + └─attr("srcfile"): @001 ├─Enc: "unknown" ├─filename: "" ├─fixedNewlines: TRUE @@ -180,7 +180,7 @@ ├─attr("srcref"): │ └─[[1]]: │ ├─location: 1:1 - 1:5 - │ └─attr("srcfile"): @014 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -189,10 +189,10 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @014 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 2:0 - └─attr("srcfile"): @014 + └─attr("srcfile"): @001 # src() shows expression with multiple elements @@ -204,7 +204,7 @@ ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:1 - 1:5 - │ │ └─attr("srcfile"): @015 + │ │ └─attr("srcfile"): @001 │ │ ├─Enc: "unknown" │ │ ├─filename: "" │ │ ├─fixedNewlines: TRUE @@ -215,14 +215,14 @@ │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." │ ├─[[2]]: │ │ ├─location: 2:1 - 2:5 - │ │ └─attr("srcfile"): @015 + │ │ └─attr("srcfile"): @001 │ └─[[3]]: │ ├─location: 3:1 - 3:5 - │ └─attr("srcfile"): @015 - ├─attr("srcfile"): @015 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 4:0 - └─attr("srcfile"): @015 + └─attr("srcfile"): @001 # src() shows expression with nested block and wholeSrcref @@ -234,7 +234,7 @@ ├─attr("srcref"): │ └─[[1]]: │ ├─location: 1:1 - 3:1 - │ └─attr("srcfile"): @016 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -243,22 +243,22 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @016 + ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 4:0 - │ └─attr("srcfile"): @016 + │ └─attr("srcfile"): @001 └─[[1]]: <{> ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:1 - 1:1 - │ │ └─attr("srcfile"): @016 + │ │ └─attr("srcfile"): @001 │ └─[[2]]: │ ├─location: 2:3 - 2:3 - │ └─attr("srcfile"): @016 - ├─attr("srcfile"): @016 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 3:1 - └─attr("srcfile"): @016 + └─attr("srcfile"): @001 # src() shows nested block element directly @@ -270,7 +270,7 @@ ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:1 - 1:1 - │ │ └─attr("srcfile"): @017 + │ │ └─attr("srcfile"): @001 │ │ ├─Enc: "unknown" │ │ ├─filename: "" │ │ ├─fixedNewlines: TRUE @@ -281,11 +281,11 @@ │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." │ └─[[2]]: │ ├─location: 2:3 - 2:3 - │ └─attr("srcfile"): @017 - ├─attr("srcfile"): @017 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 3:1 - └─attr("srcfile"): @017 + └─attr("srcfile"): @001 # src() shows block with srcref list and wholeSrcref @@ -297,7 +297,7 @@ ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:1 - 1:1 - │ │ └─attr("srcfile"): @018 + │ │ └─attr("srcfile"): @001 │ │ ├─Enc: "unknown" │ │ ├─filename: "" │ │ ├─fixedNewlines: TRUE @@ -308,14 +308,14 @@ │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." │ ├─[[2]]: │ │ ├─location: 2:3 - 2:8 - │ │ └─attr("srcfile"): @018 + │ │ └─attr("srcfile"): @001 │ └─[[3]]: │ ├─location: 3:3 - 3:8 - │ └─attr("srcfile"): @018 - ├─attr("srcfile"): @018 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 4:1 - └─attr("srcfile"): @018 + └─attr("srcfile"): @001 # src() shows single srcref @@ -326,7 +326,7 @@ Output ├─location: 1:1 - 1:5 - └─attr("srcfile"): @019 + └─attr("srcfile"): @001 ├─Enc: "unknown" ├─filename: "" ├─fixedNewlines: TRUE @@ -348,7 +348,7 @@ └─srcrefs: ├─ │ ├─location: 1:1 - 1:5 - │ └─attr("srcfile"): @020 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -359,7 +359,7 @@ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." └─ ├─location: 2:1 - 2:5 - └─attr("srcfile"): @020 + └─attr("srcfile"): @001 # src() reveals srcref list structure with index notation @@ -371,7 +371,7 @@ ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:23 - 1:23 - │ │ └─attr("srcfile"): @021 + │ │ └─attr("srcfile"): @001 │ │ ├─Enc: "unknown" │ │ ├─filename: "" │ │ ├─fixedNewlines: TRUE @@ -382,11 +382,11 @@ │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." │ └─[[2]]: │ ├─location: 1:25 - 1:25 - │ └─attr("srcfile"): @021 - ├─attr("srcfile"): @021 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 1:27 - └─attr("srcfile"): @021 + └─attr("srcfile"): @001 # src() handles srcrefs nested in language calls @@ -398,7 +398,7 @@ ├─attr("srcref"): │ └─[[1]]: │ ├─location: 1:1 - 1:26 - │ └─attr("srcfile"): @022 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -407,34 +407,34 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @022 + ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 2:0 - │ └─attr("srcfile"): @022 + │ └─attr("srcfile"): @001 └─[[1]][[2]]: <{> ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:5 - 1:5 - │ │ └─attr("srcfile"): @022 + │ │ └─attr("srcfile"): @001 │ └─[[2]]: │ ├─location: 1:7 - 1:23 - │ └─attr("srcfile"): @022 - ├─attr("srcfile"): @022 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 1:25 - │ └─attr("srcfile"): @022 + │ └─attr("srcfile"): @001 └─[[2]][[3]][[2]]: <{> ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:18 - 1:18 - │ │ └─attr("srcfile"): @022 + │ │ └─attr("srcfile"): @001 │ └─[[2]]: │ ├─location: 1:20 - 1:20 - │ └─attr("srcfile"): @022 - ├─attr("srcfile"): @022 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 1:22 - └─attr("srcfile"): @022 + └─attr("srcfile"): @001 # src() handles srcrefs nested in function bodies @@ -445,7 +445,7 @@ ├─attr("srcref"): │ ├─location: 1:6 - 1:42 - │ └─attr("srcfile"): @023 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -459,26 +459,26 @@ ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:21 - 1:21 - │ │ └─attr("srcfile"): @023 + │ │ └─attr("srcfile"): @001 │ └─[[2]]: │ ├─location: 1:23 - 1:39 - │ └─attr("srcfile"): @023 - ├─attr("srcfile"): @023 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 1:41 - │ └─attr("srcfile"): @023 + │ └─attr("srcfile"): @001 └─[[2]][[3]][[2]]: <{> ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:34 - 1:34 - │ │ └─attr("srcfile"): @023 + │ │ └─attr("srcfile"): @001 │ └─[[2]]: │ ├─location: 1:36 - 1:36 - │ └─attr("srcfile"): @023 - ├─attr("srcfile"): @023 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 1:38 - └─attr("srcfile"): @023 + └─attr("srcfile"): @001 # src() currently shows duplicate srcfile objects @@ -489,7 +489,7 @@ ├─attr("srcref"): │ ├─location: 1:14 - 3:1 - │ └─attr("srcfile"): @028 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -502,14 +502,14 @@ ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:29 - 1:29 - │ │ └─attr("srcfile"): @028 + │ │ └─attr("srcfile"): @001 │ └─[[2]]: │ ├─location: 2:3 - 2:7 - │ └─attr("srcfile"): @028 - ├─attr("srcfile"): @028 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 3:1 - └─attr("srcfile"): @028 + └─attr("srcfile"): @001 # src() shows many duplicate srcfiles in nested expression @@ -521,7 +521,7 @@ ├─attr("srcref"): │ └─[[1]]: │ ├─location: 1:1 - 4:1 - │ └─attr("srcfile"): @029 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -530,25 +530,25 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @029 + ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 5:0 - │ └─attr("srcfile"): @029 + │ └─attr("srcfile"): @001 └─[[1]]: <{> ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:1 - 1:1 - │ │ └─attr("srcfile"): @029 + │ │ └─attr("srcfile"): @001 │ ├─[[2]]: │ │ ├─location: 2:3 - 2:3 - │ │ └─attr("srcfile"): @029 + │ │ └─attr("srcfile"): @001 │ └─[[3]]: │ ├─location: 3:3 - 3:3 - │ └─attr("srcfile"): @029 - ├─attr("srcfile"): @029 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 4:1 - └─attr("srcfile"): @029 + └─attr("srcfile"): @001 # src() handles empty block @@ -560,7 +560,7 @@ ├─attr("srcref"): │ └─[[1]]: │ ├─location: 1:1 - 1:1 - │ └─attr("srcfile"): @030 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -569,10 +569,10 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @030 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 1:2 - └─attr("srcfile"): @030 + └─attr("srcfile"): @001 # src() handles function without arguments @@ -583,7 +583,7 @@ ├─attr("srcref"): │ ├─location: 1:6 - 1:24 - │ └─attr("srcfile"): @031 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -596,14 +596,14 @@ ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:17 - 1:17 - │ │ └─attr("srcfile"): @031 + │ │ └─attr("srcfile"): @001 │ └─[[2]]: │ ├─location: 1:19 - 1:22 - │ └─attr("srcfile"): @031 - ├─attr("srcfile"): @031 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 1:24 - └─attr("srcfile"): @031 + └─attr("srcfile"): @001 # src() handles if statement with blocks @@ -615,7 +615,7 @@ ├─attr("srcref"): │ └─[[1]]: │ ├─location: 1:1 - 1:26 - │ └─attr("srcfile"): @032 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -624,34 +624,34 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @032 + ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 2:0 - │ └─attr("srcfile"): @032 + │ └─attr("srcfile"): @001 ├─[[1]][[3]]: <{> │ ├─attr("srcref"): │ │ ├─[[1]]: │ │ │ ├─location: 1:11 - 1:11 - │ │ │ └─attr("srcfile"): @032 + │ │ │ └─attr("srcfile"): @001 │ │ └─[[2]]: │ │ ├─location: 1:13 - 1:13 - │ │ └─attr("srcfile"): @032 - │ ├─attr("srcfile"): @032 + │ │ └─attr("srcfile"): @001 + │ ├─attr("srcfile"): @001 │ └─attr("wholeSrcref"): │ ├─location: 1:0 - 1:15 - │ └─attr("srcfile"): @032 + │ └─attr("srcfile"): @001 └─[[1]][[4]]: <{> ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:22 - 1:22 - │ │ └─attr("srcfile"): @032 + │ │ └─attr("srcfile"): @001 │ └─[[2]]: │ ├─location: 1:24 - 1:24 - │ └─attr("srcfile"): @032 - ├─attr("srcfile"): @032 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 1:26 - └─attr("srcfile"): @032 + └─attr("srcfile"): @001 # src() respects max_vec_len parameter @@ -663,7 +663,7 @@ ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:1 - 1:1 - │ │ └─attr("srcfile"): @033 + │ │ └─attr("srcfile"): @001 │ │ ├─Enc: "unknown" │ │ ├─filename: "" │ │ ├─fixedNewlines: TRUE @@ -674,35 +674,35 @@ │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." │ ├─[[2]]: │ │ ├─location: 2:1 - 2:1 - │ │ └─attr("srcfile"): @033 + │ │ └─attr("srcfile"): @001 │ ├─[[3]]: │ │ ├─location: 3:1 - 3:1 - │ │ └─attr("srcfile"): @033 + │ │ └─attr("srcfile"): @001 │ ├─[[4]]: │ │ ├─location: 4:1 - 4:1 - │ │ └─attr("srcfile"): @033 + │ │ └─attr("srcfile"): @001 │ ├─[[5]]: │ │ ├─location: 5:1 - 5:1 - │ │ └─attr("srcfile"): @033 + │ │ └─attr("srcfile"): @001 │ ├─[[6]]: │ │ ├─location: 6:1 - 6:1 - │ │ └─attr("srcfile"): @033 + │ │ └─attr("srcfile"): @001 │ ├─[[7]]: │ │ ├─location: 7:1 - 7:1 - │ │ └─attr("srcfile"): @033 + │ │ └─attr("srcfile"): @001 │ ├─[[8]]: │ │ ├─location: 8:1 - 8:1 - │ │ └─attr("srcfile"): @033 + │ │ └─attr("srcfile"): @001 │ ├─[[9]]: │ │ ├─location: 9:1 - 9:1 - │ │ └─attr("srcfile"): @033 + │ │ └─attr("srcfile"): @001 │ └─[[10]]: │ ├─location: 10:1 - 10:1 - │ └─attr("srcfile"): @033 - ├─attr("srcfile"): @033 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 11:0 - └─attr("srcfile"): @033 + └─attr("srcfile"): @001 # src() respects show_source_lines parameter @@ -713,7 +713,7 @@ ├─attr("srcref"): │ ├─location: 1:14 - 3:1 - │ └─attr("srcfile"): @034 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -726,14 +726,14 @@ ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:29 - 1:29 - │ │ └─attr("srcfile"): @034 + │ │ └─attr("srcfile"): @001 │ └─[[2]]: │ ├─location: 2:3 - 2:7 - │ └─attr("srcfile"): @034 - ├─attr("srcfile"): @034 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 3:1 - └─attr("srcfile"): @034 + └─attr("srcfile"): @001 # src() shows expression with multiple nested blocks @@ -745,7 +745,7 @@ ├─attr("srcref"): │ └─[[1]]: │ ├─location: 1:1 - 8:1 - │ └─attr("srcfile"): @035 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -754,49 +754,49 @@ │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - ├─attr("srcfile"): @035 + ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 9:0 - │ └─attr("srcfile"): @035 + │ └─attr("srcfile"): @001 └─[[1]]: <{> ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:1 - 1:1 - │ │ └─attr("srcfile"): @035 + │ │ └─attr("srcfile"): @001 │ ├─[[2]]: │ │ ├─location: 2:3 - 4:3 - │ │ └─attr("srcfile"): @035 + │ │ └─attr("srcfile"): @001 │ └─[[3]]: │ ├─location: 5:3 - 7:3 - │ └─attr("srcfile"): @035 - ├─attr("srcfile"): @035 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 8:1 - │ └─attr("srcfile"): @035 + │ └─attr("srcfile"): @001 ├─[[2]]: <{> │ ├─attr("srcref"): │ │ ├─[[1]]: │ │ │ ├─location: 2:3 - 2:3 - │ │ │ └─attr("srcfile"): @035 + │ │ │ └─attr("srcfile"): @001 │ │ └─[[2]]: │ │ ├─location: 3:5 - 3:5 - │ │ └─attr("srcfile"): @035 - │ ├─attr("srcfile"): @035 + │ │ └─attr("srcfile"): @001 + │ ├─attr("srcfile"): @001 │ └─attr("wholeSrcref"): │ ├─location: 1:0 - 4:3 - │ └─attr("srcfile"): @035 + │ └─attr("srcfile"): @001 └─[[3]]: <{> ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 5:3 - 5:3 - │ │ └─attr("srcfile"): @035 + │ │ └─attr("srcfile"): @001 │ └─[[2]]: │ ├─location: 6:5 - 6:5 - │ └─attr("srcfile"): @035 - ├─attr("srcfile"): @035 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 7:3 - └─attr("srcfile"): @035 + └─attr("srcfile"): @001 # src() shows function with nested block in body @@ -807,7 +807,7 @@ ├─attr("srcref"): │ ├─location: 1:6 - 5:1 - │ └─attr("srcfile"): @036 + │ └─attr("srcfile"): @001 │ ├─Enc: "unknown" │ ├─filename: "" │ ├─fixedNewlines: TRUE @@ -820,24 +820,24 @@ ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 1:18 - 1:18 - │ │ └─attr("srcfile"): @036 + │ │ └─attr("srcfile"): @001 │ └─[[2]]: │ ├─location: 2:3 - 4:3 - │ └─attr("srcfile"): @036 - ├─attr("srcfile"): @036 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 5:1 - │ └─attr("srcfile"): @036 + │ └─attr("srcfile"): @001 └─[[2]][[3]]: <{> ├─attr("srcref"): │ ├─[[1]]: │ │ ├─location: 2:10 - 2:10 - │ │ └─attr("srcfile"): @036 + │ │ └─attr("srcfile"): @001 │ └─[[2]]: │ ├─location: 3:5 - 3:5 - │ └─attr("srcfile"): @036 - ├─attr("srcfile"): @036 + │ └─attr("srcfile"): @001 + ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 4:3 - └─attr("srcfile"): @036 + └─attr("srcfile"): @001 diff --git a/tests/testthat/test-src.R b/tests/testthat/test-src.R index 22286dc..bfa3c9e 100644 --- a/tests/testthat/test-src.R +++ b/tests/testthat/test-src.R @@ -349,14 +349,13 @@ test_that("srcfile deduplication - IDs are stable within a single src() call", { result_g <- src(g) id_g <- attr(result_g$`attr("srcref")`$`attr("srcfile")`, "srcfile_id") - # IDs should be different because they're from different src() calls - # and different srcfile objects + # IDs are sequential and start fresh for each src() call expect_type(id_f, "character") expect_type(id_g, "character") - # Both should be hex IDs (up to 6 chars) - expect_true(nchar(id_f) >= 1 && nchar(id_f) <= 6) - expect_true(nchar(id_g) >= 1 && nchar(id_g) <= 6) + # Both should be 3-digit sequential IDs starting at "001" + expect_equal(id_f, "001") + expect_equal(id_g, "001") }) test_that("srcfile deduplication - multiple files means no cross-file deduplication", { @@ -384,8 +383,10 @@ test_that("srcfile deduplication - multiple files means no cross-file deduplicat id_f <- attr(result_f$`attr("srcref")`$`attr("srcfile")`, "srcfile_id") id_g <- attr(result_g$`attr("srcref")`$`attr("srcfile")`, "srcfile_id") - # IDs are derived from addresses, so different addresses = different IDs - expect_false(id_f == id_g) + # IDs are sequential and start fresh for each src() call, so both get "001" + # This ensures deterministic snapshots + expect_equal(id_f, "001") + expect_equal(id_g, "001") }) test_that("srcfile deduplication - nested functions from same file", { From 09f5da4e54ffef142c5d19f9a41b756b114adc25 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Fri, 14 Nov 2025 14:49:19 +0100 Subject: [PATCH 05/28] Handle `original` fields --- R/src.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/src.R b/R/src.R index 88ad209..6e09a90 100644 --- a/R/src.R +++ b/R/src.R @@ -353,6 +353,11 @@ srcfile_node <- function(srcfile, srcref, max_lines, seen_srcfiles) { info$timestamp <- format(info$timestamp) } + # Process nested srcfile objects (e.g., 'original' in srcfilealias) + if (!is.null(info$original) && inherits(info$original, "srcfile")) { + info$original <- srcfile_node(info$original, NULL, max_lines, seen_srcfiles) + } + # Add source preview for plain srcfiles if (!inherits(srcfile, "srcfilecopy") && !is.null(srcref)) { snippet <- srcfile_lines(srcfile, srcref, max_lines) From 1c4b4a11fc004583d3f733886c08299756f89406 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Fri, 14 Nov 2025 15:36:20 +0100 Subject: [PATCH 06/28] Polish documentation --- R/src.R | 159 ++++++++++++++++++++++++++++++++++++++++---- R/tree.R | 1 + man/src.Rd | 188 +++++++++++++++++++++++++++++++++++++++++----------- man/tree.Rd | 2 + 4 files changed, 298 insertions(+), 52 deletions(-) diff --git a/R/src.R b/R/src.R index 6e09a90..92b0646 100644 --- a/R/src.R +++ b/R/src.R @@ -1,15 +1,16 @@ +#' Show structure of source reference objects: srcfile and srcref +#' +#' @description #' Display tree of source references #' #' Visualizes source reference metadata attached to R objects in a tree structure. -#' Shows source file information, line/column locations, and optionally the -#' actual source code. +#' Shows source file information, line/column locations, and lines of source code. #' #' @param x An R object with source references. Can be: #' - A `srcref` object #' - A list of `srcref` objects #' - A function (closure) with source references #' - An expression with source references -#' - A primitive/builtin function (will show informative message) #' @param max_depth Maximum depth to traverse nested structures (default 5) #' @param max_lines_preview Maximum lines of source to show per srcref (default 3) #' @param max_length Maximum number of srcref nodes to display (default 100) @@ -18,19 +19,149 @@ #' @return Invisibly returns a structured list containing the source reference #' information #' -#' @export -#' @family object inspectors -#' @examples -#' # Create a function with source references -#' f <- function(x) { -#' x + 1 -#' } +#' @section Overview: +#' +#' Source references are made of two kinds of objects: +#' - `srcref` objects, which contain information about a specific +#' location within the source file, such as the line and column numbers. +#' - `srcfile` objects, which contain metadata about the source file +#' such as its name, path, and encoding. +#' +#' ## `srcref` objects +#' +#' `srcref` objects are compact integer vectors describing a character range +#' in a source. It records start/end lines and byte/column positions and, +#' optionally, the parsed-line numbers if `#line` directives were used. +#' +#' Lengths of 4, 6, or 8 are allowed: +#' - 4: basic (first_line, first_byte, last_line, last_byte) +#' - 6: adds columns (first_col, last_col) +#' - 8: adds parsed-line numbers (first_parsed, last_parsed) +#' +#' `srcref` objects are attached as attributes (e.g. `attr(x, "srcref")` +#' or `attr(x, "wholeSrcref")`) to parsed expressions and closures when +#' `keep.source = TRUE`. The parser also stores parse/token data on the +#' associated `srcfile` when requested. +#' +#' Methods: +#' - `as.character()`: Retrieves relevant source lines from the `srcfile` +#' reference. +#' +#' They have a `srcfile` attribute that points to the source file. +#' +#' ## `srcfile` objects +#' +#' `srcfile` objects are environments representing information about a +#' source file that a source reference points to. They typically refer to +#' a file on disk and store the filename, working directory, a timestamp, +#' and encoding information. A plain `srcfile` is lightweight and opens +#' the underlying file lazily when content is needed. +#' +#' There are multiple subclasses of `srcfile`. +#' +#' +#' ### `srcfile` +#' +#' Fields common to all `srcfile` objects: +#' +#' - `filename`: The filename of the source file. If relative, the path is +#' resolved against `wd`. +#' +#' - `wd`: The working directory (`getwd()`) at the time the srcfile was created +#' (generally at the time of parsing). +#' +#' - `timestamp`: The timestamp of the source file. Retrieved from `filename` +#' with `file.mtime()`. +#' +#' - `encoding`: The encoding of the source file. +#' +#' - `Enc`: The encoding of output lines. Used by `getSrcLines()`, which +#' calls `iconv()` when `Enc` does not match `encoding`. +#' +#' Implementations: +#' - `print()` and `summary()` to print information about the source file. +#' - `open()` and `close()` to access the underlying file as a connection. +#' +#' Helpers: +#' - `getSrcLines()`: Retrieves source lines from a `srcfile`. +#' +#' +#' ### `srcfilecopy` #' -#' # Display source reference information -#' src(f) +#' A `srcfilecopy` stores the actual source lines in memory in `$lines`. +#' It is produced when code is parsed while `keep.source = TRUE` or when +#' text is parsed from a character vector. `srcfilecopy` is useful when +#' the original file may change or not exist, because it preserves the +#' exact text used by the parser. #' -#' # Limit source preview -#' src(f, max_lines_preview = 1) +#' This type of srcfile is the most common. It's created by: +#' +#' - The R-level `parse()` function when `text` is supplied: +#' +#' ```r +#' # Creates a `""` non-file `srcfilecopy` +#' parse(text = "...", keep.source = TRUE) +#' ``` +#' +#' - The console's input parser when `getOption("keep.source")` is `TRUE`. +#' +#' - `sys.source()` when `keep.source = TRUE`: +#' +#' ```r +#' sys.source(file, keep.source = TRUE) +#' ``` +#' +#' The `srcfilecopy` object is timestamped with the file's last modification time. +#' +#' +#' Fields: +#' +#' - `filename`: The filename of the source file. If `ifFile` is `FALSE`, +#' the field is non meaningful. For instance `parse(text = )` sets it to +#' `""`, and the console input parser sets it to `""`. +#' +#' - `isFile`: A logical indicating whether the source file exists. +#' +#' - `fixedNewlines`: If `TRUE`, `lines` is a character vector of lines with +#' no embedded `\n` characters. The `getSrcLines()` helper regularises `lines` +#' in this way and sets `fixedNewlines` to `TRUE`. +#' +#' +#' ### `srcfilealias` +#' +#' This object wraps an existing `srcfile` object (stored in `original`). It +#' allows exposing a different `filename` while delegating the open/close/get +#' lines operations to the `srcfile` stored in `original`. +#' +#' The typical way aliases are created is via `#line *line* *filename*` +#' directives where `*filename*` is supplied. These directives remap the srcref +#' and srcfile of parsed code to a different location, for example from a +#' temporary file or generated file to the original location on disk. +#' +#' Called by `install.packages()` when installing a _source_ package with `keep.source.pkgs` set to `TRUE` (see +#' ), but +#' [only when](https://github.com/r-devel/r-svn/blob/52affc16/src/library/tools/R/admin.R#L308): +#' +#' - `Encoding` was supplied in `DESCRIPTION` +#' - The system locale is not "C" or "POSIX". +#' +#' The source files are converted to the encoding of the system locale, then +#' collated in a single source file with `#line` directives mapping them to their +#' original file names (with full paths): +#' +#' +#' +#' Fields: +#' +#' - `filename`: The virtual file name (or full path) of the parsed code. +#' - `original`: The actual `srcfile` the code was parsed from. +#' +#' @seealso +#' - [srcfile()]: Base documentation for `srcref` and `srcfile` objects. +#' - [getParseData()]: Parse information stored when `keep.source.data` is `TRUE`. +#' +#' @export +#' @family object inspectors src <- function( x, max_depth = 5L, diff --git a/R/tree.R b/R/tree.R index 65ec300..28e8f66 100644 --- a/R/tree.R +++ b/R/tree.R @@ -9,6 +9,7 @@ #' @param max_depth How far down the tree structure should be printed. E.g. `1` #' means only direct children of the root element will be shown. Useful for #' very deep lists. +#' @param max_vec_len How many elements should be printed for vectors? #' @param show_environments Should environments be treated like normal lists and #' recursed into? #' @param hide_scalar_types Should atomic scalars be printed with type and diff --git a/man/src.Rd b/man/src.Rd index e364e40..abde3eb 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -2,18 +2,9 @@ % Please edit documentation in R/src.R \name{src} \alias{src} -\title{Display tree of source references} +\title{Show structure of source reference objects: srcfile and srcref} \usage{ -src( - x, - max_depth = 5L, - show_source_lines = TRUE, - max_lines_preview = 3L, - show_encoding_details = FALSE, - max_length = 100L, - max_vec_len = 3L, - ... -) +src(x, max_depth = 5L, max_length = 100L, ...) } \arguments{ \item{x}{An R object with source references. Can be: @@ -22,53 +13,174 @@ src( \item A list of \code{srcref} objects \item A function (closure) with source references \item An expression with source references -\item A primitive/builtin function (will show informative message) }} \item{max_depth}{Maximum depth to traverse nested structures (default 5)} -\item{show_source_lines}{Whether to show actual source code snippets (default TRUE)} - -\item{max_lines_preview}{Maximum lines of source to show per srcref (default 3)} - -\item{show_encoding_details}{Show byte-level details when they differ from -columns due to multibyte characters (default FALSE)} - \item{max_length}{Maximum number of srcref nodes to display (default 100)} \item{...}{Additional arguments passed to \code{\link[=tree]{tree()}}} } \value{ Invisibly returns a structured list containing the source reference -information. The list has components: -\itemize{ -\item \code{type}: Type of input object -\item \code{name}: Name of object if applicable -\item \code{srcfile}: Source file information -\item \code{srcrefs}: List of source reference details -} +information } \description{ +Display tree of source references + Visualizes source reference metadata attached to R objects in a tree structure. -Shows source file information, line/column locations, and optionally the -actual source code. +Shows source file information, line/column locations, and lines of source code. +} +\section{Overview}{ + + +Source references are made of two kinds of objects: +\itemize{ +\item \code{srcref} objects, which contain information about a specific +location within the source file, such as the line and column numbers. +\item \code{srcfile} objects, which contain metadata about the source file +such as its name, path, and encoding. +} +\subsection{\code{srcref} objects}{ + +\code{srcref} objects are compact integer vectors describing a character range +in a source. It records start/end lines and byte/column positions and, +optionally, the parsed-line numbers if \verb{#line} directives were used. + +Lengths of 4, 6, or 8 are allowed: +\itemize{ +\item 4: basic (first_line, first_byte, last_line, last_byte) +\item 6: adds columns (first_col, last_col) +\item 8: adds parsed-line numbers (first_parsed, last_parsed) +} + +\code{srcref} objects are attached as attributes (e.g. \code{attr(x, "srcref")} +or \code{attr(x, "wholeSrcref")}) to parsed expressions and closures when +\code{keep.source = TRUE}. The parser also stores parse/token data on the +associated \code{srcfile} when requested. + +Methods: +\itemize{ +\item \code{as.character()}: Retrieves relevant source lines from the \code{srcfile} +reference. +} + +They have a \code{srcfile} attribute that points to the source file. +} + +\subsection{\code{srcfile} objects}{ + +\code{srcfile} objects are environments representing information about a +source file that a source reference points to. They typically refer to +a file on disk and store the filename, working directory, a timestamp, +and encoding information. A plain \code{srcfile} is lightweight and opens +the underlying file lazily when content is needed. + +There are multiple subclasses of \code{srcfile}. +\subsection{\code{srcfile}}{ + +Fields common to all \code{srcfile} objects: +\itemize{ +\item \code{filename}: The filename of the source file. If relative, the path is +resolved against \code{wd}. +\item \code{wd}: The working directory (\code{getwd()}) at the time the srcfile was created +(generally at the time of parsing). +\item \code{timestamp}: The timestamp of the source file. Retrieved from \code{filename} +with \code{file.mtime()}. +\item \code{encoding}: The encoding of the source file. +\item \code{Enc}: The encoding of output lines. Used by \code{getSrcLines()}, which +calls \code{iconv()} when \code{Enc} does not match \code{encoding}. +} + +Implementations: +\itemize{ +\item \code{print()} and \code{summary()} to print information about the source file. +\item \code{open()} and \code{close()} to access the underlying file as a connection. } -\examples{ -# Create a function with source references -f <- function(x) { - x + 1 + +Helpers: +\itemize{ +\item \code{getSrcLines()}: Retrieves source lines from a \code{srcfile}. } +} + +\subsection{\code{srcfilecopy}}{ -# Display source reference information -src(f) +A \code{srcfilecopy} stores the actual source lines in memory in \verb{$lines}. +It is produced when code is parsed while \code{keep.source = TRUE} or when +text is parsed from a character vector. \code{srcfilecopy} is useful when +the original file may change or not exist, because it preserves the +exact text used by the parser. -# Show encoding details -src(f, show_encoding_details = TRUE) +This type of srcfile is the most common. It's created by: +\itemize{ +\item The R-level \code{parse()} function when \code{text} is supplied: + +\if{html}{\out{
}}\preformatted{# Creates a `""` non-file `srcfilecopy` +parse(text = "...", keep.source = TRUE) +}\if{html}{\out{
}} +\item The console's input parser when \code{getOption("keep.source")} is \code{TRUE}. +\item \code{sys.source()} when \code{keep.source = TRUE}: -# Limit source preview -src(f, max_lines_preview = 1) +\if{html}{\out{
}}\preformatted{sys.source(file, keep.source = TRUE) +}\if{html}{\out{
}} + +The \code{srcfilecopy} object is timestamped with the file's last modification time. +\url{https://github.com/r-devel/r-svn/blob/52affc16/src/library/base/R/source.R#L273-L276} } + +Fields: +\itemize{ +\item \code{filename}: The filename of the source file. If \code{ifFile} is \code{FALSE}, +the field is non meaningful. For instance \code{parse(text = )} sets it to +\code{""}, and the console input parser sets it to \code{""}. +\item \code{isFile}: A logical indicating whether the source file exists. +\item \code{fixedNewlines}: If \code{TRUE}, \code{lines} is a character vector of lines with +no embedded \verb{\\n} characters. The \code{getSrcLines()} helper regularises \code{lines} +in this way and sets \code{fixedNewlines} to \code{TRUE}. +} +} + +\subsection{\code{srcfilealias}}{ + +This object wraps an existing \code{srcfile} object (stored in \code{original}). It +allows exposing a different \code{filename} while delegating the open/close/get +lines operations to the \code{srcfile} stored in \code{original}. + +The typical way aliases are created is via \verb{#line *line* *filename*} +directives where \verb{*filename*} is supplied. These directives remap the srcref +and srcfile of parsed code to a different location, for example from a +temporary file or generated file to the original location on disk. + +Called by \code{install.packages()} when installing a \emph{source} package with \code{keep.source.pkgs} set to \code{TRUE} (see +\url{https://github.com/r-devel/r-svn/blob/52affc16/src/library/tools/R/install.R#L545}), but +\href{https://github.com/r-devel/r-svn/blob/52affc16/src/library/tools/R/admin.R#L308}{only when}: +\itemize{ +\item \code{Encoding} was supplied in \code{DESCRIPTION} +\item The system locale is not "C" or "POSIX". +} + +The source files are converted to the encoding of the system locale, then +collated in a single source file with \verb{#line} directives mapping them to their +original file names (with full paths): +\url{https://github.com/r-devel/r-svn/blob/52affc16/src/library/tools/R/admin.R#L342} + +Fields: +\itemize{ +\item \code{filename}: The virtual file name (or full path) of the parsed code. +\item \code{original}: The actual \code{srcfile} the code was parsed from. +} +} + +} +} + \seealso{ +\itemize{ +\item \code{\link[=srcfile]{srcfile()}}: Base documentation for \code{srcref} and \code{srcfile} objects. +\item \code{\link[=getParseData]{getParseData()}}: Parse information stored when \code{keep.source.data} is \code{TRUE}. +} + Other object inspectors: \code{\link{ast}()}, \code{\link{ref}()}, diff --git a/man/tree.Rd b/man/tree.Rd index 5bd4819..99deac4 100644 --- a/man/tree.Rd +++ b/man/tree.Rd @@ -35,6 +35,8 @@ very deep lists.} \item{max_length}{How many elements should be printed? This is useful in case you try and print an object with 100,000 items in it.} +\item{max_vec_len}{How many elements should be printed for vectors?} + \item{show_environments}{Should environments be treated like normal lists and recursed into?} From d6390703a8aa22b5ea1391151495f508b552099e Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Mon, 17 Nov 2025 14:32:47 +0100 Subject: [PATCH 07/28] Simplify UI --- R/src.R | 74 ++++++++++++-------------- tests/testthat/_snaps/src-snapshots.md | 51 ------------------ tests/testthat/test-src-snapshots.R | 7 --- tests/testthat/test-src.R | 15 +++--- 4 files changed, 42 insertions(+), 105 deletions(-) diff --git a/R/src.R b/R/src.R index 92b0646..f4ff77f 100644 --- a/R/src.R +++ b/R/src.R @@ -12,7 +12,6 @@ #' - A function (closure) with source references #' - An expression with source references #' @param max_depth Maximum depth to traverse nested structures (default 5) -#' @param max_lines_preview Maximum lines of source to show per srcref (default 3) #' @param max_length Maximum number of srcref nodes to display (default 100) #' @param ... Additional arguments passed to [tree()] #' @@ -165,15 +164,13 @@ src <- function( x, max_depth = 5L, - max_lines_preview = 3L, max_length = 100L, - max_vec_len = 3L, ... ) { seen_srcfiles <- new.env(parent = emptyenv()) seen_srcfiles$.counter <- 0L - result <- src_extract(x, max_lines_preview, seen_srcfiles) + result <- src_extract(x, seen_srcfiles) if (is.null(result)) { return(invisible(NULL)) } @@ -187,7 +184,6 @@ src <- function( result, max_depth = max_depth, max_length = max_length, - max_vec_len = max_vec_len, tree_args = list(...), class = c("lobstr_srcref", class(result)) ) @@ -197,20 +193,20 @@ src <- function( print.lobstr_srcref <- function(x, ...) { max_depth <- attr(x, "max_depth") %||% 5L max_length <- attr(x, "max_length") %||% 100L - max_vec_len <- attr(x, "max_vec_len") %||% 3L tree_args <- attr(x, "tree_args") %||% list() # Strip attributes before printing attr(x, "max_depth") <- NULL attr(x, "max_length") <- NULL - attr(x, "max_vec_len") <- NULL attr(x, "tree_args") <- NULL + # Defaults for `tree()` arguments that are not directly exposed by `src()` + tree_args$max_vec_len <- tree_args$max_vec_len %||% 3L + inject(tree( x = x, max_depth = max_depth, max_length = max_length, - max_vec_len = max_vec_len, !!!tree_args )) @@ -254,10 +250,10 @@ tree_label.lobstr_srcfile_ref <- function(x, opts) { # Main extraction logic -------------------------------------------------------- -src_extract <- function(x, max_lines, seen_srcfiles) { +src_extract <- function(x, seen_srcfiles) { # Srcref object if (inherits(x, "srcref")) { - return(srcref_node(x, max_lines, seen_srcfiles)) + return(srcref_node(x, seen_srcfiles)) } # List of srcrefs @@ -266,30 +262,29 @@ src_extract <- function(x, max_lines, seen_srcfiles) { length(x) > 0 && all(vapply(x, inherits, logical(1), "srcref")) ) { - return(srcref_list_node(x, max_lines, seen_srcfiles)) + return(srcref_list_node(x, seen_srcfiles)) } # Evaluated closures if (is_closure(x)) { - return(function_node(x, max_lines, seen_srcfiles)) + return(function_node(x, seen_srcfiles)) } # Expressions and language objects if (is.expression(x) || is.language(x)) { - return(expr_node(x, max_lines, seen_srcfiles)) + return(expr_node(x, seen_srcfiles)) } NULL } # Extract standard srcref-related attributes from any object -extract_srcref_attrs <- function(x, max_lines, seen_srcfiles) { +extract_srcref_attrs <- function(x, seen_srcfiles) { attrs <- list() if (!is.null(srcref <- attr(x, "srcref"))) { attrs$`attr("srcref")` <- process_srcref_attr( srcref, - max_lines, seen_srcfiles ) } @@ -298,26 +293,25 @@ extract_srcref_attrs <- function(x, max_lines, seen_srcfiles) { attrs$`attr("srcfile")` <- srcfile_node( srcfile, NULL, - max_lines, seen_srcfiles ) } if (!is.null(whole <- attr(x, "wholeSrcref"))) { - attrs$`attr("wholeSrcref")` <- srcref_node(whole, max_lines, seen_srcfiles) + attrs$`attr("wholeSrcref")` <- srcref_node(whole, seen_srcfiles) } attrs } -process_srcref_attr <- function(srcref_attr, max_lines, seen_srcfiles) { +process_srcref_attr <- function(srcref_attr, seen_srcfiles) { if (inherits(srcref_attr, "srcref")) { - return(srcref_node(srcref_attr, max_lines, seen_srcfiles)) + return(srcref_node(srcref_attr, seen_srcfiles)) } if (is.list(srcref_attr)) { srcrefs <- lapply(seq_along(srcref_attr), function(i) { - srcref_node(srcref_attr[[i]], max_lines, seen_srcfiles) + srcref_node(srcref_attr[[i]], seen_srcfiles) }) names(srcrefs) <- paste0("[[", seq_along(srcrefs), "]]") return(new_srcref_tree(srcrefs, type = "list")) @@ -326,7 +320,7 @@ process_srcref_attr <- function(srcref_attr, max_lines, seen_srcfiles) { stop("unreachable") } -srcref_node <- function(srcref, max_lines, seen_srcfiles) { +srcref_node <- function(srcref, seen_srcfiles) { info <- srcref_info(srcref) node <- list(location = info$location) @@ -338,29 +332,29 @@ srcref_node <- function(srcref, max_lines, seen_srcfiles) { } # Just for completeness but we really don't expect srcref attributes on srcrefs - attrs <- extract_srcref_attrs(srcref, max_lines, seen_srcfiles) + attrs <- extract_srcref_attrs(srcref, seen_srcfiles) node <- c(node, attrs) new_srcref_tree(node, type = "srcref") } -srcref_list_node <- function(srcref_list, max_lines, seen_srcfiles) { - srcrefs <- lapply(srcref_list, srcref_node, max_lines, seen_srcfiles) +srcref_list_node <- function(srcref_list, seen_srcfiles) { + srcrefs <- lapply(srcref_list, srcref_node, seen_srcfiles) node <- list( count = length(srcref_list), srcrefs = new_srcref_tree(srcrefs, type = "list") ) - attrs <- extract_srcref_attrs(srcref_list, max_lines, seen_srcfiles) + attrs <- extract_srcref_attrs(srcref_list, seen_srcfiles) node <- c(node, attrs) new_srcref_tree(node, type = "list") } -function_node <- function(fun, max_lines, seen_srcfiles) { - node <- extract_srcref_attrs(fun, max_lines, seen_srcfiles) - body <- src_extract(body(fun), max_lines, seen_srcfiles) +function_node <- function(fun, seen_srcfiles) { + node <- extract_srcref_attrs(fun, seen_srcfiles) + body <- src_extract(body(fun), seen_srcfiles) if (!is.null(body)) { node$`body()` <- as_srcref_tree(body, from = body(fun)) @@ -373,9 +367,9 @@ function_node <- function(fun, max_lines, seen_srcfiles) { new_srcref_tree(node, type = "closure") } -expr_node <- function(x, max_lines, seen_srcfiles) { - attrs <- extract_srcref_attrs(x, max_lines, seen_srcfiles) - nested <- extract_nested_srcrefs(x, max_lines, seen_srcfiles) +expr_node <- function(x, seen_srcfiles) { + attrs <- extract_srcref_attrs(x, seen_srcfiles) + nested <- extract_nested_srcrefs(x, seen_srcfiles) if (length(attrs) > 0) { # Node has attributes: wrap with proper type @@ -391,14 +385,14 @@ expr_node <- function(x, max_lines, seen_srcfiles) { } } -extract_nested_srcrefs <- function(x, max_lines, seen_srcfiles) { +extract_nested_srcrefs <- function(x, seen_srcfiles) { if (!is_traversable(x)) { return(list()) } nested <- list() for (i in seq_along(x)) { - child <- src_extract(x[[i]], max_lines, seen_srcfiles) + child <- src_extract(x[[i]], seen_srcfiles) if (!is.null(child)) { nested <- merge_child_result(nested, child, i) @@ -458,7 +452,7 @@ as_srcref_tree <- function(data, ..., from) { # Srcfile handling ------------------------------------------------------------- -srcfile_node <- function(srcfile, srcref, max_lines, seen_srcfiles) { +srcfile_node <- function(srcfile, srcref, seen_srcfiles) { if (is.null(srcfile)) { return(NULL) } @@ -486,19 +480,19 @@ srcfile_node <- function(srcfile, srcref, max_lines, seen_srcfiles) { # Process nested srcfile objects (e.g., 'original' in srcfilealias) if (!is.null(info$original) && inherits(info$original, "srcfile")) { - info$original <- srcfile_node(info$original, NULL, max_lines, seen_srcfiles) + info$original <- srcfile_node(info$original, NULL, seen_srcfiles) } # Add source preview for plain srcfiles if (!inherits(srcfile, "srcfilecopy") && !is.null(srcref)) { - snippet <- srcfile_lines(srcfile, srcref, max_lines) + snippet <- srcfile_lines(srcfile, srcref) if (length(snippet) > 0) { info$`lines (from file)` <- snippet } } # Check for srcref attributes even on srcfile objects - attrs <- extract_srcref_attrs(srcfile, max_lines, seen_srcfiles) + attrs <- extract_srcref_attrs(srcfile, seen_srcfiles) info <- c(info, attrs) new_srcref_tree( @@ -509,13 +503,15 @@ srcfile_node <- function(srcfile, srcref, max_lines, seen_srcfiles) { ) } -srcfile_lines <- function(srcfile, srcref, max_lines) { +srcfile_lines <- function(srcfile, srcref) { if (is.null(srcfile) || is.null(srcref)) { return(character(0)) } + max_lines <- 3L + first_line <- srcref[[1]] - last_line <- min(srcref[[3]], first_line + max_lines - 1) + last_line <- min(srcref[[3]], first_line + max_lines - 1L) # Try embedded lines first lines <- srcfile$lines diff --git a/tests/testthat/_snaps/src-snapshots.md b/tests/testthat/_snaps/src-snapshots.md index 5ddbeb8..1ee1049 100644 --- a/tests/testthat/_snaps/src-snapshots.md +++ b/tests/testthat/_snaps/src-snapshots.md @@ -653,57 +653,6 @@ ├─location: 1:0 - 1:26 └─attr("srcfile"): @001 -# src() respects max_vec_len parameter - - Code - x <- parse(text = paste(rep("1", 10), collapse = "\n"), keep.source = TRUE) - scrub_src(src(x, max_vec_len = 2)) - Output - - ├─attr("srcref"): - │ ├─[[1]]: - │ │ ├─location: 1:1 - 1:1 - │ │ └─attr("srcfile"): @001 - │ │ ├─Enc: "unknown" - │ │ ├─filename: "" - │ │ ├─fixedNewlines: TRUE - │ │ ├─isFile: FALSE - │ │ ├─lines: "1", "1", ... - │ │ ├─parseData: 1, 1, ... - │ │ ├─timestamp: "" - │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." - │ ├─[[2]]: - │ │ ├─location: 2:1 - 2:1 - │ │ └─attr("srcfile"): @001 - │ ├─[[3]]: - │ │ ├─location: 3:1 - 3:1 - │ │ └─attr("srcfile"): @001 - │ ├─[[4]]: - │ │ ├─location: 4:1 - 4:1 - │ │ └─attr("srcfile"): @001 - │ ├─[[5]]: - │ │ ├─location: 5:1 - 5:1 - │ │ └─attr("srcfile"): @001 - │ ├─[[6]]: - │ │ ├─location: 6:1 - 6:1 - │ │ └─attr("srcfile"): @001 - │ ├─[[7]]: - │ │ ├─location: 7:1 - 7:1 - │ │ └─attr("srcfile"): @001 - │ ├─[[8]]: - │ │ ├─location: 8:1 - 8:1 - │ │ └─attr("srcfile"): @001 - │ ├─[[9]]: - │ │ ├─location: 9:1 - 9:1 - │ │ └─attr("srcfile"): @001 - │ └─[[10]]: - │ ├─location: 10:1 - 10:1 - │ └─attr("srcfile"): @001 - ├─attr("srcfile"): @001 - └─attr("wholeSrcref"): - ├─location: 1:0 - 11:0 - └─attr("srcfile"): @001 - # src() respects show_source_lines parameter Code diff --git a/tests/testthat/test-src-snapshots.R b/tests/testthat/test-src-snapshots.R index b815c33..4ee97d9 100644 --- a/tests/testthat/test-src-snapshots.R +++ b/tests/testthat/test-src-snapshots.R @@ -245,13 +245,6 @@ test_that("src() handles if statement with blocks", { # Test: Parameters -------------------------------------------------------------- -test_that("src() respects max_vec_len parameter", { - expect_snapshot({ - x <- parse(text = paste(rep("1", 10), collapse = "\n"), keep.source = TRUE) - scrub_src(src(x, max_vec_len = 2)) - }) -}) - test_that("src() respects show_source_lines parameter", { expect_snapshot({ f <- simple_function_with_srcref() diff --git a/tests/testthat/test-src.R b/tests/testthat/test-src.R index bfa3c9e..14499e6 100644 --- a/tests/testthat/test-src.R +++ b/tests/testthat/test-src.R @@ -74,7 +74,7 @@ test_that("srcfile_node handles srcfilecopy", { srcref <- attr(expr, "srcref")[[1]] seen_srcfiles <- new.env(parent = emptyenv()) - info <- lobstr:::srcfile_node(srcfile, srcref, 3, seen_srcfiles) + info <- lobstr:::srcfile_node(srcfile, srcref, seen_srcfiles) expect_equal(attr(info, "srcfile_class"), class(srcfile)[1]) expect_type(info$filename, "character") @@ -83,7 +83,7 @@ test_that("srcfile_node handles srcfilecopy", { test_that("srcfile_node handles NULL gracefully", { seen_srcfiles <- new.env(parent = emptyenv()) - info <- lobstr:::srcfile_node(NULL, NULL, 3, seen_srcfiles) + info <- lobstr:::srcfile_node(NULL, NULL, seen_srcfiles) expect_null(info) }) @@ -93,7 +93,7 @@ test_that("srcfile_lines extracts from srcfilecopy", { srcref <- attr(expr, "srcref")[[1]] srcfile <- attr(srcref, "srcfile") - snippet <- lobstr:::srcfile_lines(srcfile, srcref, max_lines = 3) + snippet <- lobstr:::srcfile_lines(srcfile, srcref) expect_type(snippet, "character") expect_true(length(snippet) >= 1) @@ -110,9 +110,10 @@ test_that("srcfile_lines respects max_lines", { srcfile = srcfile ) - snippet <- lobstr:::srcfile_lines(srcfile, srcref, max_lines = 2) + snippet <- lobstr:::srcfile_lines(srcfile, srcref) - expect_true(length(snippet) <= 2) + expect_type(snippet, "character") + expect_lte(length(snippet), 3) }) test_that("srcref_location works correctly", { @@ -275,11 +276,9 @@ test_that("srcfile_lines handles missing files gracefully", { # Point to a non-existent file srcfile$filename <- "nonexistent_file.R" - snippet <- lobstr:::srcfile_lines(srcfile, srcref, max_lines = 3) + snippet <- lobstr:::srcfile_lines(srcfile, srcref) expect_type(snippet, "character") - # May still have cached lines, so just check it's character - expect_true(length(snippet) >= 0) }) # Srcfile deduplication tests -------------------------------------------------- From 030bc580bd7bd26c7b8d8585c373adcbeebbb0b3 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Mon, 17 Nov 2025 15:00:02 +0100 Subject: [PATCH 08/28] Consolidate tests --- R/src.R | 2 +- .../_snaps/{src-snapshots.md => src.md} | 48 ++-- tests/testthat/helper-src.R | 16 +- tests/testthat/test-src-snapshots.R | 272 ------------------ tests/testthat/test-src.R | 243 ++++++++++++++++ 5 files changed, 283 insertions(+), 298 deletions(-) rename tests/testthat/_snaps/{src-snapshots.md => src.md} (94%) delete mode 100644 tests/testthat/test-src-snapshots.R diff --git a/R/src.R b/R/src.R index f4ff77f..bc88823 100644 --- a/R/src.R +++ b/R/src.R @@ -239,7 +239,7 @@ tree_label.srcref <- function(x, opts) { #' @export tree_label.srcfile <- function(x, opts) { - paste0("<", class(x)[1], ": ", getSrcFilename(x), ">") + paste0("<", class(x)[1], ": ", utils::getSrcFilename(x), ">") } #' @export diff --git a/tests/testthat/_snaps/src-snapshots.md b/tests/testthat/_snaps/src.md similarity index 94% rename from tests/testthat/_snaps/src-snapshots.md rename to tests/testthat/_snaps/src.md index 1ee1049..e32c2e1 100644 --- a/tests/testthat/_snaps/src-snapshots.md +++ b/tests/testthat/_snaps/src.md @@ -15,7 +15,7 @@ │ ├─lines: "test_func <-...", " x + y", "}" │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" └─body(): <{> ├─attr("srcref"): │ ├─[[1]]: @@ -46,7 +46,7 @@ │ ├─lines: "multi_func <...", " a <- x + 1", " b <- a * 2", ... │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" └─body(): <{> ├─attr("srcref"): │ ├─[[1]]: @@ -88,7 +88,7 @@ │ │ ├─lines: "x <- quote(function() {})" │ │ ├─parseData: 1, 1, 1, ...... │ │ ├─timestamp: "" - │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ │ └─wd: "" │ ├─attr("srcfile"): @001 │ └─attr("wholeSrcref"): │ ├─location: 1:0 - 1:24 @@ -115,7 +115,7 @@ │ ├─lines: "x <- quote(function() {})" │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 1:24 @@ -140,7 +140,7 @@ │ │ ├─lines: "x <- quote(function(a, b) {})" │ │ ├─parseData: 1, 1, 1, ...... │ │ ├─timestamp: "" - │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ │ └─wd: "" │ ├─attr("srcfile"): @001 │ └─attr("wholeSrcref"): │ ├─location: 1:0 - 1:28 @@ -168,7 +168,7 @@ ├─isFile: FALSE ├─lines: "x <- functio...", " # A long c...", " # multiple...", ... ├─timestamp: "" - └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─wd: "" # src() shows expression with single element @@ -188,7 +188,7 @@ │ ├─lines: "x + 1" │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 2:0 @@ -212,7 +212,7 @@ │ │ ├─lines: "x + 1", "y + 2", "z + 3" │ │ ├─parseData: 1, 1, 1, ... │ │ ├─timestamp: "" - │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ │ └─wd: "" │ ├─[[2]]: │ │ ├─location: 2:1 - 2:5 │ │ └─attr("srcfile"): @001 @@ -242,7 +242,7 @@ │ ├─lines: "{", " 1", "}" │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 4:0 @@ -278,7 +278,7 @@ │ │ ├─lines: "{", " 1", "}" │ │ ├─parseData: 1, 1, 1, ... │ │ ├─timestamp: "" - │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ │ └─wd: "" │ └─[[2]]: │ ├─location: 2:3 - 2:3 │ └─attr("srcfile"): @001 @@ -305,7 +305,7 @@ │ │ ├─lines: "{", " a <- 1", " b <- 2", ... │ │ ├─parseData: 1, 1, 1, ... │ │ ├─timestamp: "" - │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ │ └─wd: "" │ ├─[[2]]: │ │ ├─location: 2:3 - 2:8 │ │ └─attr("srcfile"): @001 @@ -334,7 +334,7 @@ ├─lines: "x + 1" ├─parseData: 1, 1, 1, ... ├─timestamp: "" - └─wd: "/Users/lionel/Sync/Projects/R/r-..." + └─wd: "" # src() shows list of srcrefs with count @@ -356,7 +356,7 @@ │ ├─lines: "x + 1", "y + 2" │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" └─ ├─location: 2:1 - 2:5 └─attr("srcfile"): @001 @@ -379,7 +379,7 @@ │ │ ├─lines: "x <- quote(function() { 1 })" │ │ ├─parseData: 1, 1, 1, ... │ │ ├─timestamp: "" - │ │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ │ └─wd: "" │ └─[[2]]: │ ├─location: 1:25 - 1:25 │ └─attr("srcfile"): @001 @@ -406,7 +406,7 @@ │ ├─lines: "foo({ if (1) bar({ 2 }) })" │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 2:0 @@ -453,7 +453,7 @@ │ ├─lines: "f <- function() foo({ if (1) bar..." │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" └─body(): └─[[2]]: <{> ├─attr("srcref"): @@ -497,7 +497,7 @@ │ ├─lines: "test_func <-...", " x + y", "}" │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" └─body(): <{> ├─attr("srcref"): │ ├─[[1]]: @@ -529,7 +529,7 @@ │ ├─lines: "{", " 1", " 2", ... │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 5:0 @@ -568,7 +568,7 @@ │ ├─lines: "{}" │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" ├─attr("srcfile"): @001 └─attr("wholeSrcref"): ├─location: 1:0 - 1:2 @@ -591,7 +591,7 @@ │ ├─lines: "f <- function() { NULL }" │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" └─body(): <{> ├─attr("srcref"): │ ├─[[1]]: @@ -623,7 +623,7 @@ │ ├─lines: "if (TRUE) { 1 } else { 2 }" │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 2:0 @@ -670,7 +670,7 @@ │ ├─lines: "test_func <-...", " x + y", "}" │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" └─body(): <{> ├─attr("srcref"): │ ├─[[1]]: @@ -702,7 +702,7 @@ │ ├─lines: "{", " {", " 1", ... │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" ├─attr("srcfile"): @001 ├─attr("wholeSrcref"): │ ├─location: 1:0 - 9:0 @@ -764,7 +764,7 @@ │ ├─lines: "f <- functio...", " if (x) {", " 1", ... │ ├─parseData: 1, 1, 1, ... │ ├─timestamp: "" - │ └─wd: "/Users/lionel/Sync/Projects/R/r-..." + │ └─wd: "" └─body(): <{> ├─attr("srcref"): │ ├─[[1]]: diff --git a/tests/testthat/helper-src.R b/tests/testthat/helper-src.R index ee661e7..ed26d13 100644 --- a/tests/testthat/helper-src.R +++ b/tests/testthat/helper-src.R @@ -1,4 +1,18 @@ -# Helper functions for testing source reference functionality +#' Scrub src() output for deterministic snapshots +scrub_src <- function(x) { + # Capture the output as text + output <- capture.output(print(x)) + + output <- gsub('filename: "[^"]+"', 'filename: ""', output) + output <- gsub('directory: "[^"]+"', 'directory: ""', output) + output <- gsub('timestamp: "[^"]+"', 'timestamp: ""', output) + output <- gsub('wd: "[^"]+"', 'wd: ""', output) + + # Print the scrubbed output + cat(output, sep = "\n") + + invisible(x) +} #' Create a function or expression with source references #' diff --git a/tests/testthat/test-src-snapshots.R b/tests/testthat/test-src-snapshots.R deleted file mode 100644 index 4ee97d9..0000000 --- a/tests/testthat/test-src-snapshots.R +++ /dev/null @@ -1,272 +0,0 @@ -# Snapshot tests for src() output -# -# These tests capture the current behavior before implementing Phase 1 -# (srcfile deduplication) and Phase 2 (deep AST walking). - -# Helper to scrub non-deterministic parts from src() output -------------------- - -#' Scrub src() output for deterministic snapshots -#' -#' Replaces filenames, directories, and timestamps with stable values -scrub_src <- function(x) { - # Capture the output as text - output <- capture.output(print(x)) - - # Scrub filenames: replace with generic placeholder - output <- gsub('filename: "[^"]+"', 'filename: ""', output) - - # Scrub directories: replace with ... - output <- gsub('directory: "[^"]+"', 'directory: "..."', output) - - # Scrub timestamps: replace with a fixed value - output <- gsub('timestamp: "[^"]+"', 'timestamp: ""', output) - - # Print the scrubbed output - cat(output, sep = "\n") - - invisible(x) -} - -# Test: Closures (evaluated functions) ------------------------------------------ - -test_that("src() shows closure with srcref and wholeSrcref", { - expect_snapshot({ - f <- simple_function_with_srcref() - scrub_src(src(f)) - }) -}) - -test_that("src() shows multi-statement function", { - expect_snapshot({ - f <- multi_statement_function_with_srcref() - scrub_src(src(f)) - }) -}) - -# Test: Quoted functions -------------------------------------------------------- - -test_that("src() shows quoted function with nested body", { - expect_snapshot({ - with_srcref("x <- quote(function() {})") - scrub_src(src(x)) - }) -}) - -test_that("src() shows quoted function body directly", { - expect_snapshot({ - with_srcref("x <- quote(function() {})") - scrub_src(src(x[[3]])) - }) -}) - -test_that("src() shows quoted function with arguments", { - expect_snapshot({ - with_srcref("x <- quote(function(a, b) {})") - scrub_src(src(x)) - }) -}) - -test_that("src() shows srcref with parsed field when positions differ", { - expect_snapshot({ - # Create a synthetic 8-element srcref where parsed positions differ - # Format: c(first_line, first_byte, last_line, last_byte, - # first_col, last_col, first_parsed, last_parsed) - # This simulates a case where R's parser reports different positions - # than the actual source locations (e.g., due to string continuations) - srcfile <- srcfilecopy( - "test.R", - c( - "x <- function() {", - " # A long comment that spans", - " # multiple lines", - " y <- 1", - "}" - ) - ) - - synthetic_srcref <- structure( - c(2L, 3L, 4L, 8L, 3L, 8L, 1L, 5L), - class = "srcref", - srcfile = srcfile - ) - - scrub_src(src(synthetic_srcref)) - }) -}) - -# Test: Expression objects ------------------------------------------------------ - -test_that("src() shows expression with single element", { - expect_snapshot({ - x <- parse(text = "x + 1", keep.source = TRUE) - scrub_src(src(x)) - }) -}) - -test_that("src() shows expression with multiple elements", { - expect_snapshot({ - x <- parse(text = c("x + 1", "y + 2", "z + 3"), keep.source = TRUE) - scrub_src(src(x)) - }) -}) - -test_that("src() shows expression with nested block and wholeSrcref", { - expect_snapshot({ - x <- parse(text = "{\n 1\n}", keep.source = TRUE) - scrub_src(src(x)) - }) -}) - -test_that("src() shows nested block element directly", { - expect_snapshot({ - x <- parse(text = "{\n 1\n}", keep.source = TRUE) - scrub_src(src(x[[1]])) - }) -}) - -# Test: Blocks with wholeSrcref ------------------------------------------------- - -test_that("src() shows block with srcref list and wholeSrcref", { - expect_snapshot({ - x <- parse(text = "{\n a <- 1\n b <- 2\n}", keep.source = TRUE) - scrub_src(src(x[[1]])) - }) -}) - -# Test: Single srcref objects --------------------------------------------------- - -test_that("src() shows single srcref", { - expect_snapshot({ - x <- parse(text = "x + 1", keep.source = TRUE) - sr <- attr(x, "srcref")[[1]] - scrub_src(src(sr)) - }) -}) - -# Test: List of srcrefs --------------------------------------------------------- - -test_that("src() shows list of srcrefs with count", { - expect_snapshot({ - x <- parse(text = c("x + 1", "y + 2"), keep.source = TRUE) - sr_list <- attr(x, "srcref") - scrub_src(src(sr_list)) - }) -}) - -# Test: Srcref lists shown as with [[1]], [[2]] notation ---------------- - -test_that("src() reveals srcref list structure with index notation", { - expect_snapshot({ - with_srcref("x <- quote(function() { 1 })") - scrub_src(src(x[[3]])) - }) -}) - -test_that("src() handles srcrefs nested in language calls", { - expect_snapshot({ - x <- parse(text = "foo({ if (1) bar({ 2 }) })", keep.source = TRUE) - scrub_src(src(x, max_depth = 10)) - }) -}) - -test_that("src() handles srcrefs nested in function bodies", { - expect_snapshot({ - with_srcref("f <- function() foo({ if (1) bar({ 2 }) })") - scrub_src(src(f, max_depth = 10)) - }) -}) - -# Test: Type labels ------------------------------------------------------------- - -test_that("src() uses correct type labels", { - # Closure - f <- simple_function_with_srcref() - result_closure <- src(f) - expect_equal(attr(result_closure, "srcref_type"), "closure") - - # Quoted function - with_srcref("x <- quote(function() {})") - result_quoted <- src(x) - expect_equal(attr(result_quoted, "srcref_type"), "quoted_function") - - # Expression - expr <- parse(text = "1 + 1", keep.source = TRUE) - result_expr <- src(expr) - expect_equal(attr(result_expr, "srcref_type"), "expression") - - # Block - block <- parse(text = "{1}", keep.source = TRUE)[[1]] - result_block <- src(block) - expect_equal(attr(result_block, "srcref_type"), "block") -}) - -# Test: Srcfile duplication (current behavior - will change in Phase 1) -------- - -test_that("src() currently shows duplicate srcfile objects", { - expect_snapshot({ - # Current behavior: srcfile appears twice (in srcref and wholeSrcref) - # After Phase 1: should use reference notation like @abc123 - f <- simple_function_with_srcref() - scrub_src(src(f)) - }) -}) - -test_that("src() shows many duplicate srcfiles in nested expression", { - expect_snapshot({ - # Current behavior: same srcfile appears many times - # After Phase 1: these should be deduplicated - x <- parse(text = "{\n 1\n 2\n}", keep.source = TRUE) - scrub_src(src(x)) - }) -}) - -# Test: Edge cases -------------------------------------------------------------- - -test_that("src() handles empty block", { - expect_snapshot({ - x <- parse(text = "{}", keep.source = TRUE) - scrub_src(src(x[[1]])) - }) -}) - -test_that("src() handles function without arguments", { - expect_snapshot({ - with_srcref("f <- function() { NULL }") - scrub_src(src(f)) - }) -}) - -test_that("src() handles if statement with blocks", { - expect_snapshot({ - x <- parse(text = "if (TRUE) { 1 } else { 2 }", keep.source = TRUE) - scrub_src(src(x)) - }) -}) - -# Test: Parameters -------------------------------------------------------------- - -test_that("src() respects show_source_lines parameter", { - expect_snapshot({ - f <- simple_function_with_srcref() - scrub_src(src(f)) - }) -}) - -# Test: Complex nested structures ----------------------------------------------- - -test_that("src() shows expression with multiple nested blocks", { - expect_snapshot({ - x <- parse( - text = "{\n {\n 1\n }\n {\n 2\n }\n}", - keep.source = TRUE - ) - scrub_src(src(x)) - }) -}) - -test_that("src() shows function with nested block in body", { - expect_snapshot({ - with_srcref("f <- function(x) {\n if (x) {\n 1\n }\n}") - scrub_src(src(f)) - }) -}) diff --git a/tests/testthat/test-src.R b/tests/testthat/test-src.R index 14499e6..52c0655 100644 --- a/tests/testthat/test-src.R +++ b/tests/testthat/test-src.R @@ -1,3 +1,246 @@ +# Test: Closures (evaluated functions) ------------------------------------------ + +test_that("src() shows closure with srcref and wholeSrcref", { + expect_snapshot({ + f <- simple_function_with_srcref() + scrub_src(src(f)) + }) +}) + +test_that("src() shows multi-statement function", { + expect_snapshot({ + f <- multi_statement_function_with_srcref() + scrub_src(src(f)) + }) +}) + +# Test: Quoted functions -------------------------------------------------------- + +test_that("src() shows quoted function with nested body", { + expect_snapshot({ + with_srcref("x <- quote(function() {})") + scrub_src(src(x)) + }) +}) + +test_that("src() shows quoted function body directly", { + expect_snapshot({ + with_srcref("x <- quote(function() {})") + scrub_src(src(x[[3]])) + }) +}) + +test_that("src() shows quoted function with arguments", { + expect_snapshot({ + with_srcref("x <- quote(function(a, b) {})") + scrub_src(src(x)) + }) +}) + +test_that("src() shows srcref with parsed field when positions differ", { + expect_snapshot({ + # Create a synthetic 8-element srcref where parsed positions differ + # Format: c(first_line, first_byte, last_line, last_byte, + # first_col, last_col, first_parsed, last_parsed) + # This simulates a case where R's parser reports different positions + # than the actual source locations (e.g., due to string continuations) + srcfile <- srcfilecopy( + "test.R", + c( + "x <- function() {", + " # A long comment that spans", + " # multiple lines", + " y <- 1", + "}" + ) + ) + + synthetic_srcref <- structure( + c(2L, 3L, 4L, 8L, 3L, 8L, 1L, 5L), + class = "srcref", + srcfile = srcfile + ) + + scrub_src(src(synthetic_srcref)) + }) +}) + +# Test: Expression objects ------------------------------------------------------ + +test_that("src() shows expression with single element", { + expect_snapshot({ + x <- parse(text = "x + 1", keep.source = TRUE) + scrub_src(src(x)) + }) +}) + +test_that("src() shows expression with multiple elements", { + expect_snapshot({ + x <- parse(text = c("x + 1", "y + 2", "z + 3"), keep.source = TRUE) + scrub_src(src(x)) + }) +}) + +test_that("src() shows expression with nested block and wholeSrcref", { + expect_snapshot({ + x <- parse(text = "{\n 1\n}", keep.source = TRUE) + scrub_src(src(x)) + }) +}) + +test_that("src() shows nested block element directly", { + expect_snapshot({ + x <- parse(text = "{\n 1\n}", keep.source = TRUE) + scrub_src(src(x[[1]])) + }) +}) + +# Test: Blocks with wholeSrcref ------------------------------------------------- + +test_that("src() shows block with srcref list and wholeSrcref", { + expect_snapshot({ + x <- parse(text = "{\n a <- 1\n b <- 2\n}", keep.source = TRUE) + scrub_src(src(x[[1]])) + }) +}) + +# Test: Single srcref objects --------------------------------------------------- + +test_that("src() shows single srcref", { + expect_snapshot({ + x <- parse(text = "x + 1", keep.source = TRUE) + sr <- attr(x, "srcref")[[1]] + scrub_src(src(sr)) + }) +}) + +# Test: List of srcrefs --------------------------------------------------------- + +test_that("src() shows list of srcrefs with count", { + expect_snapshot({ + x <- parse(text = c("x + 1", "y + 2"), keep.source = TRUE) + sr_list <- attr(x, "srcref") + scrub_src(src(sr_list)) + }) +}) + +# Test: Srcref lists shown as with [[1]], [[2]] notation ---------------- + +test_that("src() reveals srcref list structure with index notation", { + expect_snapshot({ + with_srcref("x <- quote(function() { 1 })") + scrub_src(src(x[[3]])) + }) +}) + +test_that("src() handles srcrefs nested in language calls", { + expect_snapshot({ + x <- parse(text = "foo({ if (1) bar({ 2 }) })", keep.source = TRUE) + scrub_src(src(x, max_depth = 10)) + }) +}) + +test_that("src() handles srcrefs nested in function bodies", { + expect_snapshot({ + with_srcref("f <- function() foo({ if (1) bar({ 2 }) })") + scrub_src(src(f, max_depth = 10)) + }) +}) + +# Test: Type labels ------------------------------------------------------------- + +test_that("src() uses correct type labels", { + # Closure + f <- simple_function_with_srcref() + result_closure <- src(f) + expect_equal(attr(result_closure, "srcref_type"), "closure") + + # Quoted function + with_srcref("x <- quote(function() {})") + result_quoted <- src(x) + expect_equal(attr(result_quoted, "srcref_type"), "quoted_function") + + # Expression + expr <- parse(text = "1 + 1", keep.source = TRUE) + result_expr <- src(expr) + expect_equal(attr(result_expr, "srcref_type"), "expression") + + # Block + block <- parse(text = "{1}", keep.source = TRUE)[[1]] + result_block <- src(block) + expect_equal(attr(result_block, "srcref_type"), "block") +}) + +# Test: Srcfile duplication (current behavior - will change in Phase 1) -------- + +test_that("src() currently shows duplicate srcfile objects", { + expect_snapshot({ + # Current behavior: srcfile appears twice (in srcref and wholeSrcref) + # After Phase 1: should use reference notation like @abc123 + f <- simple_function_with_srcref() + scrub_src(src(f)) + }) +}) + +test_that("src() shows many duplicate srcfiles in nested expression", { + expect_snapshot({ + # Current behavior: same srcfile appears many times + # After Phase 1: these should be deduplicated + x <- parse(text = "{\n 1\n 2\n}", keep.source = TRUE) + scrub_src(src(x)) + }) +}) + +# Test: Edge cases -------------------------------------------------------------- + +test_that("src() handles empty block", { + expect_snapshot({ + x <- parse(text = "{}", keep.source = TRUE) + scrub_src(src(x[[1]])) + }) +}) + +test_that("src() handles function without arguments", { + expect_snapshot({ + with_srcref("f <- function() { NULL }") + scrub_src(src(f)) + }) +}) + +test_that("src() handles if statement with blocks", { + expect_snapshot({ + x <- parse(text = "if (TRUE) { 1 } else { 2 }", keep.source = TRUE) + scrub_src(src(x)) + }) +}) + +# Test: Parameters -------------------------------------------------------------- + +test_that("src() respects show_source_lines parameter", { + expect_snapshot({ + f <- simple_function_with_srcref() + scrub_src(src(f)) + }) +}) + +# Test: Complex nested structures ----------------------------------------------- + +test_that("src() shows expression with multiple nested blocks", { + expect_snapshot({ + x <- parse( + text = "{\n {\n 1\n }\n {\n 2\n }\n}", + keep.source = TRUE + ) + scrub_src(src(x)) + }) +}) + +test_that("src() shows function with nested block in body", { + expect_snapshot({ + with_srcref("f <- function(x) {\n if (x) {\n 1\n }\n}") + scrub_src(src(f)) + }) +}) # Tests for src() function and helpers # Helper function tests -------------------------------------------------------- From 042b914f26d6accc483e10d856ee0e1ff08306cd Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Mon, 17 Nov 2025 15:16:04 +0100 Subject: [PATCH 09/28] Add note about strange installed `filename` --- R/src.R | 5 ++++- man/src.Rd | 5 ++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/R/src.R b/R/src.R index bc88823..14e85de 100644 --- a/R/src.R +++ b/R/src.R @@ -147,7 +147,10 @@ #' The source files are converted to the encoding of the system locale, then #' collated in a single source file with `#line` directives mapping them to their #' original file names (with full paths): -#' +#' . +#' +#' Note that the `filename` of the `original` srcfile incorrectly points to the +#' package path in the install destination. #' #' #' Fields: diff --git a/man/src.Rd b/man/src.Rd index abde3eb..9a3203a 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -163,7 +163,10 @@ Called by \code{install.packages()} when installing a \emph{source} package with The source files are converted to the encoding of the system locale, then collated in a single source file with \verb{#line} directives mapping them to their original file names (with full paths): -\url{https://github.com/r-devel/r-svn/blob/52affc16/src/library/tools/R/admin.R#L342} +\url{https://github.com/r-devel/r-svn/blob/52affc16/src/library/tools/R/admin.R#L342}. + +Note that the \code{filename} of the \code{original} srcfile incorrectly points to the +package path in the install destination. Fields: \itemize{ From b289068c0f1df8b0c7a9fc18c5a731b8c253dfca Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Mon, 17 Nov 2025 15:45:41 +0100 Subject: [PATCH 10/28] Comment on `wholeSrcref` with `{` calls --- R/src.R | 24 +++++++++++++++++++++++- man/src.Rd | 23 ++++++++++++++++++++++- 2 files changed, 45 insertions(+), 2 deletions(-) diff --git a/R/src.R b/R/src.R index 14e85de..59c3abb 100644 --- a/R/src.R +++ b/R/src.R @@ -26,6 +26,7 @@ #' - `srcfile` objects, which contain metadata about the source file #' such as its name, path, and encoding. #' +#' #' ## `srcref` objects #' #' `srcref` objects are compact integer vectors describing a character range @@ -48,6 +49,26 @@ #' #' They have a `srcfile` attribute that points to the source file. #' +#' +#' ### `wholeSrcref` attributes +#' +#' These are `srcref` objects stored in the `wholeSrcref` attributes of: +#' +#' - Expression vectors returned by `parse()`, which seems to be the intended +#' usage. +#' - `{` calls, which seems unintended. +#' +#' For expression vectors, the `wholeSrcref` spans from the first position +#' to the last position and represents the entire document. For braces, they +#' span from the first position to the location of the closing brace. There is +#' no way to know the location of the opening brace without reparsing, which +#' seems odd. It's probably an overlook from `xxexprlist()` calling +#' `attachSrcrefs()` in +#' . That +#' function is also called at the end of parsing, where it's intended for the +#' `wholeSrcref` attribute to be attached. +#' +#' #' ## `srcfile` objects #' #' `srcfile` objects are environments representing information about a @@ -56,7 +77,8 @@ #' and encoding information. A plain `srcfile` is lightweight and opens #' the underlying file lazily when content is needed. #' -#' There are multiple subclasses of `srcfile`. +#' While it is possible to create bare `srcfile` objects, specialized subclasses +#' are much more common. #' #' #' ### `srcfile` diff --git a/man/src.Rd b/man/src.Rd index 9a3203a..6e7f3ed 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -66,6 +66,26 @@ reference. } They have a \code{srcfile} attribute that points to the source file. +\subsection{\code{wholeSrcref} attributes}{ + +These are \code{srcref} objects stored in the \code{wholeSrcref} attributes of: +\itemize{ +\item Expression vectors returned by \code{parse()}, which seems to be the intended +usage. +\item \verb{\{} calls, which seems unintended. +} + +For expression vectors, the \code{wholeSrcref} spans from the first position +to the last position and represents the entire document. For braces, they +span from the first position to the location of the closing brace. There is +no way to know the location of the opening brace without reparsing, which +seems odd. It's probably an overlook from \code{xxexprlist()} calling +\code{attachSrcrefs()} in +\url{https://github.com/r-devel/r-svn/blob/52affc16/src/main/gram.y#L1380}. That +function is also called at the end of parsing, where it's intended for the +\code{wholeSrcref} attribute to be attached. +} + } \subsection{\code{srcfile} objects}{ @@ -76,7 +96,8 @@ a file on disk and store the filename, working directory, a timestamp, and encoding information. A plain \code{srcfile} is lightweight and opens the underlying file lazily when content is needed. -There are multiple subclasses of \code{srcfile}. +While it is possible to create bare \code{srcfile} objects, specialized subclasses +are much more common. \subsection{\code{srcfile}}{ Fields common to all \code{srcfile} objects: From 4186543af4d3060c4a319e5b3d7e7bd2b6b09094 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Mon, 17 Nov 2025 15:53:01 +0100 Subject: [PATCH 11/28] More documentation --- R/src.R | 43 ++++++++++++++++++++++++++++--------------- man/src.Rd | 44 +++++++++++++++++++++++++++++--------------- 2 files changed, 57 insertions(+), 30 deletions(-) diff --git a/R/src.R b/R/src.R index 59c3abb..820b774 100644 --- a/R/src.R +++ b/R/src.R @@ -38,17 +38,29 @@ #' - 6: adds columns (first_col, last_col) #' - 8: adds parsed-line numbers (first_parsed, last_parsed) #' -#' `srcref` objects are attached as attributes (e.g. `attr(x, "srcref")` -#' or `attr(x, "wholeSrcref")`) to parsed expressions and closures when -#' `keep.source = TRUE`. The parser also stores parse/token data on the -#' associated `srcfile` when requested. +#' They are attached as attributes (e.g. `attr(x, "srcref")` or `attr(x, +#' "wholeSrcref")`), possibly wrapped in a list, to the following objects: +#' +#' - Expression vectors returned by `parse()` (wrapped in a list) +#' - Quoted function calls (unwrapped) +#' - Quoted `{` calls (wrapped in a list) +#' - Evaluated closures (unwrapped) +#' +#' By default source references are not created but can be enabled by: +#' +#' - Passing `keep.source = TRUE` explicitly to `parse()`, `source()`, or +#' `sys.source()`. +#' - Setting `options(keep.source = TRUE)`. This affects the default arguments +#' of the aforementioned functions, as well as the console input parser. +#' - Setting `options(keep.source.pkgs = TRUE)`. This affects loading a package +#' from source, and installing a package from source. +#' +#' They have a `srcfile` attribute that points to the source file. #' #' Methods: #' - `as.character()`: Retrieves relevant source lines from the `srcfile` #' reference. #' -#' They have a `srcfile` attribute that points to the source file. -#' #' #' ### `wholeSrcref` attributes #' @@ -74,8 +86,7 @@ #' `srcfile` objects are environments representing information about a #' source file that a source reference points to. They typically refer to #' a file on disk and store the filename, working directory, a timestamp, -#' and encoding information. A plain `srcfile` is lightweight and opens -#' the underlying file lazily when content is needed. +#' and encoding information. #' #' While it is possible to create bare `srcfile` objects, specialized subclasses #' are much more common. @@ -83,6 +94,9 @@ #' #' ### `srcfile` #' +#' A bare `srcfile` object does not contain any data apart from the file path. +#' It lazily loads lines from the file on disk, without any caching. +#' #' Fields common to all `srcfile` objects: #' #' - `filename`: The filename of the source file. If relative, the path is @@ -110,10 +124,8 @@ #' ### `srcfilecopy` #' #' A `srcfilecopy` stores the actual source lines in memory in `$lines`. -#' It is produced when code is parsed while `keep.source = TRUE` or when -#' text is parsed from a character vector. `srcfilecopy` is useful when -#' the original file may change or not exist, because it preserves the -#' exact text used by the parser. +#' `srcfilecopy` is useful when the original file may change or does not +#' exist, because it preserves the exact text used by the parser. #' #' This type of srcfile is the most common. It's created by: #' @@ -155,9 +167,10 @@ #' lines operations to the `srcfile` stored in `original`. #' #' The typical way aliases are created is via `#line *line* *filename*` -#' directives where `*filename*` is supplied. These directives remap the srcref -#' and srcfile of parsed code to a different location, for example from a -#' temporary file or generated file to the original location on disk. +#' directives where the optional `*filename*` argument is supplied. These +#' directives remap the srcref and srcfile of parsed code to a different +#' location, for example from a temporary file or generated file to the original +#' location on disk. #' #' Called by `install.packages()` when installing a _source_ package with `keep.source.pkgs` set to `TRUE` (see #' ), but diff --git a/man/src.Rd b/man/src.Rd index 6e7f3ed..604adb3 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -54,18 +54,31 @@ Lengths of 4, 6, or 8 are allowed: \item 8: adds parsed-line numbers (first_parsed, last_parsed) } -\code{srcref} objects are attached as attributes (e.g. \code{attr(x, "srcref")} -or \code{attr(x, "wholeSrcref")}) to parsed expressions and closures when -\code{keep.source = TRUE}. The parser also stores parse/token data on the -associated \code{srcfile} when requested. +They are attached as attributes (e.g. \code{attr(x, "srcref")} or \code{attr(x, "wholeSrcref")}), possibly wrapped in a list, to the following objects: +\itemize{ +\item Expression vectors returned by \code{parse()} (wrapped in a list) +\item Quoted function calls (unwrapped) +\item Quoted \verb{\{} calls (wrapped in a list) +\item Evaluated closures (unwrapped) +} + +By default source references are not created but can be enabled by: +\itemize{ +\item Passing \code{keep.source = TRUE} explicitly to \code{parse()}, \code{source()}, or +\code{sys.source()}. +\item Setting \code{options(keep.source = TRUE)}. This affects the default arguments +of the aforementioned functions, as well as the console input parser. +\item Setting \code{options(keep.source.pkgs = TRUE)}. This affects loading a package +from source, and installing a package from source. +} + +They have a \code{srcfile} attribute that points to the source file. Methods: \itemize{ \item \code{as.character()}: Retrieves relevant source lines from the \code{srcfile} reference. } - -They have a \code{srcfile} attribute that points to the source file. \subsection{\code{wholeSrcref} attributes}{ These are \code{srcref} objects stored in the \code{wholeSrcref} attributes of: @@ -93,13 +106,15 @@ function is also called at the end of parsing, where it's intended for the \code{srcfile} objects are environments representing information about a source file that a source reference points to. They typically refer to a file on disk and store the filename, working directory, a timestamp, -and encoding information. A plain \code{srcfile} is lightweight and opens -the underlying file lazily when content is needed. +and encoding information. While it is possible to create bare \code{srcfile} objects, specialized subclasses are much more common. \subsection{\code{srcfile}}{ +A bare \code{srcfile} object does not contain any data apart from the file path. +It lazily loads lines from the file on disk, without any caching. + Fields common to all \code{srcfile} objects: \itemize{ \item \code{filename}: The filename of the source file. If relative, the path is @@ -128,10 +143,8 @@ Helpers: \subsection{\code{srcfilecopy}}{ A \code{srcfilecopy} stores the actual source lines in memory in \verb{$lines}. -It is produced when code is parsed while \code{keep.source = TRUE} or when -text is parsed from a character vector. \code{srcfilecopy} is useful when -the original file may change or not exist, because it preserves the -exact text used by the parser. +\code{srcfilecopy} is useful when the original file may change or does not +exist, because it preserves the exact text used by the parser. This type of srcfile is the most common. It's created by: \itemize{ @@ -169,9 +182,10 @@ allows exposing a different \code{filename} while delegating the open/close/get lines operations to the \code{srcfile} stored in \code{original}. The typical way aliases are created is via \verb{#line *line* *filename*} -directives where \verb{*filename*} is supplied. These directives remap the srcref -and srcfile of parsed code to a different location, for example from a -temporary file or generated file to the original location on disk. +directives where the optional \verb{*filename*} argument is supplied. These +directives remap the srcref and srcfile of parsed code to a different +location, for example from a temporary file or generated file to the original +location on disk. Called by \code{install.packages()} when installing a \emph{source} package with \code{keep.source.pkgs} set to \code{TRUE} (see \url{https://github.com/r-devel/r-svn/blob/52affc16/src/library/tools/R/install.R#L545}), but From 38ad6a300783c10026c56e97029e731a43ad8595 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Mon, 17 Nov 2025 16:20:23 +0100 Subject: [PATCH 12/28] Assume native encoding when reading from file --- R/src.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/src.R b/R/src.R index 820b774..14a264f 100644 --- a/R/src.R +++ b/R/src.R @@ -565,9 +565,8 @@ srcfile_lines <- function(srcfile, srcref) { filepath <- file.path(directory, filename) if (file.exists(filepath)) { - encoding <- srcfile$Enc %||% "unknown" all_lines <- tryCatch( - readLines(filepath, encoding = encoding, warn = FALSE), + readLines(filepath, warn = FALSE), error = function(e) NULL ) From 215e822c12fb6b664ac2d652810d4c58973f818d Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Mon, 17 Nov 2025 16:21:31 +0100 Subject: [PATCH 13/28] Return `NULL` if `srcref` attribute does not conform --- R/src.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/src.R b/R/src.R index 14a264f..6ecd7e8 100644 --- a/R/src.R +++ b/R/src.R @@ -355,7 +355,7 @@ process_srcref_attr <- function(srcref_attr, seen_srcfiles) { return(new_srcref_tree(srcrefs, type = "list")) } - stop("unreachable") + NULL } srcref_node <- function(srcref, seen_srcfiles) { From 1c1ccb4a1be2b4a6c7f510d64ba9ecec1ffcf522 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Mon, 17 Nov 2025 16:26:11 +0100 Subject: [PATCH 14/28] Consolidate extraction of srcref attributes --- R/src.R | 37 +++++++++++++----------------------- tests/testthat/_snaps/src.md | 30 ++++++++++++++--------------- tests/testthat/test-src.R | 31 +++++++++++++++--------------- 3 files changed, 42 insertions(+), 56 deletions(-) diff --git a/R/src.R b/R/src.R index 6ecd7e8..3def116 100644 --- a/R/src.R +++ b/R/src.R @@ -321,38 +321,31 @@ extract_srcref_attrs <- function(x, seen_srcfiles) { attrs <- list() if (!is.null(srcref <- attr(x, "srcref"))) { - attrs$`attr("srcref")` <- process_srcref_attr( + attrs$`attr("srcref")` <- srcref_attr_node( srcref, seen_srcfiles ) } if (!is.null(srcfile <- attr(x, "srcfile"))) { - attrs$`attr("srcfile")` <- srcfile_node( - srcfile, - NULL, - seen_srcfiles - ) + attrs$`attr("srcfile")` <- srcfile_node(srcfile, seen_srcfiles) } if (!is.null(whole <- attr(x, "wholeSrcref"))) { - attrs$`attr("wholeSrcref")` <- srcref_node(whole, seen_srcfiles) + attrs$`attr("wholeSrcref")` <- srcref_attr_node(whole, seen_srcfiles) } attrs } -process_srcref_attr <- function(srcref_attr, seen_srcfiles) { - if (inherits(srcref_attr, "srcref")) { - return(srcref_node(srcref_attr, seen_srcfiles)) +# A srcref attribute may be a srcref object or a list of srcref objects +srcref_attr_node <- function(srcref, seen_srcfiles) { + if (inherits(srcref, "srcref")) { + return(srcref_node(srcref, seen_srcfiles)) } - if (is.list(srcref_attr)) { - srcrefs <- lapply(seq_along(srcref_attr), function(i) { - srcref_node(srcref_attr[[i]], seen_srcfiles) - }) - names(srcrefs) <- paste0("[[", seq_along(srcrefs), "]]") - return(new_srcref_tree(srcrefs, type = "list")) + if (is.list(srcref)) { + return(srcref_list_node(srcref, seen_srcfiles)) } NULL @@ -378,14 +371,10 @@ srcref_node <- function(srcref, seen_srcfiles) { srcref_list_node <- function(srcref_list, seen_srcfiles) { srcrefs <- lapply(srcref_list, srcref_node, seen_srcfiles) - - node <- list( - count = length(srcref_list), - srcrefs = new_srcref_tree(srcrefs, type = "list") - ) + names(srcrefs) <- paste0("[[", seq_along(srcrefs), "]]") attrs <- extract_srcref_attrs(srcref_list, seen_srcfiles) - node <- c(node, attrs) + node <- c(srcrefs, attrs) new_srcref_tree(node, type = "list") } @@ -490,7 +479,7 @@ as_srcref_tree <- function(data, ..., from) { # Srcfile handling ------------------------------------------------------------- -srcfile_node <- function(srcfile, srcref, seen_srcfiles) { +srcfile_node <- function(srcfile, seen_srcfiles) { if (is.null(srcfile)) { return(NULL) } @@ -518,7 +507,7 @@ srcfile_node <- function(srcfile, srcref, seen_srcfiles) { # Process nested srcfile objects (e.g., 'original' in srcfilealias) if (!is.null(info$original) && inherits(info$original, "srcfile")) { - info$original <- srcfile_node(info$original, NULL, seen_srcfiles) + info$original <- srcfile_node(info$original, seen_srcfiles) } # Add source preview for plain srcfiles diff --git a/tests/testthat/_snaps/src.md b/tests/testthat/_snaps/src.md index e32c2e1..e72b8e4 100644 --- a/tests/testthat/_snaps/src.md +++ b/tests/testthat/_snaps/src.md @@ -344,22 +344,20 @@ scrub_src(src(sr_list)) Output - ├─count: 2 - └─srcrefs: - ├─ - │ ├─location: 1:1 - 1:5 - │ └─attr("srcfile"): @001 - │ ├─Enc: "unknown" - │ ├─filename: "" - │ ├─fixedNewlines: TRUE - │ ├─isFile: FALSE - │ ├─lines: "x + 1", "y + 2" - │ ├─parseData: 1, 1, 1, ... - │ ├─timestamp: "" - │ └─wd: "" - └─ - ├─location: 2:1 - 2:5 - └─attr("srcfile"): @001 + ├─[[1]]: + │ ├─location: 1:1 - 1:5 + │ └─attr("srcfile"): @001 + │ ├─Enc: "unknown" + │ ├─filename: "" + │ ├─fixedNewlines: TRUE + │ ├─isFile: FALSE + │ ├─lines: "x + 1", "y + 2" + │ ├─parseData: 1, 1, 1, ... + │ ├─timestamp: "" + │ └─wd: "" + └─[[2]]: + ├─location: 2:1 - 2:5 + └─attr("srcfile"): @001 # src() reveals srcref list structure with index notation diff --git a/tests/testthat/test-src.R b/tests/testthat/test-src.R index 52c0655..5a77912 100644 --- a/tests/testthat/test-src.R +++ b/tests/testthat/test-src.R @@ -258,7 +258,7 @@ test_that("extract_srcref_info handles 4-element srcrefs", { srcfile = attr(srcref, "srcfile") ) - info <- lobstr:::srcref_info(srcref_4) + info <- srcref_info(srcref_4) expect_s3_class(info$location, "lobstr_srcref_location") expect_equal(as.character(info$location), "1:1 - 1:5") @@ -275,7 +275,7 @@ test_that("extract_srcref_info handles 6-element srcrefs", { srcfile = attr(srcref_base, "srcfile") ) - info <- lobstr:::srcref_info(srcref_6) + info <- srcref_info(srcref_6) expect_s3_class(info$location, "lobstr_srcref_location") expect_equal(as.character(info$location), "1:1 - 1:5") @@ -286,7 +286,7 @@ test_that("extract_srcref_info handles 8-element srcrefs", { srcref <- attr(expr, "srcref")[[1]] # Most modern srcrefs are 8-element - info <- lobstr:::srcref_info(srcref) + info <- srcref_info(srcref) expect_s3_class(info$location, "lobstr_srcref_location") expect_match(as.character(info$location), "\\d+:\\d+ - \\d+:\\d+") @@ -296,7 +296,7 @@ test_that("extract_srcref_info shows encoding details when requested", { expr <- parse(text = "x + 1", keep.source = TRUE) srcref <- attr(expr, "srcref")[[1]] - info <- lobstr:::srcref_info(srcref) + info <- srcref_info(srcref) expect_true("location" %in% names(info)) }) @@ -306,7 +306,7 @@ test_that("extract_srcref_info errors on invalid srcref length", { bad_srcref <- structure(c(1L, 2L, 3L), class = "srcref") expect_error( - lobstr:::srcref_info(bad_srcref), + srcref_info(bad_srcref), "Unexpected srcref length" ) }) @@ -317,7 +317,7 @@ test_that("srcfile_node handles srcfilecopy", { srcref <- attr(expr, "srcref")[[1]] seen_srcfiles <- new.env(parent = emptyenv()) - info <- lobstr:::srcfile_node(srcfile, srcref, seen_srcfiles) + info <- srcfile_node(srcfile, seen_srcfiles) expect_equal(attr(info, "srcfile_class"), class(srcfile)[1]) expect_type(info$filename, "character") @@ -326,7 +326,7 @@ test_that("srcfile_node handles srcfilecopy", { test_that("srcfile_node handles NULL gracefully", { seen_srcfiles <- new.env(parent = emptyenv()) - info <- lobstr:::srcfile_node(NULL, NULL, seen_srcfiles) + info <- srcfile_node(NULL, seen_srcfiles) expect_null(info) }) @@ -336,7 +336,7 @@ test_that("srcfile_lines extracts from srcfilecopy", { srcref <- attr(expr, "srcref")[[1]] srcfile <- attr(srcref, "srcfile") - snippet <- lobstr:::srcfile_lines(srcfile, srcref) + snippet <- srcfile_lines(srcfile, srcref) expect_type(snippet, "character") expect_true(length(snippet) >= 1) @@ -353,7 +353,7 @@ test_that("srcfile_lines respects max_lines", { srcfile = srcfile ) - snippet <- lobstr:::srcfile_lines(srcfile, srcref) + snippet <- srcfile_lines(srcfile, srcref) expect_type(snippet, "character") expect_lte(length(snippet), 3) @@ -364,7 +364,7 @@ test_that("srcref_location works correctly", { c(1L, 5L, 3L, 20L, 5L, 20L, 1L, 3L), class = "srcref" ) - loc <- lobstr:::srcref_location(srcref) + loc <- srcref_location(srcref) expect_equal(loc, "1:5 - 3:20") }) @@ -398,7 +398,6 @@ test_that("src works with list of srcrefs", { expect_type(result, "list") expect_equal(attr(result, "srcref_type"), "list") - expect_equal(result$count, length(srcref_list)) }) test_that("src works with expressions", { @@ -459,7 +458,7 @@ test_that("tree_label.srcref formats correctly", { srcref <- attr(expr, "srcref")[[1]] # Call the method directly since srcref has proper class - label <- lobstr:::tree_label.srcref(srcref, list()) + label <- tree_label.srcref(srcref, list()) expect_type(label, "character") expect_match(label, " Date: Mon, 17 Nov 2025 17:04:14 +0100 Subject: [PATCH 15/28] Remove UTF-8 test --- tests/testthat/helper-src.R | 20 -------------------- tests/testthat/test-src.R | 11 ----------- 2 files changed, 31 deletions(-) diff --git a/tests/testthat/helper-src.R b/tests/testthat/helper-src.R index ed26d13..a1d2975 100644 --- a/tests/testthat/helper-src.R +++ b/tests/testthat/helper-src.R @@ -86,23 +86,3 @@ multi_statement_function_with_srcref <- function() { with_srcref(code, env = env) env$multi_func } - -#' Create expression with multibyte characters -#' -#' Creates source code with multibyte characters (e.g., "é") to test -#' byte vs column handling. -#' -#' @return Parsed expression with multibyte characters -#' @noRd -expression_with_multibyte <- function() { - code <- c( - "# Créer une fonction", - "café <- function() {", - " 'résumé'", - "}" - ) - - env <- new.env(parent = baseenv()) - with_srcref(code, env = env) - env$café -} diff --git a/tests/testthat/test-src.R b/tests/testthat/test-src.R index 5a77912..c1b1e49 100644 --- a/tests/testthat/test-src.R +++ b/tests/testthat/test-src.R @@ -426,17 +426,6 @@ test_that("src respects max_lines_preview parameter", { expect_equal(attr(result, "srcref_type"), "closure") }) -test_that("src handles multibyte characters", { - skip_on_os("windows") # Encoding issues on Windows - - fun <- expression_with_multibyte() - - result <- src(fun) - - expect_type(result, "list") - expect_equal(attr(result, "srcref_type"), "closure") -}) - test_that("src returns structure and print method works", { fun <- simple_function_with_srcref() From 514923222ebc52d6b1a9e25f23ee766e01ce8b8d Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Tue, 18 Nov 2025 09:17:31 +0100 Subject: [PATCH 16/28] Add encoding documentation --- R/src.R | 26 ++++++++++++++------------ man/src.Rd | 27 +++++++++++++++------------ 2 files changed, 29 insertions(+), 24 deletions(-) diff --git a/R/src.R b/R/src.R index 3def116..56d8266 100644 --- a/R/src.R +++ b/R/src.R @@ -1,22 +1,20 @@ -#' Show structure of source reference objects: srcfile and srcref -#' -#' @description #' Display tree of source references #' -#' Visualizes source reference metadata attached to R objects in a tree structure. +#' View source reference metadata attached to R objects in a tree structure. #' Shows source file information, line/column locations, and lines of source code. #' #' @param x An R object with source references. Can be: #' - A `srcref` object #' - A list of `srcref` objects -#' - A function (closure) with source references -#' - An expression with source references +#' - A expression vector with attached source references +#' - An evaluated closure with attached source references +#' - A quoted call with attached source references #' @param max_depth Maximum depth to traverse nested structures (default 5) #' @param max_length Maximum number of srcref nodes to display (default 100) #' @param ... Additional arguments passed to [tree()] #' -#' @return Invisibly returns a structured list containing the source reference -#' information +#' @return Returns a structured list containing the source reference +#' information. Print it to view the formatted tree. #' #' @section Overview: #' @@ -35,9 +33,13 @@ #' #' Lengths of 4, 6, or 8 are allowed: #' - 4: basic (first_line, first_byte, last_line, last_byte) -#' - 6: adds columns (first_col, last_col) +#' - 6: adds columns in Unicode codepoints (first_col, last_col) #' - 8: adds parsed-line numbers (first_parsed, last_parsed) #' +#' The "column" information does not represent grapheme clusters, but Unicode +#' codepoints. The column cursor is incremented at every UTF-8 lead byte and +#' there is no support for encodings other than UTF-8. +#' #' They are attached as attributes (e.g. `attr(x, "srcref")` or `attr(x, #' "wholeSrcref")`), possibly wrapped in a list, to the following objects: #' @@ -102,8 +104,8 @@ #' - `filename`: The filename of the source file. If relative, the path is #' resolved against `wd`. #' -#' - `wd`: The working directory (`getwd()`) at the time the srcfile was created -#' (generally at the time of parsing). +#' - `wd`: The working directory (`getwd()`) at the time the srcfile was created, +#' generally at the time of parsing). #' #' - `timestamp`: The timestamp of the source file. Retrieved from `filename` #' with `file.mtime()`. @@ -149,7 +151,7 @@ #' #' Fields: #' -#' - `filename`: The filename of the source file. If `ifFile` is `FALSE`, +#' - `filename`: The filename of the source file. If `isFile` is `FALSE`, #' the field is non meaningful. For instance `parse(text = )` sets it to #' `""`, and the console input parser sets it to `""`. #' diff --git a/man/src.Rd b/man/src.Rd index 604adb3..f1f0919 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/src.R \name{src} \alias{src} -\title{Show structure of source reference objects: srcfile and srcref} +\title{Display tree of source references} \usage{ src(x, max_depth = 5L, max_length = 100L, ...) } @@ -11,8 +11,9 @@ src(x, max_depth = 5L, max_length = 100L, ...) \itemize{ \item A \code{srcref} object \item A list of \code{srcref} objects -\item A function (closure) with source references -\item An expression with source references +\item A expression vector with attached source references +\item An evaluated closure with attached source references +\item A quoted call with attached source references }} \item{max_depth}{Maximum depth to traverse nested structures (default 5)} @@ -22,13 +23,11 @@ src(x, max_depth = 5L, max_length = 100L, ...) \item{...}{Additional arguments passed to \code{\link[=tree]{tree()}}} } \value{ -Invisibly returns a structured list containing the source reference -information +Returns a structured list containing the source reference +information. Print it to view the formatted tree. } \description{ -Display tree of source references - -Visualizes source reference metadata attached to R objects in a tree structure. +View source reference metadata attached to R objects in a tree structure. Shows source file information, line/column locations, and lines of source code. } \section{Overview}{ @@ -50,10 +49,14 @@ optionally, the parsed-line numbers if \verb{#line} directives were used. Lengths of 4, 6, or 8 are allowed: \itemize{ \item 4: basic (first_line, first_byte, last_line, last_byte) -\item 6: adds columns (first_col, last_col) +\item 6: adds columns in Unicode codepoints (first_col, last_col) \item 8: adds parsed-line numbers (first_parsed, last_parsed) } +The "column" information does not represent grapheme clusters, but Unicode +codepoints. The column cursor is incremented at every UTF-8 lead byte and +there is no support for encodings other than UTF-8. + They are attached as attributes (e.g. \code{attr(x, "srcref")} or \code{attr(x, "wholeSrcref")}), possibly wrapped in a list, to the following objects: \itemize{ \item Expression vectors returned by \code{parse()} (wrapped in a list) @@ -119,8 +122,8 @@ Fields common to all \code{srcfile} objects: \itemize{ \item \code{filename}: The filename of the source file. If relative, the path is resolved against \code{wd}. -\item \code{wd}: The working directory (\code{getwd()}) at the time the srcfile was created -(generally at the time of parsing). +\item \code{wd}: The working directory (\code{getwd()}) at the time the srcfile was created, +generally at the time of parsing). \item \code{timestamp}: The timestamp of the source file. Retrieved from \code{filename} with \code{file.mtime()}. \item \code{encoding}: The encoding of the source file. @@ -165,7 +168,7 @@ The \code{srcfilecopy} object is timestamped with the file's last modification t Fields: \itemize{ -\item \code{filename}: The filename of the source file. If \code{ifFile} is \code{FALSE}, +\item \code{filename}: The filename of the source file. If \code{isFile} is \code{FALSE}, the field is non meaningful. For instance \code{parse(text = )} sets it to \code{""}, and the console input parser sets it to \code{""}. \item \code{isFile}: A logical indicating whether the source file exists. From c25b564b23d0eb452f08f5f91201eff28c7f958b Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Tue, 18 Nov 2025 09:21:15 +0100 Subject: [PATCH 17/28] Skip tests on old Windows --- tests/testthat/test-src.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/testthat/test-src.R b/tests/testthat/test-src.R index c1b1e49..a65adec 100644 --- a/tests/testthat/test-src.R +++ b/tests/testthat/test-src.R @@ -1,5 +1,10 @@ # Test: Closures (evaluated functions) ------------------------------------------ +if (utils::packageVersion("base") < "4.2.0") { + # Tree characters are ASCII on old Windows R + skip_on_os("windows") +} + test_that("src() shows closure with srcref and wholeSrcref", { expect_snapshot({ f <- simple_function_with_srcref() From 039d2d6c501e2c34de60a87ffa54b534519f4369 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Tue, 18 Nov 2025 09:29:17 +0100 Subject: [PATCH 18/28] Mention `parseData` --- R/src.R | 2 ++ man/src.Rd | 1 + 2 files changed, 3 insertions(+) diff --git a/R/src.R b/R/src.R index 56d8266..74792bc 100644 --- a/R/src.R +++ b/R/src.R @@ -115,6 +115,8 @@ #' - `Enc`: The encoding of output lines. Used by `getSrcLines()`, which #' calls `iconv()` when `Enc` does not match `encoding`. #' +#' - `parseData` (optional): Parser information saved when `keep.source.data` is #' set to `TRUE`. +#' #' Implementations: #' - `print()` and `summary()` to print information about the source file. #' - `open()` and `close()` to access the underlying file as a connection. diff --git a/man/src.Rd b/man/src.Rd index f1f0919..a43a1ac 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -129,6 +129,7 @@ with \code{file.mtime()}. \item \code{encoding}: The encoding of the source file. \item \code{Enc}: The encoding of output lines. Used by \code{getSrcLines()}, which calls \code{iconv()} when \code{Enc} does not match \code{encoding}. +\item \code{parseData} (optional): Parser information saved when \code{keep.source.data} is #' set to \code{TRUE}. } Implementations: From 3e324c09f6a3545a2c1c35709f13571c96ec5b94 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Tue, 18 Nov 2025 10:09:28 +0100 Subject: [PATCH 19/28] Add section on srcref creation --- R/src.R | 36 +++++++++++++++++++++++++++--------- man/src.Rd | 42 ++++++++++++++++++++++++++++++++---------- 2 files changed, 59 insertions(+), 19 deletions(-) diff --git a/R/src.R b/R/src.R index 74792bc..be0a53b 100644 --- a/R/src.R +++ b/R/src.R @@ -25,6 +25,33 @@ #' such as its name, path, and encoding. #' #' +#' ## Where and when are source references created? +#' +#' Ultimately the R parser creates source references. The main two entry points +#' to the parser are: +#' - The R function `parse()`. +#' - The frontend hook `ReadConsole`, which powers the console input parser in +#' the R CLI and in IDEs. +#' +#' In principle, anything that calls `parse()` may create source references, but +#' here are the important direct and indirect callers: +#' - `source()` and `sys.source()` which parse and evaluate code. +#' - `loadNamespace()` calls `sys.source()` when loading a _source_ package: +#' . +#' - `R CMD install` creates a lazy-load database from a source package. +#' The first step is to call `loadNamespace()`: +#' +#' +#' By default source references are not created but can be enabled by: +#' +#' - Passing `keep.source = TRUE` explicitly to `parse()`, `source()`, +#' `sys.source()`, or `loadNamespace()`. +#' - Setting `options(keep.source = TRUE)`. This affects the default arguments +#' of the aforementioned functions, as well as the console input parser. +#' - Setting `options(keep.source.pkgs = TRUE)`. This affects loading a package +#' from source, and installing a package from source. +#' +#' #' ## `srcref` objects #' #' `srcref` objects are compact integer vectors describing a character range @@ -48,15 +75,6 @@ #' - Quoted `{` calls (wrapped in a list) #' - Evaluated closures (unwrapped) #' -#' By default source references are not created but can be enabled by: -#' -#' - Passing `keep.source = TRUE` explicitly to `parse()`, `source()`, or -#' `sys.source()`. -#' - Setting `options(keep.source = TRUE)`. This affects the default arguments -#' of the aforementioned functions, as well as the console input parser. -#' - Setting `options(keep.source.pkgs = TRUE)`. This affects loading a package -#' from source, and installing a package from source. -#' #' They have a `srcfile` attribute that points to the source file. #' #' Methods: diff --git a/man/src.Rd b/man/src.Rd index a43a1ac..5d1e59f 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -40,6 +40,38 @@ location within the source file, such as the line and column numbers. \item \code{srcfile} objects, which contain metadata about the source file such as its name, path, and encoding. } +\subsection{Where and when are source references created?}{ + +Ultimately the R parser creates source references. The main two entry points +to the parser are: +\itemize{ +\item The R function \code{parse()}. +\item The frontend hook \code{ReadConsole}, which powers the console input parser in +the R CLI and in IDEs. +} + +In principle, anything that calls \code{parse()} may create source references, but +here are the important direct and indirect callers: +\itemize{ +\item \code{source()} and \code{sys.source()} which parse and evaluate code. +\item \code{loadNamespace()} calls \code{sys.source()} when loading a \emph{source} package: +\url{https://github.com/r-devel/r-svn/blob/acd196be/src/library/base/R/namespace.R#L573}. +\item \verb{R CMD install} creates a lazy-load database from a source package. +The first step is to call \code{loadNamespace()}: +\url{https://github.com/r-devel/r-svn/blob/acd196be/src/library/tools/R/makeLazyLoad.R#L32} +} + +By default source references are not created but can be enabled by: +\itemize{ +\item Passing \code{keep.source = TRUE} explicitly to \code{parse()}, \code{source()}, +\code{sys.source()}, or \code{loadNamespace()}. +\item Setting \code{options(keep.source = TRUE)}. This affects the default arguments +of the aforementioned functions, as well as the console input parser. +\item Setting \code{options(keep.source.pkgs = TRUE)}. This affects loading a package +from source, and installing a package from source. +} +} + \subsection{\code{srcref} objects}{ \code{srcref} objects are compact integer vectors describing a character range @@ -65,16 +97,6 @@ They are attached as attributes (e.g. \code{attr(x, "srcref")} or \code{attr(x, \item Evaluated closures (unwrapped) } -By default source references are not created but can be enabled by: -\itemize{ -\item Passing \code{keep.source = TRUE} explicitly to \code{parse()}, \code{source()}, or -\code{sys.source()}. -\item Setting \code{options(keep.source = TRUE)}. This affects the default arguments -of the aforementioned functions, as well as the console input parser. -\item Setting \code{options(keep.source.pkgs = TRUE)}. This affects loading a package -from source, and installing a package from source. -} - They have a \code{srcfile} attribute that points to the source file. Methods: From 44834d80feea3d5d5a9431e3dbbd814cf661d95f Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Tue, 18 Nov 2025 10:47:37 +0100 Subject: [PATCH 20/28] Fix issue with defensive guard --- R/src.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/src.R b/R/src.R index be0a53b..c0f7aae 100644 --- a/R/src.R +++ b/R/src.R @@ -553,7 +553,7 @@ srcfile_node <- function(srcfile, seen_srcfiles) { } srcfile_lines <- function(srcfile, srcref) { - if (is.null(srcfile) || is.null(srcref)) { + if (is.null(srcfile) || !is_srcref(srcref)) { return(character(0)) } @@ -701,3 +701,7 @@ new_srcfile_ref <- function(id, srcfile_class = "srcfile") { class = "lobstr_srcfile_ref" ) } + +is_srcref <- function(x) { + is.integer(x) && inherits(x, "srcref") && length(x) %in% c(4L, 6L, 8L) +} From d13ded479b1fea28be29c9ba15905e0dde2e74e8 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Tue, 18 Nov 2025 14:16:07 +0100 Subject: [PATCH 21/28] Add note about partial `srcfilecopy` objects created by the C parser --- R/src.R | 4 ++++ man/src.Rd | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/R/src.R b/R/src.R index c0f7aae..1be2c11 100644 --- a/R/src.R +++ b/R/src.R @@ -182,6 +182,10 @@ #' in this way and sets `fixedNewlines` to `TRUE`. #' #' +#' Note that the C-level parser (used directly mainly when parsing console input) +#' does not call the R-level constructor and only instantiates the `filename` +#' (set to `""`) and `lines` fields. +#' #' ### `srcfilealias` #' #' This object wraps an existing `srcfile` object (stored in `original`). It diff --git a/man/src.Rd b/man/src.Rd index 5d1e59f..c59dce4 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -199,6 +199,10 @@ the field is non meaningful. For instance \code{parse(text = )} sets it to no embedded \verb{\\n} characters. The \code{getSrcLines()} helper regularises \code{lines} in this way and sets \code{fixedNewlines} to \code{TRUE}. } + +Note that the C-level parser (used directly mainly when parsing console input) +does not call the R-level constructor and only instantiates the \code{filename} +(set to \code{""}) and \code{lines} fields. } \subsection{\code{srcfilealias}}{ From be74a0a063e431d83b939e7e0706e9d2fad4af9b Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Tue, 18 Nov 2025 15:27:17 +0100 Subject: [PATCH 22/28] Add note about `R_ParseVector()` --- R/src.R | 2 +- man/src.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/src.R b/R/src.R index 1be2c11..683c768 100644 --- a/R/src.R +++ b/R/src.R @@ -31,7 +31,7 @@ #' to the parser are: #' - The R function `parse()`. #' - The frontend hook `ReadConsole`, which powers the console input parser in -#' the R CLI and in IDEs. +#' the R CLI and in IDEs. This C-level parser can also be accessed from C code #' via `R_ParseVector()`. #' #' In principle, anything that calls `parse()` may create source references, but #' here are the important direct and indirect callers: diff --git a/man/src.Rd b/man/src.Rd index c59dce4..3724ec3 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -47,7 +47,7 @@ to the parser are: \itemize{ \item The R function \code{parse()}. \item The frontend hook \code{ReadConsole}, which powers the console input parser in -the R CLI and in IDEs. +the R CLI and in IDEs. This C-level parser can also be accessed from C code #' via \code{R_ParseVector()}. } In principle, anything that calls \code{parse()} may create source references, but From 571c745ca7b1ca4c5b14a975de0b19b7a5b75040 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Thu, 20 Nov 2025 14:42:59 +0100 Subject: [PATCH 23/28] Mention default value of `keep.source` --- R/src.R | 2 ++ man/src.Rd | 2 ++ 2 files changed, 4 insertions(+) diff --git a/R/src.R b/R/src.R index 683c768..4e7ec81 100644 --- a/R/src.R +++ b/R/src.R @@ -48,6 +48,8 @@ #' `sys.source()`, or `loadNamespace()`. #' - Setting `options(keep.source = TRUE)`. This affects the default arguments #' of the aforementioned functions, as well as the console input parser. +#' In interactive sessions, `keep.source` is set to `TRUE` by default: +#' . #' - Setting `options(keep.source.pkgs = TRUE)`. This affects loading a package #' from source, and installing a package from source. #' diff --git a/man/src.Rd b/man/src.Rd index 3724ec3..2b97592 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -67,6 +67,8 @@ By default source references are not created but can be enabled by: \code{sys.source()}, or \code{loadNamespace()}. \item Setting \code{options(keep.source = TRUE)}. This affects the default arguments of the aforementioned functions, as well as the console input parser. +In interactive sessions, \code{keep.source} is set to \code{TRUE} by default: +\url{https://github.com/r-devel/r-svn/blob/3a4745af/src/library/profile/Common.R#L26}. \item Setting \code{options(keep.source.pkgs = TRUE)}. This affects loading a package from source, and installing a package from source. } From e02b9c28ad824cb67b85dffc752a49ab698acc1f Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Thu, 29 Jan 2026 09:47:25 +0100 Subject: [PATCH 24/28] Use snapshot transformer to scrub output --- tests/testthat/_snaps/src.md | 48 +++++++++--------- tests/testthat/helper-src.R | 21 +++----- tests/testthat/test-src.R | 96 ++++++++++++++++++------------------ 3 files changed, 79 insertions(+), 86 deletions(-) diff --git a/tests/testthat/_snaps/src.md b/tests/testthat/_snaps/src.md index e72b8e4..6549395 100644 --- a/tests/testthat/_snaps/src.md +++ b/tests/testthat/_snaps/src.md @@ -2,7 +2,7 @@ Code f <- simple_function_with_srcref() - scrub_src(src(f)) + src(f) Output ├─attr("srcref"): @@ -33,7 +33,7 @@ Code f <- multi_statement_function_with_srcref() - scrub_src(src(f)) + src(f) Output ├─attr("srcref"): @@ -73,7 +73,7 @@ Code with_srcref("x <- quote(function() {})") - scrub_src(src(x)) + src(x) Output ├─[[3]]: <{> @@ -101,7 +101,7 @@ Code with_srcref("x <- quote(function() {})") - scrub_src(src(x[[3]])) + src(x[[3]]) Output <{> ├─attr("srcref"): @@ -125,7 +125,7 @@ Code with_srcref("x <- quote(function(a, b) {})") - scrub_src(src(x)) + src(x) Output ├─[[3]]: <{> @@ -156,7 +156,7 @@ " # A long comment that spans", " # multiple lines", " y <- 1", "}")) synthetic_srcref <- structure(c(2L, 3L, 4L, 8L, 3L, 8L, 1L, 5L), class = "srcref", srcfile = srcfile) - scrub_src(src(synthetic_srcref)) + src(synthetic_srcref) Output ├─location: 2:3 - 4:8 @@ -174,7 +174,7 @@ Code x <- parse(text = "x + 1", keep.source = TRUE) - scrub_src(src(x)) + src(x) Output ├─attr("srcref"): @@ -198,7 +198,7 @@ Code x <- parse(text = c("x + 1", "y + 2", "z + 3"), keep.source = TRUE) - scrub_src(src(x)) + src(x) Output ├─attr("srcref"): @@ -228,7 +228,7 @@ Code x <- parse(text = "{\n 1\n}", keep.source = TRUE) - scrub_src(src(x)) + src(x) Output ├─attr("srcref"): @@ -264,7 +264,7 @@ Code x <- parse(text = "{\n 1\n}", keep.source = TRUE) - scrub_src(src(x[[1]])) + src(x[[1]]) Output <{> ├─attr("srcref"): @@ -291,7 +291,7 @@ Code x <- parse(text = "{\n a <- 1\n b <- 2\n}", keep.source = TRUE) - scrub_src(src(x[[1]])) + src(x[[1]]) Output <{> ├─attr("srcref"): @@ -322,7 +322,7 @@ Code x <- parse(text = "x + 1", keep.source = TRUE) sr <- attr(x, "srcref")[[1]] - scrub_src(src(sr)) + src(sr) Output ├─location: 1:1 - 1:5 @@ -341,7 +341,7 @@ Code x <- parse(text = c("x + 1", "y + 2"), keep.source = TRUE) sr_list <- attr(x, "srcref") - scrub_src(src(sr_list)) + src(sr_list) Output ├─[[1]]: @@ -363,7 +363,7 @@ Code with_srcref("x <- quote(function() { 1 })") - scrub_src(src(x[[3]])) + src(x[[3]]) Output <{> ├─attr("srcref"): @@ -390,7 +390,7 @@ Code x <- parse(text = "foo({ if (1) bar({ 2 }) })", keep.source = TRUE) - scrub_src(src(x, max_depth = 10)) + src(x, max_depth = 10) Output ├─attr("srcref"): @@ -438,7 +438,7 @@ Code with_srcref("f <- function() foo({ if (1) bar({ 2 }) })") - scrub_src(src(f, max_depth = 10)) + src(f, max_depth = 10) Output ├─attr("srcref"): @@ -482,7 +482,7 @@ Code f <- simple_function_with_srcref() - scrub_src(src(f)) + src(f) Output ├─attr("srcref"): @@ -513,7 +513,7 @@ Code x <- parse(text = "{\n 1\n 2\n}", keep.source = TRUE) - scrub_src(src(x)) + src(x) Output ├─attr("srcref"): @@ -552,7 +552,7 @@ Code x <- parse(text = "{}", keep.source = TRUE) - scrub_src(src(x[[1]])) + src(x[[1]]) Output <{> ├─attr("srcref"): @@ -576,7 +576,7 @@ Code with_srcref("f <- function() { NULL }") - scrub_src(src(f)) + src(f) Output ├─attr("srcref"): @@ -607,7 +607,7 @@ Code x <- parse(text = "if (TRUE) { 1 } else { 2 }", keep.source = TRUE) - scrub_src(src(x)) + src(x) Output ├─attr("srcref"): @@ -655,7 +655,7 @@ Code f <- simple_function_with_srcref() - scrub_src(src(f)) + src(f) Output ├─attr("srcref"): @@ -686,7 +686,7 @@ Code x <- parse(text = "{\n {\n 1\n }\n {\n 2\n }\n}", keep.source = TRUE) - scrub_src(src(x)) + src(x) Output ├─attr("srcref"): @@ -749,7 +749,7 @@ Code with_srcref("f <- function(x) {\n if (x) {\n 1\n }\n}") - scrub_src(src(f)) + src(f) Output ├─attr("srcref"): diff --git a/tests/testthat/helper-src.R b/tests/testthat/helper-src.R index a1d2975..f8faa1e 100644 --- a/tests/testthat/helper-src.R +++ b/tests/testthat/helper-src.R @@ -1,17 +1,10 @@ -#' Scrub src() output for deterministic snapshots -scrub_src <- function(x) { - # Capture the output as text - output <- capture.output(print(x)) - - output <- gsub('filename: "[^"]+"', 'filename: ""', output) - output <- gsub('directory: "[^"]+"', 'directory: ""', output) - output <- gsub('timestamp: "[^"]+"', 'timestamp: ""', output) - output <- gsub('wd: "[^"]+"', 'wd: ""', output) - - # Print the scrubbed output - cat(output, sep = "\n") - - invisible(x) +#' Snapshot transformer to scrub src() output for deterministic snapshots +scrub_src_transform <- function(lines) { + lines <- gsub('filename: "[^"]+"', 'filename: ""', lines) + lines <- gsub('directory: "[^"]+"', 'directory: ""', lines) + lines <- gsub('timestamp: "[^"]+"', 'timestamp: ""', lines) + lines <- gsub('wd: "[^"]+"', 'wd: ""', lines) + lines } #' Create a function or expression with source references diff --git a/tests/testthat/test-src.R b/tests/testthat/test-src.R index a65adec..0d420b5 100644 --- a/tests/testthat/test-src.R +++ b/tests/testthat/test-src.R @@ -6,44 +6,44 @@ if (utils::packageVersion("base") < "4.2.0") { } test_that("src() shows closure with srcref and wholeSrcref", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { f <- simple_function_with_srcref() - scrub_src(src(f)) + src(f) }) }) test_that("src() shows multi-statement function", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { f <- multi_statement_function_with_srcref() - scrub_src(src(f)) + src(f) }) }) # Test: Quoted functions -------------------------------------------------------- test_that("src() shows quoted function with nested body", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { with_srcref("x <- quote(function() {})") - scrub_src(src(x)) + src(x) }) }) test_that("src() shows quoted function body directly", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { with_srcref("x <- quote(function() {})") - scrub_src(src(x[[3]])) + src(x[[3]]) }) }) test_that("src() shows quoted function with arguments", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { with_srcref("x <- quote(function(a, b) {})") - scrub_src(src(x)) + src(x) }) }) test_that("src() shows srcref with parsed field when positions differ", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { # Create a synthetic 8-element srcref where parsed positions differ # Format: c(first_line, first_byte, last_line, last_byte, # first_col, last_col, first_parsed, last_parsed) @@ -66,89 +66,89 @@ test_that("src() shows srcref with parsed field when positions differ", { srcfile = srcfile ) - scrub_src(src(synthetic_srcref)) + src(synthetic_srcref) }) }) # Test: Expression objects ------------------------------------------------------ test_that("src() shows expression with single element", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { x <- parse(text = "x + 1", keep.source = TRUE) - scrub_src(src(x)) + src(x) }) }) test_that("src() shows expression with multiple elements", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { x <- parse(text = c("x + 1", "y + 2", "z + 3"), keep.source = TRUE) - scrub_src(src(x)) + src(x) }) }) test_that("src() shows expression with nested block and wholeSrcref", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { x <- parse(text = "{\n 1\n}", keep.source = TRUE) - scrub_src(src(x)) + src(x) }) }) test_that("src() shows nested block element directly", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { x <- parse(text = "{\n 1\n}", keep.source = TRUE) - scrub_src(src(x[[1]])) + src(x[[1]]) }) }) # Test: Blocks with wholeSrcref ------------------------------------------------- test_that("src() shows block with srcref list and wholeSrcref", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { x <- parse(text = "{\n a <- 1\n b <- 2\n}", keep.source = TRUE) - scrub_src(src(x[[1]])) + src(x[[1]]) }) }) # Test: Single srcref objects --------------------------------------------------- test_that("src() shows single srcref", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { x <- parse(text = "x + 1", keep.source = TRUE) sr <- attr(x, "srcref")[[1]] - scrub_src(src(sr)) + src(sr) }) }) # Test: List of srcrefs --------------------------------------------------------- test_that("src() shows list of srcrefs with count", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { x <- parse(text = c("x + 1", "y + 2"), keep.source = TRUE) sr_list <- attr(x, "srcref") - scrub_src(src(sr_list)) + src(sr_list) }) }) # Test: Srcref lists shown as with [[1]], [[2]] notation ---------------- test_that("src() reveals srcref list structure with index notation", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { with_srcref("x <- quote(function() { 1 })") - scrub_src(src(x[[3]])) + src(x[[3]]) }) }) test_that("src() handles srcrefs nested in language calls", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { x <- parse(text = "foo({ if (1) bar({ 2 }) })", keep.source = TRUE) - scrub_src(src(x, max_depth = 10)) + src(x, max_depth = 10) }) }) test_that("src() handles srcrefs nested in function bodies", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { with_srcref("f <- function() foo({ if (1) bar({ 2 }) })") - scrub_src(src(f, max_depth = 10)) + src(f, max_depth = 10) }) }) @@ -179,71 +179,71 @@ test_that("src() uses correct type labels", { # Test: Srcfile duplication (current behavior - will change in Phase 1) -------- test_that("src() currently shows duplicate srcfile objects", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { # Current behavior: srcfile appears twice (in srcref and wholeSrcref) # After Phase 1: should use reference notation like @abc123 f <- simple_function_with_srcref() - scrub_src(src(f)) + src(f) }) }) test_that("src() shows many duplicate srcfiles in nested expression", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { # Current behavior: same srcfile appears many times # After Phase 1: these should be deduplicated x <- parse(text = "{\n 1\n 2\n}", keep.source = TRUE) - scrub_src(src(x)) + src(x) }) }) # Test: Edge cases -------------------------------------------------------------- test_that("src() handles empty block", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { x <- parse(text = "{}", keep.source = TRUE) - scrub_src(src(x[[1]])) + src(x[[1]]) }) }) test_that("src() handles function without arguments", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { with_srcref("f <- function() { NULL }") - scrub_src(src(f)) + src(f) }) }) test_that("src() handles if statement with blocks", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { x <- parse(text = "if (TRUE) { 1 } else { 2 }", keep.source = TRUE) - scrub_src(src(x)) + src(x) }) }) # Test: Parameters -------------------------------------------------------------- test_that("src() respects show_source_lines parameter", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { f <- simple_function_with_srcref() - scrub_src(src(f)) + src(f) }) }) # Test: Complex nested structures ----------------------------------------------- test_that("src() shows expression with multiple nested blocks", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { x <- parse( text = "{\n {\n 1\n }\n {\n 2\n }\n}", keep.source = TRUE ) - scrub_src(src(x)) + src(x) }) }) test_that("src() shows function with nested block in body", { - expect_snapshot({ + expect_snapshot(transform = scrub_src_transform, { with_srcref("f <- function(x) {\n if (x) {\n 1\n }\n}") - scrub_src(src(f)) + src(f) }) }) # Tests for src() function and helpers From 265f1fc347beacfd5549001ce0d2bcc6fa29506b Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Thu, 29 Jan 2026 09:44:12 +0100 Subject: [PATCH 25/28] Address code review --- R/src.R | 3 ++- man/src.Rd | 3 ++- tests/testthat/helper-src.R | 34 +--------------------------------- 3 files changed, 5 insertions(+), 35 deletions(-) diff --git a/R/src.R b/R/src.R index 4e7ec81..90bd768 100644 --- a/R/src.R +++ b/R/src.R @@ -31,7 +31,8 @@ #' to the parser are: #' - The R function `parse()`. #' - The frontend hook `ReadConsole`, which powers the console input parser in -#' the R CLI and in IDEs. This C-level parser can also be accessed from C code #' via `R_ParseVector()`. +#' the R CLI and in IDEs. This C-level parser can also be accessed from C code +#' via `R_ParseVector()`. #' #' In principle, anything that calls `parse()` may create source references, but #' here are the important direct and indirect callers: diff --git a/man/src.Rd b/man/src.Rd index 2b97592..9f5634c 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -47,7 +47,8 @@ to the parser are: \itemize{ \item The R function \code{parse()}. \item The frontend hook \code{ReadConsole}, which powers the console input parser in -the R CLI and in IDEs. This C-level parser can also be accessed from C code #' via \code{R_ParseVector()}. +the R CLI and in IDEs. This C-level parser can also be accessed from C code +via \code{R_ParseVector()}. } In principle, anything that calls \code{parse()} may create source references, but diff --git a/tests/testthat/helper-src.R b/tests/testthat/helper-src.R index f8faa1e..6fafafc 100644 --- a/tests/testthat/helper-src.R +++ b/tests/testthat/helper-src.R @@ -1,4 +1,4 @@ -#' Snapshot transformer to scrub src() output for deterministic snapshots +# Snapshot transformer to scrub src() output for deterministic snapshots scrub_src_transform <- function(lines) { lines <- gsub('filename: "[^"]+"', 'filename: ""', lines) lines <- gsub('directory: "[^"]+"', 'directory: ""', lines) @@ -7,17 +7,6 @@ scrub_src_transform <- function(lines) { lines } -#' Create a function or expression with source references -#' -#' This helper writes code to a temporary file, sources it, and returns -#' the result with source references attached. Useful for testing srcref -#' functionality. -#' -#' @param code Character vector of R code -#' @param env Environment to source into (default: caller environment) -#' @param file Optional file path (default: creates temp file) -#' @return The result of sourcing the code with keep.source = TRUE -#' @noRd with_srcref <- function(code, env = parent.frame(), file = NULL) { if (is.null(file)) { file <- tempfile("test_srcref", fileext = ".R") @@ -28,24 +17,10 @@ with_srcref <- function(code, env = parent.frame(), file = NULL) { source(file, local = env, keep.source = TRUE) } -#' Parse code with source references -#' -#' Creates a parsed expression with source references attached, useful for -#' testing srcref extraction from expressions. -#' -#' @param code Character string of R code -#' @return Parsed expression with srcref attributes -#' @noRd parse_with_srcref <- function(code) { parse(text = code, keep.source = TRUE) } -#' Create a function with known source references -#' -#' Creates a simple test function with predictable source references. -#' -#' @return A function with source references -#' @noRd simple_function_with_srcref <- function() { code <- c( "test_func <- function(x, y) {", @@ -58,13 +33,6 @@ simple_function_with_srcref <- function() { env$test_func } -#' Create a multi-statement function with source references -#' -#' Creates a function with multiple statements for testing statement-level -#' srcref handling. -#' -#' @return A function with multiple statements and source references -#' @noRd multi_statement_function_with_srcref <- function() { code <- c( "multi_func <- function(x) {", From acec430ae685a7a4875708df0ec610ce8a5910b9 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Thu, 29 Jan 2026 09:58:09 +0100 Subject: [PATCH 26/28] Add note about `wholeSrcref` in evaluated closures --- R/src.R | 3 +++ man/src.Rd | 3 +++ 2 files changed, 6 insertions(+) diff --git a/R/src.R b/R/src.R index 90bd768..ec7a055 100644 --- a/R/src.R +++ b/R/src.R @@ -103,6 +103,9 @@ #' function is also called at the end of parsing, where it's intended for the #' `wholeSrcref` attribute to be attached. #' +#' For evaluated closures, the `wholeSrcref` attribute on the body has the same +#' unreliable start positions as `{` nodes. +#' #' #' ## `srcfile` objects #' diff --git a/man/src.Rd b/man/src.Rd index 9f5634c..1c35e30 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -125,6 +125,9 @@ seems odd. It's probably an overlook from \code{xxexprlist()} calling \url{https://github.com/r-devel/r-svn/blob/52affc16/src/main/gram.y#L1380}. That function is also called at the end of parsing, where it's intended for the \code{wholeSrcref} attribute to be attached. + +For evaluated closures, the \code{wholeSrcref} attribute on the body has the same +unreliable start positions as \verb{\{} nodes. } } From 6a17a3b121c055a6f368eb6b936e7a8c46d13319 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Thu, 29 Jan 2026 09:58:49 +0100 Subject: [PATCH 27/28] Link to R journal --- R/src.R | 1 + man/src.Rd | 1 + 2 files changed, 2 insertions(+) diff --git a/R/src.R b/R/src.R index ec7a055..85544f9 100644 --- a/R/src.R +++ b/R/src.R @@ -228,6 +228,7 @@ #' @seealso #' - [srcfile()]: Base documentation for `srcref` and `srcfile` objects. #' - [getParseData()]: Parse information stored when `keep.source.data` is `TRUE`. +#' - Source References (R Journal): #' #' @export #' @family object inspectors diff --git a/man/src.Rd b/man/src.Rd index 1c35e30..5cf5abd 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -253,6 +253,7 @@ Fields: \itemize{ \item \code{\link[=srcfile]{srcfile()}}: Base documentation for \code{srcref} and \code{srcfile} objects. \item \code{\link[=getParseData]{getParseData()}}: Parse information stored when \code{keep.source.data} is \code{TRUE}. +\item Source References (R Journal): \url{https://journal.r-project.org/articles/RJ-2010-010} } Other object inspectors: From 37a5af88e5c306fad26c7b539681db6fa4e42cbd Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Thu, 29 Jan 2026 10:02:56 +0100 Subject: [PATCH 28/28] Mention that column is a right-boundary position --- R/src.R | 5 +++++ man/src.Rd | 5 +++++ 2 files changed, 10 insertions(+) diff --git a/R/src.R b/R/src.R index 85544f9..b2241bc 100644 --- a/R/src.R +++ b/R/src.R @@ -70,6 +70,11 @@ #' codepoints. The column cursor is incremented at every UTF-8 lead byte and #' there is no support for encodings other than UTF-8. #' +#' The srcref columns are right-boundary positions, meaning that for an +#' expression starting at the start of the file, the column will be 1. Note that +#' `wholeSrcref` (see below) on the other hand starts at 0, before the first +#' character. It might also end 1 character after the last srcref column. +#' #' They are attached as attributes (e.g. `attr(x, "srcref")` or `attr(x, #' "wholeSrcref")`), possibly wrapped in a list, to the following objects: #' diff --git a/man/src.Rd b/man/src.Rd index 5cf5abd..2073bee 100644 --- a/man/src.Rd +++ b/man/src.Rd @@ -92,6 +92,11 @@ The "column" information does not represent grapheme clusters, but Unicode codepoints. The column cursor is incremented at every UTF-8 lead byte and there is no support for encodings other than UTF-8. +The srcref columns are right-boundary positions, meaning that for an +expression starting at the start of the file, the column will be 1. Note that +\code{wholeSrcref} (see below) on the other hand starts at 0, before the first +character. It might also end 1 character after the last srcref column. + They are attached as attributes (e.g. \code{attr(x, "srcref")} or \code{attr(x, "wholeSrcref")}), possibly wrapped in a list, to the following objects: \itemize{ \item Expression vectors returned by \code{parse()} (wrapped in a list)