path_rel2abs() will not expand symlinks to avoid problems with Python…

…'s venv. (fix #64)

DESCRIPTION

@@ -23,6 +23,7 @@ Imports:
         stats,
         utils,
         compiler,
+        fs,
         matrixStats,
         R6,
         withr

NEWS.md

@@ -37,16 +37,22 @@
    a different version of irace, since such attempts typically end up in errors
    that are difficult to understand.
 
- * irace warns about using `'&&'` and `'||'` instead of `'&'` and `'|'` in parameter conditions. A future version of irace will reject those uses as errors.
+ * irace warns about using `'&&'` and `'||'` instead of `'&'` and `'|'` in parameter conditions.
+   A future version of irace will reject those uses as errors.
 
- * The internal function `irace.reload.debug()` has been removed.  Use `devtools::reload()` instead.
+ * The internal function `irace.reload.debug()` has been removed.
+   Use `devtools::reload()` instead.
 
  * The column `"instance"` of the `instancesList` data frame stored in the
    logFile has been renamed to `"instanceID"`.  This data frame should not be
    accessed directly. Instead use the new function
    `get_instanceID_seed_pairs()`.
 
- * Using `maxTime > 0` with `elitist=0` now gives a clear error rather than fail later (fix #65).
+ * Using `maxTime > 0` with `elitist=0` now gives a clear error rather than fail later.
+                                                    (fix #65, reported by @DE0CH)
+
+ * `path_rel2abs()` will not expand symlinks to avoid problems with Python's venv.
+                                                    (fix #64, reported by @DE0CH)
 
 
 ## New features and improvements

R/irace-package.R

@@ -8,7 +8,6 @@
 #' @importFrom R6 R6Class
 #' @importFrom grDevices dev.off pdf
 #' @importFrom graphics abline axis boxplot par plot points strwidth bxp grid
-#'
 #' 
 #' @details  License: GPL (>= 2)
 #' 

R/path_rel2abs.R

@@ -1,5 +1,6 @@
 #' Converts a relative path to an absolute path. It tries really hard to create
-#' canonical paths.
+#' canonical paths. If the path passed corresponds to an executable, it tries
+#' to find its path using `Sys.which()`.
 #' 
 #' @param path (`character(1)`) Character string representing a relative path.
 #' @param cwd (`character(1)`) Current working directory.
@@ -11,117 +12,21 @@
 #' @export
 path_rel2abs <- function (path, cwd = getwd())
 {
-  # Keep doing gsub as long as x keeps changing.
-  gsub.all <- function(pattern, repl, x, ...) {
-    repeat {
-      newx <- gsub(pattern, repl, x, ...)
-      if (newx == x) return(newx)
-      x <- newx
+  # There is no need to normalize cwd if it was returned by getwd()
+  if (!missing(cwd))
+    cwd <- fs::path_expand(cwd)
+
+  if (fs::is_absolute_path(path)) {
+    # Possibly expand ~/path to /home/user/path.
+    path <- fs::path_expand(path)
+  } else {
+    # it may be a command in the path.
+    sys_path <- suppressWarnings(Sys.which(path))
+    if (nzchar(sys_path)
+      && fs::file_access(sys_path, "execute")
+      && fs::is_file(sys_path)) {
+      path <- as.vector(sys_path)
     }
   }
-  # FIXME: Why NA and not FALSE?
-  irace_normalize_path <- function(path)
-    suppressWarnings(normalizePath(path, winslash = "/", mustWork = NA))
-
-  if (is.null.or.na(path)) {
-    return (NULL)
-  } else if (path == "") {
-    return ("")
-  }
-
-  # Using .Platform$file.sep is too fragile. Better just use "/" everywhere.
-  s <- "/"
-
-  # Possibly expand ~/path to /home/user/path.
-  path <- path.expand(path)
-  # Remove winslashes if given.
-  path <- gsub("\\", s, path, fixed = TRUE)
-
-  # Detect a Windows drive
-  windrive.regex <- "^[A-Za-z]:"
-  windrive <- ""
-  if (grepl(paste0(windrive.regex, "($|", s, ")"), path)) {
-    m <- regexpr(windrive.regex, path)
-    windrive <- regmatches(path, m)
-    path <- sub(windrive.regex, "", path)
-  }
-
-  # Change "/./" to "/" to get a canonical form 
-  path <- gsub.all(paste0(s, ".", s), s, path, fixed = TRUE)
-  # Change "//" to "/" to get a canonical form 
-  path <- gsub(paste0(s, s, "+"), s, path)
-  # Change "/.$" to "/" to get a canonical form 
-  path <- sub(paste0(s, "\\.$"), s, path)
-  # Drop final "/"
-  path <- sub(paste0(s, "$"), "", path)
-  if (path == "") path <- s
-
-  # Prefix the current cwd to the path if it doesn't start with
-  # / \\ or whatever separator.
-  if (path == "." || !startsWith(path, s)) {
-    # There is no need to normalize cwd if it was returned by getwd()
-    if (!missing(cwd)) {
-      # Recurse to get absolute cwd
-      cwd <- path_rel2abs(cwd)
-    }
-
-    # Speed-up the most common cases.
-    # If it is just "."
-    if (path == ".") return (irace_normalize_path(cwd))
-
-    # If it does not contain separators at all and does not start with ".."
-    if (!startsWith(path, "..") && !grepl(s, path)) {
-      # it may be a command in the path.
-      sys_path <- suppressWarnings(Sys.which(path))
-      if (nchar(sys_path) > 0
-          && file.access(sys_path, mode = 1) == 0
-          && !file.info(sys_path)$isdir) {
-        return(irace_normalize_path(as.vector(sys_path)))
-      }
-    }
-
-    # Remove "./" from the start of path.
-    path <- sub(paste0("^\\.", s), "", path)
-    # Make it absolute but avoid doubling s
-    if (substring(cwd, nchar(cwd)) == s) path <- paste0(cwd, path)
-    else path <- paste0(cwd, s, path)
-    # If it is just a path without ".." inside
-    if (!grepl(paste0(s,"\\.\\."), path)) {
-      return (irace_normalize_path(path))
-    }
-    # Detect a Windows drive
-    if (grepl(paste0(windrive.regex, "($|", s, ")"), path)) {
-      m <- regexpr(windrive.regex, path)
-      windrive <- regmatches(path, m)
-      path <- sub(windrive.regex, "", path)
-    }
-  }
-  # else
-
-  # Change "/x/.." to "/" to get a canonical form 
-  prevdir.regex <- paste0(s, "[^", s,"]+", s, "\\.\\.")
-  repeat {
-    # We need to do it one by one so "a/b/c/../../../" is not converted to "a/b/../"
-    tmp <- sub(paste0(prevdir.regex, s), s, path)
-    if (tmp == path) break
-    path <- tmp
-  }
-  # Handle "/something/..$" to "/" that is, when ".." is the last thing in the path.
-  path <- sub(paste0(prevdir.regex, "$"), s, path)
-
-  # Handle "^/../../.." to "/" that is, going up at the root just returns the root.
-  repeat {
-    # We need to do it one by one so "a/b/c/../../../" is not converted to "a/b/../"
-    tmp <- sub(paste0("^", s, "\\.\\.", s), s, path)
-    if (tmp == path) break
-    path <- tmp
-  }
-  # Handle "^/..$" to "/" that is, when ".." is the last thing in the path.
-  path <- sub(paste0("^", s, "\\.\\.$"), s, path)
-  # Add back Windows drive, if any.
-  path <- paste0(windrive, path)
-
-  # We use normalizePath, which will further simplify the path if
-  # the path exists.
-  irace_normalize_path(path)
+  fs::path_abs(path, start = cwd)
 }

R/random_seed.R

@@ -62,8 +62,8 @@ has_random_seed <- function()
   exists(".Random.seed", globalenv(), mode = "integer", inherits = FALSE)
 }
 
-#' @return [gen_random_seeds()] returns a list of `n` seeds that were generated from the `global_seed`.
-#' The generated seeds can then e.g. be used to seed thread-local RNGs.
+# @return [gen_random_seeds()] returns a list of `n` seeds that were generated from the `global_seed`.
+# The generated seeds can then e.g. be used to seed thread-local RNGs.
 gen_random_seeds <- function(n, global_seed = NULL)
 {
   # Use a random global seed if not set.

tests/testthat/test-path.R

@@ -1,9 +1,29 @@
-test_that("test.path_rel2abs", {
+
+test_path_rel2abs <- function(testcases)
+{
+  for (i in 1:nrow(testcases)) {
+    orig <- testcases[i,1L]
+    cwd <-  testcases[i,2L]
+    res <- path_rel2abs(testcases[i,1L], cwd)
+    if (testcases[i,3L] == "Sys.which") {
+      exp <- normalizePath(Sys.which(testcases[i,1]), winslash = "/", mustWork = NA)
+    } else {
+      exp <- gsub("\\", "/", path.expand(testcases[i,3L]), fixed = TRUE)
+    }
+    if (res == exp) {
+      #cat("[OK] ", i, ": path_rel2abs(\"", orig, "\", \"", cwd, "\") -> ", res, "\n", sep="")
+    } else {
+      cat("[FAILED] ", i, ": path_rel2abs(\"", orig, "\", \"", cwd, "\") -> ", res, " but expected: ", exp, "\n")
+    }
+    expect_match(res, exp, fixed = TRUE)
+  }
+}
+
+test_that("test path_rel2abs", {
   # Try to set wd; otherwise fail silently.
   old.cwd <- getwd()
   skip_if(is.null(old.cwd))
   withr::defer(setwd(old.cwd))
-  # FIXME: Use local_dir() to avoid on.exit
   tryCatch(setwd("/tmp"), error = function(e) { skip(e) })
 
   testcases <- read.table(text='
@@ -31,35 +51,18 @@ test_that("test.path_rel2abs", {
 "/home/leslie/././x.r"      "/tmp"  "/home/leslie/x.r"
 "/home/leslie/~/x.r"        "/tmp"  "/home/leslie/~/x.r"
 "/~/x.r"                    "/tmp"  "/~/x.r"
-"e:/home/leslie/x.r"        "/tmp"  "e:/home/leslie/x.r"
 "leslie/leslie/../../irace" "/tmp"  "/tmp/irace"
 "x.r"                       "/tmp"  "/tmp/x.r"
 "~/irace/../x.r"            "/tmp"  "~/x.r"
 "~/x.r"                     "/tmp"  "~/x.r"
 "../../../data"             "./"    "/data"
 "../../../data"             "/tmp/a/b/c/" "/tmp/data"
 "..//a"                     ".//"   "/a"
-"R"                         "/tmp/" "Sys.which"
 ', stringsAsFactors=FALSE)
-  for(i in 1:nrow(testcases)) {
-    orig <- testcases[i,1]
-    cwd <-  testcases[i,2]
-    res <- irace:::path_rel2abs(testcases[i,1], cwd)
-    if (testcases[i,3] == "Sys.which") {
-      exp <- normalizePath(Sys.which(testcases[i,1]), winslash = "/", mustWork = NA)
-    } else {
-      exp <- gsub("\\", "/", path.expand(testcases[i,3]), fixed = TRUE)
-    }
-    if (res == exp) {
-      # cat("[OK] (", orig, ", ", cwd, ") -> ", res, "\n", sep="")
-    } else {
-      cat("[FAILED] (", orig, ", ", cwd, ") -> ", res, " but expected: ", exp, "\n")
-    }
-    expect_match(res, exp, fixed = TRUE)
-  }
+  test_path_rel2abs(testcases)
 })
 
-test_that("test.path_rel2abs for windows", {
+test_that("test path_rel2abs without /tmp", {
 
   testcases <- read.table(text='
 .                         N:\\\\tmp  N:/tmp
@@ -154,35 +157,37 @@ test_that("test.path_rel2abs for windows", {
 ./x.r                     N:/tmp  N:/tmp/x.r
 .x.R                      N:/tmp  N:/tmp/.x.R
 D:/./x.r                  N:/tmp  D:/x.r
-D:\\\\.\\\\x.r                  N:/tmp  D:/x.r
-D:\\.\\x.r                  N:/tmp  D:/x.r
+D:\\\\.\\\\x.r            N:/tmp  D:/x.r
+D:\\.\\x.r                N:/tmp  D:/x.r
 D:                        N:/tmp  D:/
-D:\\\\                       N:/tmp  D:/
+D:\\\\                    N:/tmp  D:/
 D:/                       N:/tmp  D:/
 D:/leslie/././x.r         N:/tmp  D:/leslie/x.r
-D:/leslie/~/x.r        N:/tmp  D:/leslie/~/x.r
-e:/home/leslie/x.r        /tmp  e:/home/leslie/x.r
+D:/leslie/~/x.r           N:/tmp  D:/leslie/~/x.r
+e:/home/leslie/x.r        /tmp  E:/home/leslie/x.r
 leslie/leslie/../../irace N:/tmp  N:/tmp/irace
 x.r                       N:/tmp  N:/tmp/x.r
 ~/irace/../x.r            N:/tmp  ~/x.r
 ~/x.r                     N:/tmp  ~/x.r
 "R"                       "/tmp/" "Sys.which"
 ', stringsAsFactors=FALSE)
-  for(i in 1:nrow(testcases)) {
-    orig <- testcases[i,1]
-    cwd <-  testcases[i,2]
-    res <- path_rel2abs(testcases[i,1], cwd)
-    if (testcases[i,3] == "Sys.which") {
-      exp <- normalizePath(Sys.which(testcases[i,1]), winslash = "/", mustWork = NA)
-    } else {
-      exp <- gsub("\\", "/", path.expand(testcases[i,3]), fixed = TRUE)
-    }
-    if (res == exp) {
-      #cat("[OK] ", i, ": path_rel2abs(\"", orig, "\", \"", cwd, "\") -> ", res, "\n", sep="")
-    } else {
-      cat("[FAILED] ", i, ": path_rel2abs(\"", orig, "\", \"", cwd, "\") -> ", res, " but expected: ", exp, "\n")
-    }
-    expect_match(res, exp, fixed = TRUE)
-  }
+  test_path_rel2abs(testcases)
 })
 
+test_that("test path_rel2abs with symlink", {
+  require("fs")
+  # Try to set wd; otherwise fail silently.
+  old.cwd <- getwd()
+  skip_if(is.null(old.cwd))
+  withr::defer(setwd(old.cwd))
+  tryCatch({
+    tmp <- withr::local_tempdir()
+    setwd(tmp)
+    dir_create("a")
+    file_create("a/b")
+    link_create(path_abs("a"), "c")
+  }, error = function(e) { skip(e) })
+  testcases <- data.frame(p = "c/b", wd = ".", res = file.path(tmp, "c/b"),
+    stringsAsFactors=FALSE)
+  test_path_rel2abs(testcases)
+})