violation of writing to package directory during tests

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: psqn
 Type: Package
 Title: Partially Separable Quasi-Newton
-Version: 0.2.0
+Version: 0.2.1
 Authors@R: c(person("Benjamin", "Christoffersen", 
                     email = "[email protected]", 
                     role = c("cre", "aut"), 

NEWS

@@ -1,3 +1,8 @@
+Changes in version 0.2.1
+ * tests that compile files using Rcpp::sourceCpp() now do so in a temporary
+   directory in tempdir(). It was done before in the package directory which
+   violates CRAN policies.
+
 Changes in version 0.2.0
  * added a generic method for partially separable functions.
  * made it possible to run a setup function prior to evaluating all the element

cran-comments.md

@@ -19,3 +19,7 @@
 There were no WARNINGs or ERRORs.
 
 There is a NOTE about the package size in some cases.
+
+I am sorry for writing to the package's directory in the previous version. The 
+new version writes to a directory in tempdir() and deletes this directory after 
+the tests.

tests/testthat/helper.R

@@ -1,2 +1,38 @@
+# skips test on macOS
 skip_on_macOS <- function()
   skip_if(Sys.info()["sysname"] == "Darwin")
+
+# the temporary directory we will use. This must be deleted!
+.temp_dir_to_use <- file.path(tempdir(), "tmp-psqn-cpp-dir")
+if(!dir.exists(.temp_dir_to_use))
+  dir.create(.temp_dir_to_use)
+
+# compiles a C++ file from the inst directory and returns the needed information
+# to delete all associated files and reset the working directory
+compile_cpp_file <- function(f, new_name = f, do_compile = TRUE){
+  old_wd <- getwd()
+  # create the directory we will use
+  success <- FALSE
+  new_wd <- .temp_dir_to_use
+  on.exit({
+    if(!success)
+      setwd(old_wd)
+  }, add = TRUE)
+  # copy the file
+  file.copy(system.file(f, package = "psqn"),
+            file.path(new_wd, new_name))
+  # we have to copy all the headers
+  file.copy(
+    list.files(system.file("include", package = "psqn"), full.names = TRUE),
+    new_wd)
+  # set the working directory to the directory with all the files
+  eval(bquote(setwd(.(new_wd))))
+  if(do_compile)
+    Rcpp::sourceCpp(new_name)
+  success <- TRUE
+  list(old_wd = old_wd, new_wd = new_wd)
+}
+
+# resets everything following a call to compile_cpp_file
+reset_compile_cpp_file <- function(reset_info)
+  setwd(reset_info$old_wd)

tests/testthat/test-cpp-api.R

@@ -32,7 +32,9 @@ test_that("mixed logit model gives the same", {
   skip_if_not_installed("RcppArmadillo")
   skip_on_macOS()
 
-  Rcpp::sourceCpp(system.file("mlogit-ex.cpp", package = "psqn"))
+  reset_info <- compile_cpp_file("mlogit-ex.cpp")
+  on.exit(reset_compile_cpp_file(reset_info), add = TRUE)
+  setwd(reset_info$old_wd)
   optimizer <- get_mlogit_optimizer(sim_dat, max_threads = 2L)
 
   val <- c(beta, sapply(sim_dat, function(x) x$u))

tests/testthat/test-poly-ex.R

@@ -33,26 +33,22 @@ test_that("Poly example gives the same", {
 
   # we also want to check that we get the right error when we do not define
   # PSQN_USE_EIGEN so we alter the file a bit
-  tmp_file <- file.path(system.file(package = "psqn"),
-                        "temp-file-to-be-compiled.cpp")
   (function(){
-    on.exit({
-      # clean up
-      fs <- list.files(system.file(package = "psqn"), full.names = TRUE)
-      to_delete <- grepl("temp-file-to-be-compiled.*", fs)
-      sapply(fs[to_delete], unlink)
-    })
+    reset_info <- compile_cpp_file("poly-ex.cpp", do_compile = FALSE)
+    on.exit(reset_compile_cpp_file(reset_info), add = TRUE)
 
-    tmp_file_con <- file(tmp_file)
+    old_lines <- readLines("poly-ex.cpp")
+    tmp_file_con <- file("poly-ex.cpp")
     writeLines(
-      c(readLines(system.file("poly-ex.cpp", package = "psqn")),
+      c(old_lines,
         "// [[Rcpp::export]]",
         "void dum_get_hess_sparse_call(SEXP ptr) {",
         "  XPtr<poly_optim>(ptr)->get_hess_sparse();",
         "}"),
       tmp_file_con)
     close(tmp_file_con)
-    sourceCpp(tmp_file)
+    sourceCpp("poly-ex.cpp")
+    setwd(reset_info$old_wd)
 
     optimizer <- get_poly_optimizer(
       cluster_dat, max_threads = 2L, mu_global = mu_global)

tests/testthat/test-psqn-generic.R

@@ -53,7 +53,10 @@ test_that("the R and C++ interface gives the same and correct result", {
   skip_on_cran()
   library(Rcpp)
   library(Matrix)
-  sourceCpp(system.file("generic_example.cpp", package = "psqn"))
+  reset_info <- compile_cpp_file("generic_example.cpp")
+  on.exit(reset_compile_cpp_file(reset_info), add = TRUE)
+  setwd(reset_info$old_wd)
+
   cpp_arg <- lapply(dat, function(x){
     x$indices <- x$indices - 1L # C++ needs zero-based indices
     x
@@ -97,23 +100,20 @@ test_that("the R and C++ interface gives the same and correct result", {
   }
 
   # test that we get the same when we do not use Kahan summation algorithm
-  tmp_file <- file.path(system.file(package = "psqn"),
-                        "temp-file-to-be-compiled.cpp")
   (function(){
-    on.exit({
-      # clean up
-      fs <- list.files(system.file(package = "psqn"), full.names = TRUE)
-      to_delete <- grepl("temp-file-to-be-compiled.*", fs)
-      sapply(fs[to_delete], unlink)
-    })
+    reset_info <- compile_cpp_file("generic_example.cpp",
+                                   "generic_example-Kahan.cpp",
+                                   do_compile = FALSE)
+    on.exit(reset_compile_cpp_file(reset_info), add = TRUE)
 
-    tmp_file_con <- file(tmp_file)
+    old_lines <- readLines("generic_example-Kahan.cpp")
+    tmp_file_con <- file("generic_example-Kahan.cpp")
     writeLines(
-      c("#define PSQN_NO_USE_KAHAN",
-        readLines(system.file("generic_example.cpp", package = "psqn"))),
+      c("#define PSQN_NO_USE_KAHAN", old_lines),
       tmp_file_con)
     close(tmp_file_con)
-    sourceCpp(tmp_file)
+    sourceCpp("generic_example-Kahan.cpp")
+    setwd(reset_info$old_wd)
 
     Cpp_res <- optim_generic_ex(
       val = numeric(K), ptr = ptr, rel_eps = 1e-9, max_it = 1000L,

tests/testthat/z-undo-helper.R

@@ -0,0 +1,3 @@
+# remove the temporary directory
+gc()
+unlink(.temp_dir_to_use, recursive = TRUE)