1 2## Copyright (C) 2021 Iñaki Ucar 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 25mkv <- "PKG_CPPFLAGS = -DRCPP_USE_GLOBAL_ROSTREAM" 26cfg <- " 27#ifndef RCPP_USE_GLOBAL_ROSTREAM 28#define RCPP_USE_GLOBAL_ROSTREAM 29#endif 30#include <Rcpp.h> 31using namespace Rcpp;" 32ptr <- " 33// [[Rcpp::export]] 34CharacterVector ptr%s() { 35 CharacterVector out(2); 36 std::ostringstream Rcout_address, Rcerr_address; 37 Rcout_address << (void const *)(&Rcout); 38 Rcerr_address << (void const *)(&Rcerr); 39 out[0] = Rcout_address.str(); 40 out[1] = Rcerr_address.str(); 41 return out; 42}" 43alig <- " 44// [[Rcpp::export]] 45void toLeft() { 46 Rcout << std::left; 47 Rcerr << std::left; 48} 49// [[Rcpp::export]] 50void toRight() { 51 Rcout << std::right; 52 Rcerr << std::right; 53}" 54print <- ' 55// [[Rcpp::export]] 56void something() { 57 Rcout << std::setw(20) << "somethingRcout" << std::endl; 58 Rcerr << std::setw(20) << "somethingRcerr" << std::endl; 59}' 60 61# create package and write functions into separate translation units 62pkg_name <- "fooRostream" 63path <- tempdir() 64pkg_path <- file.path(path, pkg_name) 65src_path <- file.path(pkg_path, "src") 66 67if (dir.exists(pkg_path)) unlink(pkg_path) 68Rcpp.package.skeleton( 69 pkg_name, path=path, environment=environment(), example_code=FALSE) 70writeLines(c(cfg, sprintf(ptr, "A")), file.path(src_path, "ptrA.cpp")) 71writeLines(c(cfg, sprintf(ptr, "B")), file.path(src_path, "ptrB.cpp")) 72writeLines(c(cfg, alig), file.path(src_path, "alig.cpp")) 73writeLines(c(cfg, print), file.path(src_path, "print.cpp")) 74writeLines(mkv, file.path(src_path, "Makevars")) 75compileAttributes(pkg_path) 76 77# tests 78testRostream <- function() { 79 captureFun <- function(...) { 80 err <- capture.output( 81 out <- capture.output(..., type="output"), type="message") 82 c(out, err) 83 } 84 res <- all(ptrA() == ptrB()) 85 res <- c(res, all(grepl("^ ", captureFun(something())))) 86 toLeft() # change alignment globally 87 res <- c(res, all(grepl("^s", captureFun(something())))) 88 toRight() # restore 89 res 90} 91 92# test package 93lib_path <- file.path(path, "templib") 94dir.create(lib_path) 95install.packages(pkg_path, lib_path, repos=NULL, type="source") 96expect_true(require("fooRostream", lib.loc=lib_path, character.only=TRUE)) 97expect_true(all(testRostream())) 98 99# test sourceCpp 100sourceCpp(file.path(src_path, "ptrA.cpp")) 101sourceCpp(file.path(src_path, "ptrB.cpp")) 102sourceCpp(file.path(src_path, "alig.cpp")) 103sourceCpp(file.path(src_path, "print.cpp")) 104expect_true(all(testRostream())) 105 106# cleanup 107on.exit(unlink(pkg_path, recursive=TRUE), add=TRUE) 108on.exit(unlink(lib_path, recursive=TRUE), add=TRUE) 109