Skip compiling and generating wrappers when unnecessary (#81)

yutannihilation · web-flow · commit 09c830538e0f · 2021-03-19T20:24:07.000+09:00
* Handle compile=NA * Skip generating wrapper-files when unnecessary - add force arg to force generating them - remove force_wrappers * Remove compile from make_wrappers_externally * Tweak * Fix comment * Improve cli expressions * Reflect the changes by #76 * Stop showing a warning * Tweak comments * Implement find_newer_files_than() * Tweak error message * Use `library_path` to match with the function name * Add test about force = TRUE * Fix function name * Fix test * Sleep less furiously * Fix message * Improve the error in find_newer_files_than()
diff --git a/.github/workflows/test_pkg_gen.yaml b/.github/workflows/test_pkg_gen.yaml
@@ -31,7 +31,7 @@ jobs:
 
     steps:
       - uses: actions/checkout@v2
-      
+
       - name: Set up Rust
         uses: actions-rs/toolchain@v1
         with:
@@ -67,7 +67,7 @@ jobs:
         run: |
           rustup target add x86_64-pc-windows-gnu
           rustup target add i686-pc-windows-gnu
-          echo "C:\msys64\mingw64\bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append 
+          echo "C:\msys64\mingw64\bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append
           echo "C:\msys64\mingw32\bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append
         shell: pwsh
 
@@ -93,6 +93,7 @@ jobs:
         env:
           _R_CHECK_CRAN_INCOMING_REMOTE_: false
         run: |
+          # preperation
           remotes::install_local(force = TRUE)
           temp_dir <- tempdir()
           pkg_dir <- file.path(temp_dir, "testpkg")
@@ -116,11 +117,35 @@ jobs:
             ),
             file.path("tests", "testthat", "test-hello.R")
           )
+
+          # check if rextendr::document() compiles and generates wrappers properly
           rextendr::document()
           rcmdcheck::rcmdcheck(
-              path = ".", 
+              path = ".",
               args = c("--no-manual", "--as-cran"),
               error_on = "warning",
               check_dir = "check_use_extendr"
           )
+
+          library_path <- rextendr:::get_library_path()
+          library_mtime_before <- file.info(library_path)$mtime
+          wrappers_path <- file.path("R", "extendr-wrappers.R")
+          wrappers_mtime_before <- file.info(wrappers_path)$mtime
+
+          # check if rextendr::document() don't re-generate wrappers when unnecessary
+          rextendr::document()
+          stopifnot(library_mtime_before == file.info(library_path)$mtime)
+          stopifnot(wrappers_mtime_before == file.info(wrappers_path)$mtime)
+
+          # check if force = TRUE forces re-generating wrappers, but not compile
+          rextendr::register_extendr(force = TRUE)
+          stopifnot(library_mtime_before == file.info(library_path)$mtime)
+          stopifnot(wrappers_mtime_before < file.info(wrappers_path)$mtime)
+
+          wrappers_mtime_before <- file.info(wrappers_path)$mtime
+
+          # check if compile = TRUE forces compile, and accordingly the wrapper generation
+          rextendr::register_extendr(compile = TRUE)
+          stopifnot(library_mtime_before < file.info(library_path)$mtime)
+          stopifnot(wrappers_mtime_before < file.info(wrappers_path)$mtime)
         shell: Rscript {0}
diff --git a/R/register_extendr.R b/R/register_extendr.R
@@ -10,16 +10,21 @@
 #' `R/extendr-wrappers.R`. Afterwards, you will have to re-document and then
 #' re-install the package for the wrapper functions to take effect.
 #'
-#' @inheritParams pkgload::load_all
 #' @param path Path from which package root is looked up.
 #' @param quiet Logical indicating whether any progress messages should be
 #'   generated or not.
