Add test for client packages compiled without protected evaluation

Author: lionel-

ChangeLog

@@ -1,4 +1,12 @@
 
+2018-06-02  Lionel Henry  <lionel@rstudio.com>
+
+        * inst/unitTests/runit.interface.R: New test for the case where
+        the client package was compiled without protected evaluation
+        enabled. On R 3.5, longjump exceptions thrown from imported
+        functions are still caught and dealt with properly by the client
+        package.
+
 2018-06-01  Lionel Henry  <lionel@rstudio.com>
 
         * inst/unitTests/runit.interface.R: New tests for interfaces and unwind.

inst/unitTests/runit.interface.R

@@ -21,6 +21,25 @@
 
 if (.runThisTest) {
 
+    build_package <- function(name, lib_path, tempdir = getwd(),
+                              config = character()) {
+        file.copy(system.file("unitTests", name, package = "Rcpp"),
+                  getwd(),
+                  recursive = TRUE)
+
+        src_path <- file.path(tempdir, name)
+        Rcpp::compileAttributes(src_path)
+        writeLines(config, file.path(src_path, "src", "config.h"))
+
+        install.packages(
+            src_path,
+            lib_path,
+            repos = NULL,
+            type = "source",
+            INSTALL_opts = "--install-tests"
+        )
+    }
+
     test.interface.unwind <- function() {
         exporter_name <- "testRcppInterfaceExporter"
         user_name <- "testRcppInterfaceUser"
@@ -33,37 +52,12 @@ if (.runThisTest) {
             unlink(tempdir, recursive = TRUE)
         })
 
-        file.copy(system.file("unitTests", exporter_name, package = "Rcpp"),
-                  tempdir,
-                  recursive = TRUE)
-        file.copy(system.file("unitTests", user_name, package = "Rcpp"),
-                  tempdir,
-                  recursive = TRUE)
-
-        exporter_path <- file.path(tempdir, exporter_name)
-        user_path <- file.path(tempdir, user_name)
-
-        Rcpp::compileAttributes(exporter_path)
-        Rcpp::compileAttributes(user_path)
-
         lib_path <- file.path(tempdir, "templib")
         dir.create(lib_path)
 
-        install <- function(path, lib_path) {
-            install.packages(
-                path,
-                lib_path,
-                repos = NULL,
-                type = "source",
-                INSTALL_opts = "--install-tests"
-            )
-        }
-        install(exporter_path, lib_path)
-        install(user_path, lib_path)
-
         old_lib_paths <- .libPaths()
-        on.exit(.libPaths(old_lib_paths))
-        .libPaths(lib_path)
+        on.exit(.libPaths(old_lib_paths), add = TRUE)
+        .libPaths(c(lib_path, old_lib_paths))
 
         # Without this testInstalledPackage() won't find installed
         # packages even though we've passed `lib.loc`
@@ -73,12 +67,31 @@ if (.runThisTest) {
         sys_sep <- if (.Platform$OS.type == "windows") ";" else ":"
         Sys.setenv(R_LIBS = paste(c(lib_path, old_lib_paths), collapse = sys_sep))
 
+        cfg <- "#define RCPP_PROTECTED_EVAL"
+        build_package(exporter_name, lib_path, config = cfg)
+        build_package(user_name, lib_path, config = cfg)
+
         result <- tools::testInstalledPackage(user_name, lib.loc = lib_path, types = "test")
 
         # Be verbose if tests were not successful
         if (result) {
             log <- file.path(paste0(user_name, "-tests"), "tests.Rout.fail")
-            cat(">> tests.Rout.fail", readLines(log), sep = "\n", file = stderr())
+            cat(">> PROTECTED tests.Rout.fail", readLines(log), sep = "\n", file = stderr())
+        }
+
+        checkEquals(result, 0L)
+
+
+        # Now test client package without protected evaluation
+        unlink(user_name, recursive = TRUE)
+        unlink(paste0(user_name, "-tests"), recursive = TRUE)
+        build_package(user_name, lib_path, config = character())
+
+        result <- tools::testInstalledPackage(user_name, lib.loc = lib_path, types = "test")
+
+        if (result) {
+            log <- file.path(paste0(user_name, "-tests"), "tests.Rout.fail")
+            cat(">> UNPROTECTED tests.Rout.fail", readLines(log), sep = "\n", file = stderr())
         }
 
         checkEquals(result, 0L)

inst/unitTests/testRcppInterfaceExporter/src/config.h

@@ -1,4 +1,4 @@
-#define RCPP_PROTECTED_EVAL
+#include "config.h"
 
 #include <Rcpp.h>
 #include "unwound.h"

inst/unitTests/testRcppInterfaceExporter/src/exporter.cpp

@@ -1,4 +1,4 @@
-#define RCPP_PROTECTED_EVAL
+#include "config.h"
 
 #include <Rcpp.h>
 #include <testRcppInterfaceExporter.h>

inst/unitTests/testRcppInterfaceUser/src/config.h

@@ -1,4 +1,5 @@
 
+# This tests errors converted to exceptions by Rcpp_eval()
 x <- tryCatch(
   error = identity,
   testRcppInterfaceUser::use_cpp_interface(quote(stop("jump!")))
@@ -17,6 +18,7 @@ if (getRversion() >= "3.5.0") {
 testRcppInterfaceUser::reset_flags()
 testRcppInterfaceExporter::reset_flags()
 
+# This tests longjumps not caught by Rcpp_eval()
 x <- withRestarts(
   here = identity,
   testRcppInterfaceUser::use_cpp_interface(quote(invokeRestart("here", "value")))