Preload Windows runtime DLL dependencies (t-kalinowski#115)

* Preload Windows runtime DLL dependencies

* Preserve PATH order for Windows DLL preload

Finding: Preserve PATH order when preloading DLLs

quickr_windows_add_dll_paths() now returns the final post-update PATH directory order instead of synthetic candidate order. Added a regression test that keeps two candidate directories in reversed candidate order on PATH and asserts the returned preload order follows PATH precedence.

* Limit Windows DLL preload to candidate directories

Finding: Avoid preloading unrelated PATH DLLs

quickr_windows_add_dll_paths() now preserves post-update PATH order only among quickr candidate runtime/link directories, instead of returning every directory on PATH. Added a regression test proving unrelated PATH directories with matching DLL basenames are excluded from preload search.

* Restore Windows runtime path discovery

* Limit grandparent Windows bin discovery

Finding: Limit grandparent bin lookup to arch library dirs

Restrict the ../../bin probe to -L directories shaped like .../lib/x64 or .../lib/i386, while keeping the regular ../bin probe for ordinary library paths.

* set `TESTTHAT_CPUS` on CI

Author: t-kalinowski

.github/workflows/R-CMD-check.yaml

@@ -29,6 +29,7 @@ jobs:
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
       R_KEEP_PKG_SOURCE: yes
+      TESTTHAT_CPUS: 5
 
     steps:
       - uses: actions/checkout@v4

R/quick.R

@@ -296,7 +296,8 @@ compile <- function(fsub, build_dir = tempfile(paste0(fsub@name, "-build-"))) {
     stop("Compilation Error", call. = FALSE)
   }
 
-  quickr_windows_add_dll_paths(link_flags)
+  dll_dirs <- quickr_windows_add_dll_paths(link_flags)
+  quickr_windows_load_dll_dependencies(dll_dirs)
 
   # tryCatch(dyn.unload(dll_path), error = identity)
   dll <- tryCatch(
@@ -330,35 +331,48 @@ quickr_windows_add_dll_paths <- function(
   which = Sys.which
 ) {
   if (!identical(os_type, "windows")) {
-    return(invisible(FALSE))
+    return(invisible(character()))
   }
+
+  config_path <- function(value) {
+    value <- trimws(value)
+    if (!nzchar(value)) {
+      return("")
+    }
+    value <- sub("^\"([^\"]+)\".*", "\\1", value)
+    value <- sub("^'([^']+)'.*", "\\1", value)
+    strsplit(value, "\\s+")[[1L]][[1L]]
+  }
+
   dirs <- flags[grepl("^-L", flags)]
   dirs <- sub("^-L", "", dirs)
+  dirs <- vapply(dirs, config_path, character(1))
   dirs <- dirs[nzchar(dirs)]
 
-  bin_siblings <- file.path(dirs, "..", "bin")
+  arch_lib_dirs <- dirs[
+    tolower(basename(dirs)) %in%
+      c("x64", "i386") &
+      tolower(basename(dirname(dirs))) == "lib"
+  ]
+  bin_siblings <- c(
+    file.path(dirs, "..", "bin"),
+    file.path(arch_lib_dirs, "..", "..", "bin")
+  )
 
+  config_binpref <- config_path(config_value("BINPREF"))
+  if (nzchar(config_binpref) && !dir.exists(config_binpref)) {
+    config_binpref <- dirname(config_binpref)
+  }
   config_values <- c(
-    config_value("BINPREF"),
     config_value("FC"),
     config_value("F77"),
     config_value("CC"),
     config_value("CXX")
   )
-  config_paths <- vapply(
-    config_values,
-    function(value) {
-      value <- trimws(value)
-      if (!nzchar(value)) {
-        return("")
-      }
-      value <- sub("^\"([^\"]+)\".*", "\\1", value)
-      value <- sub("^'([^']+)'.*", "\\1", value)
-      strsplit(value, "\\s+")[[1L]][[1L]]
-    },
-    character(1)
-  )
-  config_bins <- unique(dirname(config_paths[nzchar(config_paths)]))
+  config_paths <- vapply(config_values, config_path, character(1))
+  config_bins <- dirname(config_paths[nzchar(config_paths)])
+  config_bins <- config_bins[nzchar(config_bins) & config_bins != "."]
+  config_bins <- unique(c(config_binpref, config_bins))
 
   r_bin <- R.home("bin")
   r_bin_x64 <- file.path(r_bin, "x64")
@@ -373,6 +387,16 @@ quickr_windows_add_dll_paths <- function(
     "RTOOLS_HOME"
   ))
   rtools_roots <- rtools_roots[nzchar(rtools_roots)]
+  link_dirs <- gsub("\\", "/", dirs, fixed = TRUE)
+  rtools_link_roots <- sub(
+    "/(?:x86_64|aarch64)-w64-mingw32(?:\\.static(?:\\.posix)?)?/.*$",
+    "",
+    link_dirs
+  )
+  rtools_link_roots <- rtools_link_roots[
+    nzchar(rtools_link_roots) & rtools_link_roots != link_dirs
+  ]
+  rtools_roots <- unique(c(rtools_roots, rtools_link_roots))
   rtools_bins <- unique(c(
     file.path(rtools_roots, "usr", "bin"),
     file.path(rtools_roots, "mingw64", "bin"),
@@ -399,8 +423,9 @@ quickr_windows_add_dll_paths <- function(
   dirs <- dirs[nzchar(dirs)]
   dirs <- dirs[dir.exists(dirs)]
   if (!length(dirs)) {
-    return(invisible(FALSE))
+    return(invisible(character()))
   }
+  dirs <- normalizePath(dirs, winslash = "\\", mustWork = FALSE)
 
   path <- Sys.getenv("PATH", unset = "")
   existing <- strsplit(path, ";", fixed = TRUE)[[1]]
@@ -410,14 +435,61 @@ quickr_windows_add_dll_paths <- function(
     winslash = "\\",
     mustWork = FALSE
   ))
-  dirs_norm <- tolower(normalizePath(dirs, winslash = "\\", mustWork = FALSE))
+  dirs_norm <- tolower(dirs)
   to_add <- dirs[!dirs_norm %in% existing_norm]
+  path_entries <- existing
   if (length(to_add)) {
-    Sys.setenv(PATH = paste(c(to_add, existing), collapse = ";"))
-    return(invisible(TRUE))
+    path_entries <- c(to_add, existing)
+    Sys.setenv(PATH = paste(path_entries, collapse = ";"))
+  }
+  path_entries <- path_entries[nzchar(path_entries)]
+  path_entries <- path_entries[dir.exists(path_entries)]
+  path_entries <- normalizePath(
+    path_entries,
+    winslash = "\\",
+    mustWork = FALSE
+  )
+  path_entries <- path_entries[tolower(path_entries) %in% dirs_norm]
+
+  invisible(path_entries)
+}
+
+
+quickr_windows_load_dll_dependencies <- function(
+  dirs,
+  os_type = .Platform$OS.type,
+  dyn_load = base::dyn.load
+) {
+  if (!identical(os_type, "windows")) {
+    return(invisible(character()))
+  }
+  stopifnot(is.character(dirs), is.function(dyn_load))
+
+  patterns <- c(
+    "libgcc_s*.dll",
+    "libwinpthread*.dll",
+    "libquadmath*.dll",
+    "libgfortran*.dll",
+    "libopenblas*.dll",
+    "Rblas.dll",
+    "Rlapack.dll"
+  )
+  dlls <- unlist(
+    lapply(patterns, \(pattern) Sys.glob(file.path(dirs, pattern))),
+    use.names = FALSE
+  )
+  dlls <- dlls[file.exists(dlls)]
+  if (!length(dlls)) {
+    return(invisible(character()))
+  }
+
+  dlls <- normalizePath(dlls, winslash = "\\", mustWork = FALSE)
+  dlls <- dlls[!duplicated(tolower(basename(dlls)))]
+  for (dll in dlls) {
+    dyn_load(dll)
   }
 
-  invisible(FALSE)
+  invisible(dlls)
 }