1 2## Copyright (C) 2018 - 2019 RStudio 3## 4## This file is part of Rcpp. 5## 6## Rcpp is free software: you can redistribute it and/or modify it 7## under the terms of the GNU General Public License as published by 8## the Free Software Foundation, either version 2 of the License, or 9## (at your option) any later version. 10## 11## Rcpp is distributed in the hope that it will be useful, but 12## WITHOUT ANY WARRANTY; without even the implied warranty of 13## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14## GNU General Public License for more details. 15## 16## You should have received a copy of the GNU General Public License 17## along with Rcpp. If not, see <http://www.gnu.org/licenses/>. 18 19.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes" && Sys.getenv("RunVerboseRcppTests") == "yes" 20 21if (! .runThisTest) exit_file("Set 'RunVerboseRcppTests' and 'RunAllRcppTests' to 'yes' to run.") 22 23library(Rcpp) 24 25build_package <- function(name, lib_path, tempdir = getwd(), 26 config = character()) { 27 file.copy(system.file("tinytest", name, package = "Rcpp"), 28 getwd(), 29 recursive = TRUE) 30 31 src_path <- file.path(tempdir, name) 32 Rcpp::compileAttributes(src_path) 33 writeLines(config, file.path(src_path, "src", "config.h")) 34 35 install.packages( 36 src_path, 37 lib_path, 38 repos = NULL, 39 type = "source", 40 INSTALL_opts = "--install-tests" 41 ) 42} 43 44# test.interface.unwind <- function() { 45exporter_name <- "testRcppInterfaceExporter" 46user_name <- "testRcppInterfaceUser" 47 48tempdir <- tempfile() 49dir.create(tempdir) 50old_wd <- setwd(tempdir) 51 52lib_path <- file.path(tempdir, "templib") 53dir.create(lib_path) 54 55old_lib_paths <- .libPaths() 56on.exit(.libPaths(old_lib_paths), add = TRUE) 57.libPaths(c(lib_path, old_lib_paths)) 58 59## Without this testInstalledPackage() won't find installed 60## packages even though we've passed `lib.loc` 61old_libs_envvar <- Sys.getenv("R_LIBS") 62on.exit(Sys.setenv(R_LIBS = old_libs_envvar), add = TRUE) 63 64sys_sep <- if (.Platform$OS.type == "windows") ";" else ":" 65Sys.setenv(R_LIBS = paste(c(lib_path, old_lib_paths), collapse = sys_sep)) 66 67cfg <- "#define RCPP_USE_UNWIND_PROTECT" 68build_package(exporter_name, lib_path, config = cfg) 69build_package(user_name, lib_path, config = cfg) 70 71result <- tools::testInstalledPackage(user_name, lib.loc = lib_path, types = "test") 72 73## Be verbose if tests were not successful 74if (result) { 75 log <- file.path(paste0(user_name, "-tests"), "tests.Rout.fail") 76 cat(">> PROTECTED tests.Rout.fail", readLines(log), sep = "\n", file = stderr()) 77} 78 79expect_equal(result, 0L) 80 81 82## Now test client package without protected evaluation 83unlink(user_name, recursive = TRUE) 84unlink(paste0(user_name, "-tests"), recursive = TRUE) 85build_package(user_name, lib_path, config = character()) 86 87result <- tools::testInstalledPackage(user_name, lib.loc = lib_path, types = "test") 88 89if (result) { 90 log <- file.path(paste0(user_name, "-tests"), "tests.Rout.fail") 91 cat(">> UNPROTECTED tests.Rout.fail", readLines(log), sep = "\n", file = stderr()) 92} 93 94expect_equal(result, 0L) 95 96on.exit({ 97 setwd(old_wd) 98 unlink(tempdir, recursive = TRUE) 99}) 100