-#' @param force_wrappers Logical indicating whether to install a minimal wrapper
-#'   file in the cases when generating wrappers by Rust code failed. This might
-#'   be needed when the wrapper file is accidentally lost or corrupted.
+#' @param force Logical indicating whether to force re-generating
+#'   `R/extendr-wrappers.R` even when it doesn't seem to need updated. (By
+#'   default, generation is skipped when it's newer than the DLL).
+#' @param compile Logical indicating whether to recompile DLLs:
+#'   \describe{
+#'     \item{`TRUE`}{always recompiles}
+#'     \item{`NA`}{recompiles if needed (i.e., any source files or manifest file are newer than the DLL)}
+#'     \item{`FALSE`}{never recompiles}
+#'   }
 #' @return (Invisibly) Path to the file containing generated wrappers.
 #' @export
-register_extendr <- function(path = ".", quiet = FALSE, force_wrappers = FALSE, compile = NA) {
+register_extendr <- function(path = ".", quiet = FALSE, force = FALSE, compile = NA) {
   x <- desc::desc(rprojroot::find_package_root_file("DESCRIPTION", path = path))
   pkg_name <- x$get("Package")
 
@@ -40,29 +45,51 @@ register_extendr <- function(path = ".", quiet = FALSE, force_wrappers = FALSE,
 
   outfile <- rprojroot::find_package_root_file("R", "extendr-wrappers.R", path = path)
 
-  # If force_wrappers is TRUE, use a minimal wrapper file even when
-  # make_wrappers() fails; since the wrapper generation depends on the compiled
-  # Rust code, the package needs to be installed before attempting this, but
-  # it's not always the case (e.g. the package might be corrupted, or not
-  # installed yet).
-  if (isTRUE(force_wrappers)) {
-    error_handle <- function(e) {
-      cli::cli_alert_danger("Failed to generate wrapper functions: {e$message}.")
-      cli::cli_alert_warning("Falling back to a minimal wrapper file instead.")
-
-      make_example_wrappers(pkg_name, outfile, path = path)
-    }
-  } else {
-    error_handle <- function(e) {
+  path <- rprojroot::find_package_root_file(path = path)
+
+  # If compile is NA, compile if the DLL is newer than the source files
+  if (isTRUE(is.na(compile))) {
+    compile <- needs_compilation(path, quiet) || pkgbuild::needs_compile(path)
+  }
+
+  if (isTRUE(compile)) {
+    # This relies on [`pkgbuild::needs_compile()`], which
+    # does not know about Rust files modifications.
+    # `force = TRUE` enforces compilation.
+    pkgbuild::compile_dll(
+      path = path,
+      force = TRUE,
+      quiet = quiet
+    )
+  }
+
+  library_path <- get_library_path(path)
+
+  if (!file.exists(library_path)) {
+    msg <- "{library_path} doesn't exist"
+    if (isTRUE(compile)) {
+      # If it doesn't exist even after compile, we have no idea what happened
+      ui_throw(msg)
+    } else {
+      # If compile wasn't invoked, it might succeed with explicit "compile = TRUE"
       ui_throw(
-        "Failed to generate wrapper functions.",
-        c(
-          ui_x(e[["message"]])
-        )
+        msg,
+        ui_i("You need to compile first, try `register_rextendr(compile = TRUE)`")
       )
     }
   }
 
+  # If the wrapper file is newer than the DLL file, assume it's been generated
+  # by the latest DLL, which should mean it doesn't need to be re-generated.
+  # This isn't always the case (e.g. when the user accidentally edited the
+  # wrapper file by hand) so the user might need to run with `force = TRUE`.
+  if (!isTRUE(force) && length(find_newer_files_than(outfile, library_path)) > 0) {
+    rel_path <- pretty_rel_path(outfile, path)
+    cli::cli_alert_info("{.file {rel_path}} is up-to-date. Skip generating wrapper functions.")
+
+    return(invisible(character(0L)))
+  }
+
   tryCatch(
     # Call the wrapper generation in a separate R process to avoid the problem
     # of loading and unloading the same name of a DLL (c.f. #64).
@@ -72,10 +99,14 @@ register_extendr <- function(path = ".", quiet = FALSE, force_wrappers = FALSE,
       outfile = outfile,
       path = path,
       use_symbols = TRUE,
-      quiet = quiet,
-      compile = compile
+      quiet = quiet
     ),
-    error = error_handle
+    error = function(e) {
+      ui_throw(
+        "Failed to generate wrapper functions.",
+        ui_x(e[["message"]])
+      )
+    }
   )
 
   # Ensures path is absolute
@@ -121,28 +152,15 @@ make_wrappers <- function(module_name, package_name, outfile,
 #'
 #' Does the same as [`make_wrappers`], but out of process.
 #' @inheritParams make_wrappers
-#' @param compile Logical indicating whether the library should be recompiled.
 #' @noRd
 make_wrappers_externally <- function(module_name, package_name, outfile,
-                                     path, use_symbols = FALSE, quiet = FALSE,
-                                     compile = NA) {
-  func <- function(path, make_wrappers, compile, quiet,
+                                     path, use_symbols = FALSE, quiet = FALSE) {
+  func <- function(path, make_wrappers, quiet,
                    module_name, package_name, outfile,
                    use_symbols, ...) {
-    if (isTRUE(compile)) {
-      # This relies on [`pkgbuild::needs_compile()`], which
-      # does not know about Rust files modifications.
-      # `force = TRUE` enforces compilation.
-      pkgbuild::compile_dll(
-        path = path,
-        force = TRUE,
-        quiet = quiet
-      )
-    }
-
-    dll_path <- file.path(path, "src", paste0(package_name, .Platform$dynlib.ext))
+    library_path <- file.path(path, "src", paste0(package_name, .Platform$dynlib.ext))
     # Loads native library
-    lib <- dyn.load(dll_path)
+    lib <- dyn.load(library_path)
     # Registers library unloading to be invoked at the end of this function
     on.exit(dyn.unload(lib[["path"]]), add = TRUE)
 
@@ -159,7 +177,6 @@ make_wrappers_externally <- function(module_name, package_name, outfile,
   args <- list(
     path = rprojroot::find_package_root_file(path = path),
     make_wrappers = make_wrappers,
-    compile = compile,
     # arguments passed to make_wrappers()
     module_name = module_name,
     package_name = package_name,
diff --git a/R/rextendr_document.R b/R/rextendr_document.R
@@ -10,8 +10,7 @@
 #' @export
 document <- function(pkg = ".", quiet = FALSE, roclets = NULL) {
   try_save_all(quiet = quiet)
-  needs_compilation <- needs_compilation(pkg, quiet) || pkgbuild::needs_compile(pkg)
 
-  register_extendr(path = pkg, quiet = quiet, compile = needs_compilation)
+  register_extendr(path = pkg, quiet = quiet)
   devtools::document(pkg = pkg, roclets = roclets, quiet = FALSE)
 }
diff --git a/R/track_rust_source.R b/R/track_rust_source.R
@@ -147,27 +147,11 @@ needs_compilation <- function(path = ".", quiet = FALSE) {
     return(TRUE)
   }
 
-  rust_files <- get_rust_files(path)
-
-  # Shortcut: no rust sources found, nothing to track.
-  if (length(rust_files) == 0L) {
-    return(FALSE)
-  }
-
-  # Obtains detailed info of each source file and library file.
-  # This includes 'last modification time'.
-  # Stored as tibbles
-  rust_info <- get_file_info(rust_files)
-  library_info <- get_file_info(library_path)
-
   # Leaves files that were modified *after* the library
-  modified_files_info <- dplyr::filter(
-    rust_info,
-    .data$mtime > library_info[["mtime"]][1]
-  )
+  modified_files_paths <- find_newer_files_than(get_rust_files(path), library_path)
 
   # Shortcut: no files have been modified since last compilation.
-  if (nrow(modified_files_info) == 0L) {
+  if (length(modified_files_paths) == 0L) {
     return(FALSE)
   }
 
@@ -177,7 +161,7 @@ needs_compilation <- function(path = ".", quiet = FALSE) {
   # do not support `quiet` arg.
   if (!isTRUE(quiet)) {
     purrr::walk(
-      pretty_rel_path(modified_files_info[["path"]], search_from = path),
+      pretty_rel_path(modified_files_paths, search_from = path),
       ~ cli::cli_alert_info("File {.file {.x}} has been modified since last compilation.")
     )
   }
@@ -200,3 +184,43 @@ get_file_info <- function(path) {
   info <- dplyr::mutate(info, path = rownames(info), .before = dplyr::everything())
   tibble::as_tibble(info)
 }
+
+# Find files newer than the reference file.
+#
+# @param files File paths to find newer ones than `reference`.
+# @param reference A file path to compare `files` against.
+# @return File paths newer than `reference`.
+find_newer_files_than <- function(files, reference) {
+  # If `files` is of length 0 or NULL, exit early.
+  if (length(files) == 0L) {
+    return(character(0))
+  }
+
+  error_details <- character(0)
+
+  if (length(reference) != 1L) {
+    error_details <- ui_x("Expected vector of length `1`, got `{length(reference)}`.")
+  }
+
+  if (typeof(reference) != "character") {
+    error_details <- c(error_details, ui_x("Expected type `character`, got `{typeof(reference)}`."))
+  }
+
+  # if `reference` is already found invalid, skip checking the existence
+  if (length(error_details) == 0L && !file.exists(reference)) {
+    error_details <- ui_x("File {reference} doesn't exist.")
+  }
+
+  if (length(error_details) > 0L) {
+    ui_throw("Invalid argument `reference`.", details = error_details)
+  }
+
+  reference_mtime <- get_file_info(reference)[["mtime"]]
+
+  modified_files_info <- dplyr::filter(
+    get_file_info(files),
+    .data$mtime > reference_mtime
+  )
+
+  modified_files_info[["path"]]
+}
diff --git a/man/register_extendr.Rd b/man/register_extendr.Rd
diff --git a/tests/testthat/test-helper-functions.R b/tests/testthat/test-helper-functions.R
@@ -144,3 +144,26 @@ test_that("`get_file_info()` and `file.info()` outputs are equivalent", {
   expect_true(is.na(na_info[["ctime"]]))
   expect_true(is.na(na_info[["atime"]]))
 })
+
+test_that("find_newer_files_than() works", {
+  old_file <- tempfile()
+  new_file1 <- tempfile()
+  new_file2 <- tempfile()
+  brio::write_file("", old_file)
+  Sys.sleep(0.01)
+  brio::write_file("", new_file1)
+  brio::write_file("", new_file2)
+
+  # files are older than reference
+  expect_equal(find_newer_files_than(old_file, new_file1), character(0))
+  # files are newer than reference
+  expect_equal(find_newer_files_than(new_file1, old_file), new_file1)
+  # multiple files
+  expect_equal(find_newer_files_than(c(new_file1, new_file2), old_file), c(new_file1, new_file2))
+  # no files
+  expect_equal(find_newer_files_than(character(0), old_file), character(0))
+  expect_equal(find_newer_files_than(NA_character_, old_file), character(0))
+  # invalid cases
+  expect_error(find_newer_files_than(old_file, character(0)))
+  expect_error(find_newer_files_than(old_file, "/no/such/files"))
+})

Original file line number	Diff line number	Diff line change
`@@ -10,8 +10,7 @@`
`10`	`10`	`#' @export`
`11`	`11`	`document <- function(pkg = ".", quiet = FALSE, roclets = NULL) {`
`12`	`12`	`try_save_all(quiet = quiet)`
`13`		`- needs_compilation <- needs_compilation(pkg, quiet) \|\| pkgbuild::needs_compile(pkg)`
`14`	`13`
`15`		`- register_extendr(path = pkg, quiet = quiet, compile = needs_compilation)`
	`14`	`+ register_extendr(path = pkg, quiet = quiet)`
`16`	`15`	`devtools::document(pkg = pkg, roclets = roclets, quiet = FALSE)`
`17`	`16`	`}`