R Under development (unstable) (2024-06-28 r86850 ucrt) -- "Unsuffered Consequences" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > local({ + owd <- getwd() + if (is.null(owd)) { + message("cannot 'chdir' as current directory is unknown") + return(invisible()) + } else on.exit(setwd(owd), add = TRUE) + + + ## test for 3 specific cases of sourcing + ## * sourcing a file by specifying its basename + ## * sourcing a file by specifying its absolute path + ## * sourcing a file by specifying one of its relative paths + abs_path_R <- tempfile("test", fileext = ".R") + on.exit(unlink(abs_path_R), add = TRUE) + this.path:::.writeCode({ + n <- this.path:::.getframenumber() + if (is.na(n) || n < 1L) stop("invalid traceback") + sym <- ".this.path::document.context" + frame <- sys.frame(n) + if (!exists(sym, envir = frame, inherits = FALSE)) + sym <- ".this.path::document.contexts" + stopifnot(bindingIsLocked(sym, frame)) + cat("\n> getwd()\n") + print(getwd()) + cat("\n> ", paste(deparse(call("dynGet", sym)), collapse = "\n+ "), "\n", sep = "") + print(frame[[sym]]) + cat("\n> this.path::sys.path(original = TRUE)\n") + print(this.path::sys.path(original = TRUE)) + cat("\n> this.path::sys.path(for.msg = TRUE)\n") + print(this.path::sys.path(for.msg = TRUE)) + cat("\n> sys.path(verbose = TRUE)\n") + stopifnot(identical( + print(this.path::sys.path(verbose = TRUE)), + getOption("this.path::sys.path() expectation") + )) + cat("\n> this.path::sys.path(original = TRUE)\n") + print(this.path::sys.path(original = TRUE)) + cat("\n> this.path::sys.path(for.msg = TRUE)\n") + print(this.path::sys.path(for.msg = TRUE)) + }, file = abs_path_R) + abs_path_R <- normalizePath(abs_path_R, "/", TRUE) + abs_path_dir <- normalizePath(R.home(), "/", TRUE) + basename_R <- this.path::basename2(abs_path_R) + basename_dir <- this.path::dirname2(abs_path_R) + + + rel_path_and_dir <- function(file) { + x <- this.path::path.split.1(file) + n <- length(x) + if (n < 3L) { + c(this.path::dirname2(file), this.path::basename2(file)) + } else { + i <- n < seq_len(n) + max(2L, n%/%2L) + c(this.path::path.unsplit(x[!i]), this.path::path.unsplit(x[i])) + } + } + tmp <- rel_path_and_dir(abs_path_R) + rel_path_dir <- tmp[[1L]] + rel_path_R <- tmp[[2L]] + rm(tmp) + + + ## for 'source' and 'debugSource' specifically, + ## try sourcing a 'file://' URL + basename_R_URL <- this.path:::.as_file_URL(basename_R) + rel_path_R_URL <- this.path:::.as_file_URL(rel_path_R) + abs_path_R_URL <- this.path:::.as_file_URL(abs_path_R) + + + fun <- function(expr, envir = parent.frame(), + bquote.envir = envir, eval.envir = envir) + { + if (!is.environment(envir)) + stop("not an environment", domain = "R") + expr <- call("bquote", substitute(expr), as.symbol("bquote.envir")) + expr <- eval(expr) + dep <- deparse(expr) + cat("\n\n\n\n\n\n\n\n\n\n") + cat("\n> getwd()\n") + print(getwd()) + cat("\n> ") + cat(dep, sep = "\n+ ") + eval(expr, eval.envir) + } + + + oopt <- options(`this.path::sys.path() expectation` = normalizePath(abs_path_R, "/", TRUE)) + on.exit(options(oopt), add = TRUE) + + + ## try using source in all possible manners + setwd(basename_dir) + fun(source(.(basename_R) , local = TRUE, chdir = FALSE)) ## from a basename without changing directory + fun(source(.(basename_R) , local = TRUE, chdir = TRUE )) ## from a basename with changing directory (shouldn't do anything) + fun(source(.(basename_R_URL) , local = TRUE)) ## from a basename 'file://' URL + fun(source(print(conn <- file(open = "r", .(basename_R))), local = TRUE)) ; close(conn) ## from a basename connection + setwd(rel_path_dir) + fun(source(.(rel_path_R) , local = TRUE, chdir = FALSE)) ## from a relative path without changing directory + fun(source(.(rel_path_R) , local = TRUE, chdir = TRUE )) ## from a relative path with changing directory + fun(source(.(rel_path_R_URL) , local = TRUE)) ## from a relative path 'file://' URL + fun(source(print(conn <- file(open = "r", .(rel_path_R))), local = TRUE)) ; close(conn) ## from a relative path connection + setwd(abs_path_dir) + fun(source(.(abs_path_R) , local = TRUE, chdir = FALSE)) ## from an absolute path without changing directory + fun(source(.(abs_path_R) , local = TRUE, chdir = TRUE )) ## from an absolute path with changing directory + fun(source(.(abs_path_R_URL) , local = TRUE)) ## from an absolute path 'file://' URL + fun(source(print(conn <- file(open = "r", .(abs_path_R))), local = TRUE)) ; close(conn) ## from an absolute path connection + + + ## 'sys.source' cannot handle 'file://' URLs nor connections + setwd(basename_dir) + fun(sys.source(.(basename_R), envir = environment(), chdir = FALSE)) + fun(sys.source(.(basename_R), envir = environment(), chdir = TRUE )) + setwd(rel_path_dir) + fun(sys.source(.(rel_path_R), envir = environment(), chdir = FALSE)) + fun(sys.source(.(rel_path_R), envir = environment(), chdir = TRUE )) + setwd(abs_path_dir) + fun(sys.source(.(abs_path_R), envir = environment(), chdir = FALSE)) + fun(sys.source(.(abs_path_R), envir = environment(), chdir = TRUE )) + + + ## 'debugSource' cannot handle connections + if (.Platform$GUI == "RStudio") { + debugSource <- get("debugSource", "tools:rstudio", inherits = FALSE) + setwd(basename_dir) + fun(debugSource(.(basename_R) )) + fun(debugSource(.(basename_R_URL))) + setwd(rel_path_dir) + fun(debugSource(.(rel_path_R) )) + fun(debugSource(.(rel_path_R_URL))) + setwd(abs_path_dir) + fun(debugSource(.(abs_path_R) )) + fun(debugSource(.(abs_path_R_URL))) + } + + + ## 'compiler::loadcmp' cannot handle 'file://' URLs nor connections + if (requireNamespace("compiler", quietly = TRUE)) { + basename_Rc <- basename_R; this.path::ext(basename_Rc) <- ".Rc" + rel_path_Rc <- rel_path_R; this.path::ext(rel_path_Rc) <- ".Rc" + abs_path_Rc <- abs_path_R; this.path::ext(abs_path_Rc) <- ".Rc" + + + on.exit(unlink(abs_path_Rc), add = TRUE) + compiler::cmpfile(abs_path_R, abs_path_Rc) + + + opt2 <- options(`this.path::sys.path() expectation` = normalizePath(abs_path_Rc, "/", TRUE)) + setwd(basename_dir) + fun(compiler::loadcmp(.(basename_Rc), envir = environment(), chdir = FALSE)) + fun(compiler::loadcmp(.(basename_Rc), envir = environment(), chdir = TRUE )) + setwd(rel_path_dir) + fun(compiler::loadcmp(.(rel_path_Rc), envir = environment(), chdir = FALSE)) + fun(compiler::loadcmp(.(rel_path_Rc), envir = environment(), chdir = TRUE )) + setwd(abs_path_dir) + fun(compiler::loadcmp(.(abs_path_Rc), envir = environment(), chdir = FALSE)) + fun(compiler::loadcmp(.(abs_path_Rc), envir = environment(), chdir = TRUE )) + options(opt2) + } + + + ## 'utils::Sweave' cannot handle 'file://' URLs nor connections + if (requireNamespace("utils", quietly = TRUE)) { + basename_Rnw <- basename_R; this.path::ext(basename_Rnw) <- ".Rnw" + abs_path_Rnw <- abs_path_R; this.path::ext(abs_path_Rnw) <- ".Rnw" + + + on.exit(unlink(abs_path_Rnw), add = TRUE) + writeLines(c( + "\\documentclass{article}", + "", + "\\begin{document}", + "", + "<<>>=", + ## remove expressions starting with 'cat' + { + exprs <- parse(abs_path_R) + exprs <- exprs[!vapply(exprs, function(expr) { + is.call(expr) && identical(expr[[1L]], as.symbol("cat")) + }, NA, USE.NAMES = FALSE)] + this.path:::.writeCode(exprs, NULL) + }, + "@", + "", + "\\end{document}" + ), abs_path_Rnw) + + + opt2 <- options(`this.path::sys.path() expectation` = normalizePath(abs_path_Rnw, "/", TRUE)) + setwd(basename_dir) + outputname <- fun(utils::Sweave(.(basename_Rnw))) + writeLines(readLines(outputname)) + unlink(outputname) + + + tmpdir <- tempfile("dir") + on.exit(unlink(tmpdir, recursive = TRUE, force = TRUE), add = TRUE) + dir.create(tmpdir) + setwd(tmpdir) + writeLines(readLines(fun(utils::Sweave(.(this.path::path.join("..", basename_Rnw)))))) + options(opt2) + } + + + ## 'box::use' cannot handle 'file://' URLs nor connections nor absolute paths + if (requireNamespace("box", quietly = TRUE)) { + tmp <- c(sub("\\.R$", ".r", abs_path_R), abs_path_R) + tmp <- tmp[[match(TRUE, file.exists(tmp))]] + opt2 <- options(`this.path::sys.path() expectation` = normalizePath(tmp, "/", TRUE)) + setwd(basename_dir); box::set_script_path(this.path::path.join(basename_dir, ".")) + fun(box::use(module = ./.(as.symbol(sub("\\.R$", "", basename_R))))); box::unload(module) + if (!this.path:::.is_abs_path(rel_path_R)) { + tmp_fun <- function(x) { + n <- length(x) + if (n > 1L) + call("/", tmp_fun(x[-n]), as.symbol(x[[n]])) + else as.symbol(x[[1L]]) + } + tmp <- tmp_fun(c(".", this.path::path.split.1(sub("\\.R$", "", rel_path_R)))) + setwd(rel_path_dir); box::set_script_path(this.path::path.join(rel_path_dir, ".")) + fun(box::use(module = .(tmp))); box::unload(module) + rm(tmp, tmp_fun) + } + options(opt2) + } + + + ## 'knitr::knit' cannot handle 'file://' URLs + if (requireNamespace("knitr", quietly = TRUE)) { + basename_Rmd <- basename_R; this.path::ext(basename_Rmd) <- ".Rmd" + rel_path_Rmd <- rel_path_R; this.path::ext(rel_path_Rmd) <- ".Rmd" + abs_path_Rmd <- abs_path_R; this.path::ext(abs_path_Rmd) <- ".Rmd" + + + on.exit(unlink(abs_path_Rmd), add = TRUE) + writeLines(c( + "```{r}", + ## remove expressions starting with 'cat' + { + exprs <- parse(abs_path_R) + exprs <- exprs[!vapply(exprs, function(expr) { + is.call(expr) && identical(expr[[1L]], as.symbol("cat")) + }, NA, USE.NAMES = FALSE)] + this.path:::.writeCode(exprs, NULL) + }, + "```" + ), abs_path_Rmd) + + + opt2 <- options(`this.path::sys.path() expectation` = normalizePath(abs_path_Rmd, "/", TRUE)) + setwd(basename_dir) + fun(knitr::knit(.(basename_Rmd) , output = stdout(), quiet = TRUE)) + fun(knitr::knit(print(conn <- file(.(basename_Rmd))), output = stdout(), quiet = TRUE)); close(conn) + setwd(rel_path_dir) + fun(knitr::knit(.(rel_path_Rmd) , output = stdout(), quiet = TRUE)) + fun(knitr::knit(print(conn <- file(.(rel_path_Rmd))), output = stdout(), quiet = TRUE)); close(conn) + setwd(abs_path_dir) + fun(knitr::knit(.(abs_path_Rmd) , output = stdout(), quiet = TRUE)) + fun(knitr::knit(print(conn <- file(.(abs_path_Rmd))), output = stdout(), quiet = TRUE)); close(conn) + options(opt2) + } + + + ## 'plumber::plumb' cannot handle 'file://' URLs nor connections + if (requireNamespace("plumber", quietly = TRUE)) { + opt2 <- options(`this.path::sys.path() expectation` = normalizePath(abs_path_R, "/", TRUE)) + setwd(basename_dir) + fun(plumber::plumb(.(basename_R))) + setwd(rel_path_dir) + fun(plumber::plumb(.(rel_path_R))) + setwd(abs_path_dir) + fun(plumber::plumb(.(abs_path_R))) + options(opt2) + + + entrypoint_R <- this.path::path.join(basename_dir, "entrypoint.R") + on.exit(unlink(entrypoint_R), add = TRUE) + writeLines(c( + readLines(abs_path_R), + "plumber::Plumber$new()" + ), entrypoint_R) + opt2 <- options(`this.path::sys.path() expectation` = normalizePath(entrypoint_R, "/", TRUE)) + setwd(basename_dir) + fun(plumber::plumb()) + setwd(rel_path_dir) + fun(plumber::plumb(dir = .(dirname(rel_path_R)))) + setwd(abs_path_dir) + fun(plumber::plumb(dir = .(dirname(abs_path_R)))) + options(opt2) + } + + + ## 'shiny::runApp' + if (requireNamespace("shiny", quietly = TRUE)) { + shinytmp <- tempfile("shinytmp", tmpdir = basename_dir) + on.exit(unlink(shinytmp, recursive = TRUE, force = TRUE), add = TRUE) + dir.create(shinytmp) + file <- this.path::path.join(shinytmp, "app.R") + writeLines(c( + readLines(abs_path_R), + "stop(structure(list(message = \"\", call = NULL), class = c(\"this_path_tests_R_catch_this_error\", \"error\", \"condition\")))" + ), file) + opt2 <- options(`this.path::sys.path() expectation` = normalizePath(file, "/", TRUE)) + rm(file) + abs_path_app_R <- normalizePath(shinytmp, "/", TRUE) + abs_path_app_dir <- abs_path_dir + basename_app_R <- "." + basename_app_dir <- abs_path_app_R + tmp <- rel_path_and_dir(abs_path_app_R) + rel_path_app_dir <- tmp[[1L]] + rel_path_app_R <- tmp[[2L]] + rm(tmp) + setwd(basename_app_dir) + this.path::tryCatch3({ + fun(shiny::runApp(.(basename_app_R))) + }, this_path_tests_R_catch_this_error = ) + setwd(rel_path_app_dir) + this.path::tryCatch3({ + fun(shiny::runApp(.(rel_path_app_R))) + }, this_path_tests_R_catch_this_error = ) + setwd(abs_path_app_dir) + this.path::tryCatch3({ + fun(shiny::runApp(.(abs_path_app_R))) + }, this_path_tests_R_catch_this_error = ) + options(opt2) + } + + + ## 'testthat::source_file' cannot handle 'file://' URLs nor connections + if (requireNamespace("testthat", quietly = TRUE)) { + setwd(basename_dir) + fun(testthat::source_file(.(basename_R), env = environment(), chdir = FALSE, wrap = FALSE)) + fun(testthat::source_file(.(basename_R), env = environment(), chdir = FALSE, wrap = TRUE )) + fun(testthat::source_file(.(basename_R), env = environment(), chdir = TRUE , wrap = FALSE)) + fun(testthat::source_file(.(basename_R), env = environment(), chdir = TRUE , wrap = TRUE )) + setwd(rel_path_dir) + fun(testthat::source_file(.(rel_path_R), env = environment(), chdir = FALSE, wrap = FALSE)) + fun(testthat::source_file(.(rel_path_R), env = environment(), chdir = FALSE, wrap = TRUE )) + fun(testthat::source_file(.(rel_path_R), env = environment(), chdir = TRUE , wrap = FALSE)) + fun(testthat::source_file(.(rel_path_R), env = environment(), chdir = TRUE , wrap = TRUE )) + setwd(abs_path_dir) + fun(testthat::source_file(.(abs_path_R), env = environment(), chdir = FALSE, wrap = FALSE)) + fun(testthat::source_file(.(abs_path_R), env = environment(), chdir = FALSE, wrap = TRUE )) + fun(testthat::source_file(.(abs_path_R), env = environment(), chdir = TRUE , wrap = FALSE)) + fun(testthat::source_file(.(abs_path_R), env = environment(), chdir = TRUE , wrap = TRUE )) + } + + + invisible() + }) > getwd() [1] "D:/temp/RtmpK4xprQ" > source("test186a876251728.R", local = TRUE, chdir = FALSE) > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "test186a876251728.R" file: .normalizePath("test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/temp/RtmpK4xprQ" > source("test186a876251728.R", local = TRUE, chdir = TRUE) > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "test186a876251728.R" file: .normalizePath("test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/temp/RtmpK4xprQ" > source("file://test186a876251728.R", local = TRUE) > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "file://test186a876251728.R" file: .normalizePath("test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "file://test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "file://test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "file://test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/temp/RtmpK4xprQ" > source(print(conn <- file(open = "r", "test186a876251728.R")), + local = TRUE) A connection with description "test186a876251728.R" class "file" mode "r" text "text" opened "opened" can read "yes" can write "no" > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "file://test186a876251728.R" file: .normalizePath("test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "file://test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "file://test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "file://test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/temp" > source("RtmpK4xprQ/test186a876251728.R", local = TRUE, chdir = FALSE) > getwd() [1] "D:/temp" > dynGet(".this.path::document.context") ofile: "RtmpK4xprQ/test186a876251728.R" file: .normalizePath("RtmpK4xprQ/test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "RtmpK4xprQ/test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/temp" > source("RtmpK4xprQ/test186a876251728.R", local = TRUE, chdir = TRUE) > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "RtmpK4xprQ/test186a876251728.R" wd: "D:/temp" file: .normalizePath_against(wd, "RtmpK4xprQ/test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "RtmpK4xprQ/test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/temp" > source("file://RtmpK4xprQ/test186a876251728.R", local = TRUE) > getwd() [1] "D:/temp" > dynGet(".this.path::document.context") ofile: "file://RtmpK4xprQ/test186a876251728.R" file: .normalizePath("RtmpK4xprQ/test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "file://RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "file://RtmpK4xprQ/test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "file://RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/temp" > source(print(conn <- file(open = "r", "RtmpK4xprQ/test186a876251728.R")), + local = TRUE) A connection with description "RtmpK4xprQ/test186a876251728.R" class "file" mode "r" text "text" opened "opened" can read "yes" can write "no" > getwd() [1] "D:/temp" > dynGet(".this.path::document.context") ofile: "file://RtmpK4xprQ/test186a876251728.R" file: .normalizePath("RtmpK4xprQ/test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "file://RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "file://RtmpK4xprQ/test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "file://RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/RCompile/recent/R" > source("D:/temp/RtmpK4xprQ/test186a876251728.R", local = TRUE, + chdir = FALSE) > getwd() [1] "D:/RCompile/recent/R" > dynGet(".this.path::document.context") ofile: "D:/temp/RtmpK4xprQ/test186a876251728.R" file: .normalizePath("D:/temp/RtmpK4xprQ/test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/RCompile/recent/R" > source("D:/temp/RtmpK4xprQ/test186a876251728.R", local = TRUE, + chdir = TRUE) > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "D:/temp/RtmpK4xprQ/test186a876251728.R" wd: "D:/RCompile/recent/R" file: .normalizePath_against(wd, "D:/temp/RtmpK4xprQ/test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/RCompile/recent/R" > source("file:///D:/temp/RtmpK4xprQ/test186a876251728.R", local = TRUE) > getwd() [1] "D:/RCompile/recent/R" > dynGet(".this.path::document.context") ofile: "file:///D:/temp/RtmpK4xprQ/test186a876251728.R" file: .normalizePath("D:/temp/RtmpK4xprQ/test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "file:///D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "file:///D:/temp/RtmpK4xprQ/test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "file:///D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/RCompile/recent/R" > source(print(conn <- file(open = "r", "D:/temp/RtmpK4xprQ/test186a876251728.R")), + local = TRUE) A connection with description "D:/temp/RtmpK4xprQ/test186a876251728.R" class "file" mode "r" text "text" opened "opened" can read "yes" can write "no" > getwd() [1] "D:/RCompile/recent/R" > dynGet(".this.path::document.context") ofile: "file:///D:/temp/RtmpK4xprQ/test186a876251728.R" file: .normalizePath("D:/temp/RtmpK4xprQ/test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "file:///D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "file:///D:/temp/RtmpK4xprQ/test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "file:///D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/temp/RtmpK4xprQ" > sys.source("test186a876251728.R", envir = environment(), chdir = FALSE) > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "test186a876251728.R" file: .normalizePath("test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'sys.source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/temp/RtmpK4xprQ" > sys.source("test186a876251728.R", envir = environment(), chdir = TRUE) > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "test186a876251728.R" file: .normalizePath("test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'sys.source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/temp" > sys.source("RtmpK4xprQ/test186a876251728.R", envir = environment(), + chdir = FALSE) > getwd() [1] "D:/temp" > dynGet(".this.path::document.context") ofile: "RtmpK4xprQ/test186a876251728.R" file: .normalizePath("RtmpK4xprQ/test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "RtmpK4xprQ/test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'sys.source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/temp" > sys.source("RtmpK4xprQ/test186a876251728.R", envir = environment(), + chdir = TRUE) > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "RtmpK4xprQ/test186a876251728.R" wd: "D:/temp" file: .normalizePath_against(wd, "RtmpK4xprQ/test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "RtmpK4xprQ/test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'sys.source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/RCompile/recent/R" > sys.source("D:/temp/RtmpK4xprQ/test186a876251728.R", envir = environment(), + chdir = FALSE) > getwd() [1] "D:/RCompile/recent/R" > dynGet(".this.path::document.context") ofile: "D:/temp/RtmpK4xprQ/test186a876251728.R" file: .normalizePath("D:/temp/RtmpK4xprQ/test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'sys.source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > getwd() [1] "D:/RCompile/recent/R" > sys.source("D:/temp/RtmpK4xprQ/test186a876251728.R", envir = environment(), + chdir = TRUE) > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "D:/temp/RtmpK4xprQ/test186a876251728.R" wd: "D:/RCompile/recent/R" file: .normalizePath_against(wd, "D:/temp/RtmpK4xprQ/test186a876251728.R") source: > this.path::sys.path(original = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > sys.path(verbose = TRUE) Source: call to function 'sys.source' [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(original = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.R" saving to file "D:/temp/RtmpK4xprQ/test186a876251728.Rc" ... done > getwd() [1] "D:/temp/RtmpK4xprQ" > compiler::loadcmp("test186a876251728.Rc", envir = environment(), + chdir = FALSE) > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "test186a876251728.Rc" file: .normalizePath("test186a876251728.Rc") source: > this.path::sys.path(original = TRUE) [1] "test186a876251728.Rc" > this.path::sys.path(for.msg = TRUE) [1] "test186a876251728.Rc" > sys.path(verbose = TRUE) Source: call to function 'loadcmp' from package 'compiler' [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(original = TRUE) [1] "test186a876251728.Rc" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > getwd() [1] "D:/temp/RtmpK4xprQ" > compiler::loadcmp("test186a876251728.Rc", envir = environment(), + chdir = TRUE) > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "test186a876251728.Rc" file: .normalizePath("test186a876251728.Rc") source: > this.path::sys.path(original = TRUE) [1] "test186a876251728.Rc" > this.path::sys.path(for.msg = TRUE) [1] "test186a876251728.Rc" > sys.path(verbose = TRUE) Source: call to function 'loadcmp' from package 'compiler' [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(original = TRUE) [1] "test186a876251728.Rc" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > getwd() [1] "D:/temp" > compiler::loadcmp("RtmpK4xprQ/test186a876251728.Rc", envir = environment(), + chdir = FALSE) > getwd() [1] "D:/temp" > dynGet(".this.path::document.context") ofile: "RtmpK4xprQ/test186a876251728.Rc" file: .normalizePath("RtmpK4xprQ/test186a876251728.Rc") source: > this.path::sys.path(original = TRUE) [1] "RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(for.msg = TRUE) [1] "RtmpK4xprQ/test186a876251728.Rc" > sys.path(verbose = TRUE) Source: call to function 'loadcmp' from package 'compiler' [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(original = TRUE) [1] "RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > getwd() [1] "D:/temp" > compiler::loadcmp("RtmpK4xprQ/test186a876251728.Rc", envir = environment(), + chdir = TRUE) > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "RtmpK4xprQ/test186a876251728.Rc" wd: "D:/temp" file: .normalizePath_against(wd, "RtmpK4xprQ/test186a876251728.Rc") source: > this.path::sys.path(original = TRUE) [1] "RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(for.msg = TRUE) [1] "RtmpK4xprQ/test186a876251728.Rc" > sys.path(verbose = TRUE) Source: call to function 'loadcmp' from package 'compiler' [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(original = TRUE) [1] "RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > getwd() [1] "D:/RCompile/recent/R" > compiler::loadcmp("D:/temp/RtmpK4xprQ/test186a876251728.Rc", + envir = environment(), chdir = FALSE) > getwd() [1] "D:/RCompile/recent/R" > dynGet(".this.path::document.context") ofile: "D:/temp/RtmpK4xprQ/test186a876251728.Rc" file: .normalizePath("D:/temp/RtmpK4xprQ/test186a876251728.Rc") source: > this.path::sys.path(original = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > sys.path(verbose = TRUE) Source: call to function 'loadcmp' from package 'compiler' [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(original = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > getwd() [1] "D:/RCompile/recent/R" > compiler::loadcmp("D:/temp/RtmpK4xprQ/test186a876251728.Rc", + envir = environment(), chdir = TRUE) > getwd() [1] "D:/temp/RtmpK4xprQ" > dynGet(".this.path::document.context") ofile: "D:/temp/RtmpK4xprQ/test186a876251728.Rc" wd: "D:/RCompile/recent/R" file: .normalizePath_against(wd, "D:/temp/RtmpK4xprQ/test186a876251728.Rc") source: > this.path::sys.path(original = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > sys.path(verbose = TRUE) Source: call to function 'loadcmp' from package 'compiler' [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(original = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > this.path::sys.path(for.msg = TRUE) [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rc" > getwd() [1] "D:/temp/RtmpK4xprQ" > utils::Sweave("test186a876251728.Rnw") Writing to file test186a876251728.tex Processing code chunks with options ... 1 : echo keep.source term verbatim (test186a876251728.Rnw:5) You can now run (pdf)latex on 'test186a876251728.tex' \documentclass{article} \usepackage{Sweave} \begin{document} \begin{Schunk} \begin{Sinput} > n <- this.path:::.getframenumber() > if (is.na(n) || n < 1L) stop("invalid traceback") > sym <- ".this.path::document.context" > frame <- sys.frame(n) > if (!exists(sym, envir = frame, inherits = FALSE)) sym <- ".this.path::document.contexts" > stopifnot(bindingIsLocked(sym, frame)) > print(getwd()) \end{Sinput} \begin{Soutput} [1] "D:/temp/RtmpK4xprQ" \end{Soutput} \begin{Sinput} > print(frame[[sym]]) \end{Sinput} \begin{Soutput} $test186a876251728.Rnw ofile: "test186a876251728.Rnw" file: .normalizePath("test186a876251728.Rnw") source: \end{Soutput} \begin{Sinput} > print(this.path::sys.path(original = TRUE)) \end{Sinput} \begin{Soutput} [1] "test186a876251728.Rnw" \end{Soutput} \begin{Sinput} > print(this.path::sys.path(for.msg = TRUE)) \end{Sinput} \begin{Soutput} [1] "test186a876251728.Rnw" \end{Soutput} \begin{Sinput} > stopifnot(identical(print(this.path::sys.path(verbose = TRUE)), + getOption("this.path::sys.path() expectation"))) \end{Sinput} \begin{Soutput} Source: call to function 'Sweave' from package 'utils' [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rnw" \end{Soutput} \begin{Sinput} > print(this.path::sys.path(original = TRUE)) \end{Sinput} \begin{Soutput} [1] "test186a876251728.Rnw" \end{Soutput} \begin{Sinput} > print(this.path::sys.path(for.msg = TRUE)) \end{Sinput} \begin{Soutput} [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rnw" \end{Soutput} \end{Schunk} \end{document} > getwd() [1] "D:/temp/RtmpK4xprQ/dir186a87cae4a07" > utils::Sweave("../test186a876251728.Rnw") Writing to file test186a876251728.tex Processing code chunks with options ... 1 : echo keep.source term verbatim (test186a876251728.Rnw:5) You can now run (pdf)latex on 'test186a876251728.tex' \documentclass{article} \usepackage{Sweave} \begin{document} \begin{Schunk} \begin{Sinput} > n <- this.path:::.getframenumber() > if (is.na(n) || n < 1L) stop("invalid traceback") > sym <- ".this.path::document.context" > frame <- sys.frame(n) > if (!exists(sym, envir = frame, inherits = FALSE)) sym <- ".this.path::document.contexts" > stopifnot(bindingIsLocked(sym, frame)) > print(getwd()) \end{Sinput} \begin{Soutput} [1] "D:/temp/RtmpK4xprQ/dir186a87cae4a07" \end{Soutput} \begin{Sinput} > print(frame[[sym]]) \end{Sinput} \begin{Soutput} $`../test186a876251728.Rnw` ofile: "../test186a876251728.Rnw" file: .normalizePath("../test186a876251728.Rnw") source: \end{Soutput} \begin{Sinput} > print(this.path::sys.path(original = TRUE)) \end{Sinput} \begin{Soutput} [1] "../test186a876251728.Rnw" \end{Soutput} \begin{Sinput} > print(this.path::sys.path(for.msg = TRUE)) \end{Sinput} \begin{Soutput} [1] "../test186a876251728.Rnw" \end{Soutput} \begin{Sinput} > stopifnot(identical(print(this.path::sys.path(verbose = TRUE)), + getOption("this.path::sys.path() expectation"))) \end{Sinput} \begin{Soutput} Source: call to function 'Sweave' from package 'utils' [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rnw" \end{Soutput} \begin{Sinput} > print(this.path::sys.path(original = TRUE)) \end{Sinput} \begin{Soutput} [1] "../test186a876251728.Rnw" \end{Soutput} \begin{Sinput} > print(this.path::sys.path(for.msg = TRUE)) \end{Sinput} \begin{Soutput} [1] "D:/temp/RtmpK4xprQ/test186a876251728.Rnw" \end{Soutput} \end{Schunk} \end{document} > > > local({ + FILE.R <- tempfile(fileext = ".R") + on.exit(unlink(FILE.R)) + this.path:::.writeCode({ + stopifnot(identical( + this.path::this.path(), + getOption("this.path::this.path() expectation") + )) + }, FILE.R) + oopt <- options( + `this.path::this.path() expectation` = normalizePath(FILE.R, "/", TRUE), + keep.source = TRUE + ) + on.exit(options(oopt), add = TRUE) + eval( + parse(FILE.R), + structure(list2env(list(.packageName = FILE.R), parent = .BaseNamespaceEnv), path = FILE.R) + ) + eval(parse(FILE.R)) + }) > > > local({ + FILE.R <- tempfile(fileext = ".R") + on.exit(unlink(FILE.R)) + this.path:::.writeCode({ + list( + this.path::src.path(original = TRUE), + this.path::src.path(original = NA), + this.path::src.path(), + this.path::src.path(original = TRUE), + this.path::src.path(original = NA) + ) + }, FILE.R) + oopt <- options(keep.source = TRUE) + on.exit(options(oopt), add = TRUE) + stopifnot(identical( + eval(parse(FILE.R)), + list(FILE.R, normalizePath(FILE.R, "/", TRUE))[c(1L, 1L, 2L, 1L, 2L)] + )) + }) > > > local({ + FILE1.R <- tempfile(pattern = "file1_", fileext = ".R") + on.exit(unlink(FILE1.R), add = TRUE) + this.path:::.writeCode({ + fun <- function(x) x + fun1 <- function() fun(this.path::src.path()) + }, FILE1.R) + source(FILE1.R, environment(), keep.source = TRUE) + + + FILE2.R <- tempfile(pattern = "file2_", fileext = ".R") + on.exit(unlink(FILE2.R), add = TRUE) + this.path:::.writeCode({ + fun2 <- function() fun(this.path::src.path()) + }, FILE2.R) + source(FILE2.R, environment(), keep.source = TRUE) + + + ## it might seem weird to use eval(expression()) + ## it is just to prevent the expressions from having source references + stopifnot(identical(eval(expression(fun1())), normalizePath(FILE1.R, "/", TRUE))) + stopifnot(identical(eval(expression(fun2())), normalizePath(FILE2.R, "/", TRUE))) + + + FILE3.R <- tempfile("file3_", fileext = ".R") + on.exit(unlink(FILE3.R), add = TRUE) + this.path:::.writeCode({ + x <- list(fun1(), fun2(), fun(this.path::src.path())) + }, FILE3.R) + source(FILE3.R, environment(), keep.source = TRUE) + stopifnot(identical(x, as.list(normalizePath(c(FILE1.R, FILE2.R, FILE3.R), "/", TRUE)))) + }) > > proc.time() user system elapsed 0.70 0.14 0.81