New upstream version 0.2
Andreas Tille
6 years ago
0 | Package: bindrcpp | |
1 | Title: An 'Rcpp' Interface to Active Bindings | |
2 | Description: Provides an easy way to fill an environment with active bindings | |
3 | that call a C++ function. | |
4 | Authors@R: c( | |
5 | person("Kirill", "Müller", role = c("aut", "cre"), email = "krlmlr+r@mailbox.org"), | |
6 | person("RStudio", role = "cph") | |
7 | ) | |
8 | Version: 0.2 | |
9 | Date: 2017-06-15 | |
10 | URL: https://github.com/krlmlr/bindrcpp, | |
11 | https://krlmlr.github.io/bindrcpp | |
12 | BugReports: https://github.com/krlmlr/bindrcpp/issues | |
13 | Imports: Rcpp, bindr | |
14 | Suggests: testthat | |
15 | LinkingTo: Rcpp, plogr | |
16 | RoxygenNote: 6.0.1 | |
17 | LazyData: true | |
18 | License: MIT + file LICENSE | |
19 | Encoding: UTF-8 | |
20 | NeedsCompilation: yes | |
21 | Packaged: 2017-06-15 20:53:22 UTC; muelleki | |
22 | Author: Kirill Müller [aut, cre], | |
23 | RStudio [cph] | |
24 | Maintainer: Kirill Müller <krlmlr+r@mailbox.org> | |
25 | Repository: CRAN | |
26 | Date/Publication: 2017-06-17 23:52:40 UTC |
0 | 52470b405afa4c0d5172a439604ad6bd *DESCRIPTION | |
1 | d3d2f503f5c96ac395a270e7c295ec0b *LICENSE | |
2 | 3a9c92677932609677f9a6370d097c29 *NAMESPACE | |
3 | 876a0477e3f61e936ef0fdb7211fdaaf *NEWS.md | |
4 | 7ddf9467cba4519d4692e5f6f1795806 *R/RcppExports.R | |
5 | 1ce0e6f00f32e2d0765fb57749317ec9 *R/bindr.R | |
6 | b04097e5dbb70ea2d7bf5b0fee8acb46 *R/bindrcpp-package.R | |
7 | 2cdf48ce2f31adb3aea16cd398507126 *R/test.R | |
8 | 35837e0fbb8b9a53760fd747e6bdac89 *README.md | |
9 | ebff110d87c1681eda6f30b93fa7ffde *inst/include/bindrcpp.h | |
10 | fc7eea695d0dd9253a05637f8d7601da *inst/include/bindrcpp_RcppExports.h | |
11 | 51590efce84ef7ff9bf547c265cd66bf *inst/include/bindrcpp_types.h | |
12 | aaf228a83c0e8d48ab132a5523ab5ccf *man/bindrcpp-package.Rd | |
13 | fed1d0a4957c37ae234ceb655095f717 *man/init_logging.Rd | |
14 | bfebf612b38c0d8e41f4f3449c290aa7 *man/reexports.Rd | |
15 | 3a3c839566f06a1eb4cb3c960b7cab62 *src/Makevars | |
16 | 3a3c839566f06a1eb4cb3c960b7cab62 *src/Makevars.win | |
17 | 9436f19309a6dcd8adc4fd9cb33930fd *src/RcppExports.cpp | |
18 | 5917fdf0957beca52727bb02dad6a90f *src/create.cpp | |
19 | 6492f645509837fe7c735958d71079d3 *src/plogr.cpp | |
20 | 4c5fafc9e32aea31f70fd316f4f0af9e *src/test.cpp | |
21 | 9d12bc91cc42c506ca4ac9a2184614b8 *tests/testthat.R | |
22 | 56632f0010990dc5ab5d734dfe763b95 *tests/testthat/test-create.R |
0 | # Generated by roxygen2: do not edit by hand | |
1 | ||
2 | export(create_env) | |
3 | export(populate_env) | |
4 | importFrom(Rcpp,sourceCpp) | |
5 | importFrom(bindr,create_env) | |
6 | importFrom(bindr,populate_env) | |
7 | useDynLib(bindrcpp) |
0 | # bindrcpp 0.2 (2017-06-15) | |
1 | ||
2 | - Fixed very rare segmentation fault due to missing protection of function arguments in autogenerated boilerplate code. | |
3 | - Fix compilation errors on FreeBSD due to use of nonstandard Make features (#5). | |
4 | - Native symbol registration added by Rcpp. | |
5 | ||
6 | ||
7 | # bindrcpp 0.1 (2016-12-08) | |
8 | ||
9 | Initial CRAN release. | |
10 | ||
11 | ## Exported C++ functions | |
12 | ||
13 | - `create_env_string()` creates an environment with active bindings, with names given as a character vector. Access of these bindings triggers a call to a C++ function with a fixed signature (`GETTER_FUNC_STRING`); this call contains the name of the binding (as character) and an arbitrary payload (`PAYLOAD`, essentially a wrapped `void*`). | |
14 | - `create_env_symbol()` is similar, the callback function accepts the name of the binding as symbol instead of | |
15 | character (`GETTER_FUNC_SYMBOL`). | |
16 | - `populate_env_string()` and `populate_env_symbol()` populate an existing environment instead of creating a new one. | |
17 | - Use `LinkingTo: bindrcpp` and `#include <bindrcpp.h>` to access these functions from your package. | |
18 | ||
19 | ## Exported R functions | |
20 | ||
21 | - Reexported from `bindr`: `create_env()` and `populate_env()`. |
0 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand | |
1 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 | |
2 | ||
3 | #' Enable internal logging | |
4 | #' | |
5 | #' Log entries, depending on the log level, will be printed to the standard | |
6 | #' error stream. | |
7 | #' | |
8 | #' @param log_level A character value, one of "WARN", "INFO", "DEBUG", "VERB", | |
9 | #' or "NONE". | |
10 | #' | |
11 | #' @keywords internal | |
12 | init_logging <- function(log_level) { | |
13 | invisible(.Call('bindrcpp_init_logging', PACKAGE = 'bindrcpp', log_level)) | |
14 | } | |
15 | ||
16 | callback_string <- function(name, fun, payload) { | |
17 | .Call('bindrcpp_callback_string', PACKAGE = 'bindrcpp', name, fun, payload) | |
18 | } | |
19 | ||
20 | callback_symbol <- function(name, fun, payload) { | |
21 | .Call('bindrcpp_callback_symbol', PACKAGE = 'bindrcpp', name, fun, payload) | |
22 | } | |
23 | ||
24 | do_test_create_environment <- function(names, xform, parent) { | |
25 | .Call('bindrcpp_do_test_create_environment', PACKAGE = 'bindrcpp', names, xform, parent) | |
26 | } | |
27 | ||
28 | # Register entry points for exported C++ functions | |
29 | methods::setLoadAction(function(ns) { | |
30 | .Call('bindrcpp_RcppExport_registerCCallable', PACKAGE = 'bindrcpp') | |
31 | }) |
0 | #' @details Use `LinkingTo: bindrcpp` in `DESCRIPTION` and | |
1 | #' `#include <bindrcpp.h>` in your C++ headers and/or modules to access the | |
2 | #' C++ functions provided by this package: | |
3 | #' | |
4 | #' - `create_env_string()` creates an environment with active bindings, with | |
5 | #' names given as a character vector. Access of these bindings triggers a | |
6 | #' call to a C++ function with a fixed signature (`GETTER_FUNC_STRING`); | |
7 | #' this call contains the name of the binding (as character) and an arbitrary | |
8 | #' payload (`PAYLOAD`, essentially a wrapped `void*`). | |
9 | #' - `create_env_symbol()` is similar, the callback function accepts the name of | |
10 | #' the binding as symbol instead of character (`GETTER_FUNC_SYMBOL`). | |
11 | #' - `populate_env_string()` and `populate_env_symbol()` populate an existing | |
12 | #' environment instead of creating a new one. | |
13 | "_PACKAGE" | |
14 | ||
15 | #' @useDynLib bindrcpp | |
16 | #' @importFrom Rcpp sourceCpp | |
17 | #' @importFrom bindr create_env populate_env | |
18 | NULL |
0 | cpp_create_environment <- function(names, xform, parent = parent.frame()) { | |
1 | do_test_create_environment(names, xform, parent) | |
2 | } |
0 | ||
1 | <!-- README.md is generated from README.Rmd. Please edit that file --> | |
2 | bindrcpp [![Travis-CI Build Status](https://travis-ci.org/krlmlr/bindrcpp.svg?branch=master)](https://travis-ci.org/krlmlr/bindrcpp) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/krlmlr/bindrcpp?branch=master&svg=true)](https://ci.appveyor.com/project/krlmlr/bindrcpp) [![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/bindrcpp)](https://cran.r-project.org/package=bindrcpp) | |
3 | =============================================================================================================================================================================================================================================================================================================================================================================================================================== | |
4 | ||
5 | It's easy to create active bindings in R via [`makeActiveBinding()`](https://www.rdocumentation.org/packages/base/versions/3.3.1/topics/bindenv). This package faciliates the creation of active bindings that link back to C++ code. It provides an interface that allows binding several identifiers in an environment to the same C++ function, which is then called with the name (and a payload) as argument. | |
6 | ||
7 | Installation | |
8 | ------------ | |
9 | ||
10 | You can install bindrcpp from github with: | |
11 | ||
12 | ``` r | |
13 | # install.packages("devtools") | |
14 | devtools::install_github("krlmlr/bindrcpp") | |
15 | ``` | |
16 | ||
17 | Example | |
18 | ------- | |
19 | ||
20 | The following C++ module exports a function `test_tolower_bindings()` that creates active bindings that return the binding name in lowercase. | |
21 | ||
22 | ``` cpp | |
23 | #include <Rcpp.h> | |
24 | ||
25 | // [[Rcpp::depends(bindrcpp)]] | |
26 | #include <bindrcpp.h> | |
27 | ||
28 | #include <algorithm> | |
29 | #include <string> | |
30 | ||
31 | using namespace Rcpp; | |
32 | ||
33 | using namespace bindrcpp; | |
34 | ||
35 | SEXP tolower_callback(const String& name, PAYLOAD) { | |
36 | std::string name_string = name; | |
37 | std::transform(name_string.begin(), name_string.end(), name_string.begin(), ::tolower); | |
38 | return CharacterVector(name_string); | |
39 | } | |
40 | ||
41 | // [[Rcpp::export]] | |
42 | SEXP test_tolower_bindings(CharacterVector names, Environment parent) { | |
43 | // We don't pass any payload here | |
44 | return bindrcpp::create_env_string( | |
45 | names, &tolower_callback, PAYLOAD(NULL), parent); | |
46 | } | |
47 | ``` | |
48 | ||
49 | This function can be called from R: | |
50 | ||
51 | ``` r | |
52 | env <- test_tolower_bindings(c("Converting", "to", "LOWERCASE"), .GlobalEnv) | |
53 | ls(env) | |
54 | #> [1] "Converting" "LOWERCASE" "to" | |
55 | env$Converting | |
56 | #> [1] "converting" | |
57 | env$to | |
58 | #> [1] "to" | |
59 | env$LOWERCASE | |
60 | #> [1] "lowercase" | |
61 | env$y | |
62 | #> NULL | |
63 | ``` | |
64 | ||
65 | The bindings are read-only: | |
66 | ||
67 | ``` r | |
68 | env$Converting <- "CONVERTING" | |
69 | #> Error: Binding is read-only. | |
70 | ``` |
0 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand | |
1 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 | |
2 | ||
3 | #ifndef RCPP_bindrcpp_H_GEN_ | |
4 | #define RCPP_bindrcpp_H_GEN_ | |
5 | ||
6 | #include "bindrcpp_RcppExports.h" | |
7 | ||
8 | #endif // RCPP_bindrcpp_H_GEN_ |
0 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand | |
1 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 | |
2 | ||
3 | #ifndef RCPP_bindrcpp_RCPPEXPORTS_H_GEN_ | |
4 | #define RCPP_bindrcpp_RCPPEXPORTS_H_GEN_ | |
5 | ||
6 | #include "bindrcpp_types.h" | |
7 | #include <Rcpp.h> | |
8 | ||
9 | namespace bindrcpp { | |
10 | ||
11 | using namespace Rcpp; | |
12 | ||
13 | namespace { | |
14 | void validateSignature(const char* sig) { | |
15 | Rcpp::Function require = Rcpp::Environment::base_env()["require"]; | |
16 | require("bindrcpp", Rcpp::Named("quietly") = true); | |
17 | typedef int(*Ptr_validate)(const char*); | |
18 | static Ptr_validate p_validate = (Ptr_validate) | |
19 | R_GetCCallable("bindrcpp", "bindrcpp_RcppExport_validate"); | |
20 | if (!p_validate(sig)) { | |
21 | throw Rcpp::function_not_exported( | |
22 | "C++ function with signature '" + std::string(sig) + "' not found in bindrcpp"); | |
23 | } | |
24 | } | |
25 | } | |
26 | ||
27 | inline Environment create_env_string(CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload, Environment enclos) { | |
28 | typedef SEXP(*Ptr_create_env_string)(SEXP,SEXP,SEXP,SEXP); | |
29 | static Ptr_create_env_string p_create_env_string = NULL; | |
30 | if (p_create_env_string == NULL) { | |
31 | validateSignature("Environment(*create_env_string)(CharacterVector,bindrcpp::GETTER_FUNC_STRING,bindrcpp::PAYLOAD,Environment)"); | |
32 | p_create_env_string = (Ptr_create_env_string)R_GetCCallable("bindrcpp", "bindrcpp_create_env_string"); | |
33 | } | |
34 | RObject rcpp_result_gen; | |
35 | { | |
36 | RNGScope RCPP_rngScope_gen; | |
37 | rcpp_result_gen = p_create_env_string(Shield<SEXP>(Rcpp::wrap(names)), Shield<SEXP>(Rcpp::wrap(fun)), Shield<SEXP>(Rcpp::wrap(payload)), Shield<SEXP>(Rcpp::wrap(enclos))); | |
38 | } | |
39 | if (rcpp_result_gen.inherits("interrupted-error")) | |
40 | throw Rcpp::internal::InterruptedException(); | |
41 | if (rcpp_result_gen.inherits("try-error")) | |
42 | throw Rcpp::exception(as<std::string>(rcpp_result_gen).c_str()); | |
43 | return Rcpp::as<Environment >(rcpp_result_gen); | |
44 | } | |
45 | ||
46 | inline Environment populate_env_string(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload) { | |
47 | typedef SEXP(*Ptr_populate_env_string)(SEXP,SEXP,SEXP,SEXP); | |
48 | static Ptr_populate_env_string p_populate_env_string = NULL; | |
49 | if (p_populate_env_string == NULL) { | |
50 | validateSignature("Environment(*populate_env_string)(Environment,CharacterVector,bindrcpp::GETTER_FUNC_STRING,bindrcpp::PAYLOAD)"); | |
51 | p_populate_env_string = (Ptr_populate_env_string)R_GetCCallable("bindrcpp", "bindrcpp_populate_env_string"); | |
52 | } | |
53 | RObject rcpp_result_gen; | |
54 | { | |
55 | RNGScope RCPP_rngScope_gen; | |
56 | rcpp_result_gen = p_populate_env_string(Shield<SEXP>(Rcpp::wrap(env)), Shield<SEXP>(Rcpp::wrap(names)), Shield<SEXP>(Rcpp::wrap(fun)), Shield<SEXP>(Rcpp::wrap(payload))); | |
57 | } | |
58 | if (rcpp_result_gen.inherits("interrupted-error")) | |
59 | throw Rcpp::internal::InterruptedException(); | |
60 | if (rcpp_result_gen.inherits("try-error")) | |
61 | throw Rcpp::exception(as<std::string>(rcpp_result_gen).c_str()); | |
62 | return Rcpp::as<Environment >(rcpp_result_gen); | |
63 | } | |
64 | ||
65 | inline Environment create_env_symbol(CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload, Environment enclos) { | |
66 | typedef SEXP(*Ptr_create_env_symbol)(SEXP,SEXP,SEXP,SEXP); | |
67 | static Ptr_create_env_symbol p_create_env_symbol = NULL; | |
68 | if (p_create_env_symbol == NULL) { | |
69 | validateSignature("Environment(*create_env_symbol)(CharacterVector,bindrcpp::GETTER_FUNC_SYMBOL,bindrcpp::PAYLOAD,Environment)"); | |
70 | p_create_env_symbol = (Ptr_create_env_symbol)R_GetCCallable("bindrcpp", "bindrcpp_create_env_symbol"); | |
71 | } | |
72 | RObject rcpp_result_gen; | |
73 | { | |
74 | RNGScope RCPP_rngScope_gen; | |
75 | rcpp_result_gen = p_create_env_symbol(Shield<SEXP>(Rcpp::wrap(names)), Shield<SEXP>(Rcpp::wrap(fun)), Shield<SEXP>(Rcpp::wrap(payload)), Shield<SEXP>(Rcpp::wrap(enclos))); | |
76 | } | |
77 | if (rcpp_result_gen.inherits("interrupted-error")) | |
78 | throw Rcpp::internal::InterruptedException(); | |
79 | if (rcpp_result_gen.inherits("try-error")) | |
80 | throw Rcpp::exception(as<std::string>(rcpp_result_gen).c_str()); | |
81 | return Rcpp::as<Environment >(rcpp_result_gen); | |
82 | } | |
83 | ||
84 | inline Environment populate_env_symbol(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload) { | |
85 | typedef SEXP(*Ptr_populate_env_symbol)(SEXP,SEXP,SEXP,SEXP); | |
86 | static Ptr_populate_env_symbol p_populate_env_symbol = NULL; | |
87 | if (p_populate_env_symbol == NULL) { | |
88 | validateSignature("Environment(*populate_env_symbol)(Environment,CharacterVector,bindrcpp::GETTER_FUNC_SYMBOL,bindrcpp::PAYLOAD)"); | |
89 | p_populate_env_symbol = (Ptr_populate_env_symbol)R_GetCCallable("bindrcpp", "bindrcpp_populate_env_symbol"); | |
90 | } | |
91 | RObject rcpp_result_gen; | |
92 | { | |
93 | RNGScope RCPP_rngScope_gen; | |
94 | rcpp_result_gen = p_populate_env_symbol(Shield<SEXP>(Rcpp::wrap(env)), Shield<SEXP>(Rcpp::wrap(names)), Shield<SEXP>(Rcpp::wrap(fun)), Shield<SEXP>(Rcpp::wrap(payload))); | |
95 | } | |
96 | if (rcpp_result_gen.inherits("interrupted-error")) | |
97 | throw Rcpp::internal::InterruptedException(); | |
98 | if (rcpp_result_gen.inherits("try-error")) | |
99 | throw Rcpp::exception(as<std::string>(rcpp_result_gen).c_str()); | |
100 | return Rcpp::as<Environment >(rcpp_result_gen); | |
101 | } | |
102 | ||
103 | } | |
104 | ||
105 | #endif // RCPP_bindrcpp_RCPPEXPORTS_H_GEN_ |
0 | #ifndef _bindrcpp_bindrcpp_types_H_ | |
1 | #define _bindrcpp_bindrcpp_types_H_ | |
2 | ||
3 | #include <RcppCommon.h> | |
4 | ||
5 | #include <Rcpp.h> | |
6 | ||
7 | namespace bindrcpp { | |
8 | ||
9 | struct PAYLOAD { void* p; explicit PAYLOAD(void* p_) : p(p_) {}; }; | |
10 | typedef SEXP (*GETTER_FUNC_STRING)(const Rcpp::String& name, bindrcpp::PAYLOAD payload); | |
11 | typedef SEXP (*GETTER_FUNC_SYMBOL)(const Rcpp::Symbol& name, bindrcpp::PAYLOAD payload); | |
12 | ||
13 | } | |
14 | ||
15 | namespace Rcpp { | |
16 | using namespace bindrcpp; | |
17 | ||
18 | template <> inline SEXP wrap(const PAYLOAD& payload) { | |
19 | return List::create(XPtr<PAYLOAD>(new PAYLOAD(payload))); | |
20 | } | |
21 | template <> inline SEXP wrap(const GETTER_FUNC_STRING& fun) { | |
22 | return List::create(XPtr<GETTER_FUNC_STRING>(new GETTER_FUNC_STRING(fun))); | |
23 | } | |
24 | template <> inline SEXP wrap(const GETTER_FUNC_SYMBOL& fun) { | |
25 | return List::create(XPtr<GETTER_FUNC_SYMBOL>(new GETTER_FUNC_SYMBOL(fun))); | |
26 | } | |
27 | template <> inline PAYLOAD as(SEXP x) { | |
28 | List xl = x; | |
29 | XPtr<PAYLOAD> xpayload(static_cast<SEXP>(xl[0])); | |
30 | return *xpayload.get(); | |
31 | } | |
32 | template <> inline GETTER_FUNC_STRING as(SEXP x) { | |
33 | List xl = x; | |
34 | XPtr<GETTER_FUNC_STRING> xfun(static_cast<SEXP>(xl[0])); | |
35 | return *xfun.get(); | |
36 | } | |
37 | template <> inline GETTER_FUNC_SYMBOL as(SEXP x) { | |
38 | List xl = x; | |
39 | XPtr<GETTER_FUNC_SYMBOL> xfun(static_cast<SEXP>(xl[0])); | |
40 | return *xfun.get(); | |
41 | } | |
42 | } | |
43 | ||
44 | #endif |
0 | % Generated by roxygen2: do not edit by hand | |
1 | % Please edit documentation in R/bindrcpp-package.R | |
2 | \docType{package} | |
3 | \name{bindrcpp-package} | |
4 | \alias{bindrcpp} | |
5 | \alias{bindrcpp-package} | |
6 | \title{bindrcpp: An 'Rcpp' Interface to Active Bindings} | |
7 | \description{ | |
8 | Provides an easy way to fill an environment with active bindings | |
9 | that call a C++ function. | |
10 | } | |
11 | \details{ | |
12 | Use \code{LinkingTo: bindrcpp} in \code{DESCRIPTION} and | |
13 | \code{#include <bindrcpp.h>} in your C++ headers and/or modules to access the | |
14 | C++ functions provided by this package: | |
15 | \itemize{ | |
16 | \item \code{create_env_string()} creates an environment with active bindings, with | |
17 | names given as a character vector. Access of these bindings triggers a | |
18 | call to a C++ function with a fixed signature (\code{GETTER_FUNC_STRING}); | |
19 | this call contains the name of the binding (as character) and an arbitrary | |
20 | payload (\code{PAYLOAD}, essentially a wrapped \code{void*}). | |
21 | \item \code{create_env_symbol()} is similar, the callback function accepts the name of | |
22 | the binding as symbol instead of character (\code{GETTER_FUNC_SYMBOL}). | |
23 | \item \code{populate_env_string()} and \code{populate_env_symbol()} populate an existing | |
24 | environment instead of creating a new one. | |
25 | } | |
26 | } | |
27 | \seealso{ | |
28 | Useful links: | |
29 | \itemize{ | |
30 | \item \url{https://github.com/krlmlr/bindrcpp} | |
31 | \item \url{https://krlmlr.github.io/bindrcpp} | |
32 | \item Report bugs at \url{https://github.com/krlmlr/bindrcpp/issues} | |
33 | } | |
34 | ||
35 | } | |
36 | \author{ | |
37 | \strong{Maintainer}: Kirill Müller \email{krlmlr+r@mailbox.org} | |
38 | ||
39 | Other contributors: | |
40 | \itemize{ | |
41 | \item RStudio [copyright holder] | |
42 | } | |
43 | ||
44 | } |
0 | % Generated by roxygen2: do not edit by hand | |
1 | % Please edit documentation in R/RcppExports.R | |
2 | \name{init_logging} | |
3 | \alias{init_logging} | |
4 | \title{Enable internal logging} | |
5 | \usage{ | |
6 | init_logging(log_level) | |
7 | } | |
8 | \arguments{ | |
9 | \item{log_level}{A character value, one of "WARN", "INFO", "DEBUG", "VERB", | |
10 | or "NONE".} | |
11 | } | |
12 | \description{ | |
13 | Log entries, depending on the log level, will be printed to the standard | |
14 | error stream. | |
15 | } | |
16 | \keyword{internal} |
0 | % Generated by roxygen2: do not edit by hand | |
1 | % Please edit documentation in R/bindr.R | |
2 | \docType{import} | |
3 | \name{reexports} | |
4 | \alias{reexports} | |
5 | \alias{create_env} | |
6 | \alias{reexports} | |
7 | \alias{populate_env} | |
8 | \title{Objects exported from other packages} | |
9 | \keyword{internal} | |
10 | \description{ | |
11 | These objects are imported from other packages. Follow the links | |
12 | below to see their documentation. | |
13 | ||
14 | \describe{ | |
15 | \item{bindr}{\code{\link[bindr]{create_env}}, \code{\link[bindr]{populate_env}}} | |
16 | }} | |
17 |
0 | PKG_CPPFLAGS = -I../inst/include -I. |
0 | PKG_CPPFLAGS = -I../inst/include -I. |
0 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand | |
1 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 | |
2 | ||
3 | #include "../inst/include/bindrcpp.h" | |
4 | #include "../inst/include/bindrcpp_types.h" | |
5 | #include <Rcpp.h> | |
6 | #include <string> | |
7 | #include <set> | |
8 | ||
9 | using namespace Rcpp; | |
10 | ||
11 | // create_env_string_imp | |
12 | Environment create_env_string_imp(CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload, Environment enclos); | |
13 | static SEXP bindrcpp_create_env_string_imp_try(SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP, SEXP enclosSEXP) { | |
14 | BEGIN_RCPP | |
15 | Rcpp::RObject rcpp_result_gen; | |
16 | Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP); | |
17 | Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_STRING >::type fun(funSEXP); | |
18 | Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP); | |
19 | Rcpp::traits::input_parameter< Environment >::type enclos(enclosSEXP); | |
20 | rcpp_result_gen = Rcpp::wrap(create_env_string_imp(names, fun, payload, enclos)); | |
21 | return rcpp_result_gen; | |
22 | END_RCPP_RETURN_ERROR | |
23 | } | |
24 | RcppExport SEXP bindrcpp_create_env_string_imp(SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP, SEXP enclosSEXP) { | |
25 | SEXP rcpp_result_gen; | |
26 | { | |
27 | Rcpp::RNGScope rcpp_rngScope_gen; | |
28 | rcpp_result_gen = PROTECT(bindrcpp_create_env_string_imp_try(namesSEXP, funSEXP, payloadSEXP, enclosSEXP)); | |
29 | } | |
30 | Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error"); | |
31 | if (rcpp_isInterrupt_gen) { | |
32 | UNPROTECT(1); | |
33 | Rf_onintr(); | |
34 | } | |
35 | Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error"); | |
36 | if (rcpp_isError_gen) { | |
37 | SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen); | |
38 | UNPROTECT(1); | |
39 | Rf_error(CHAR(rcpp_msgSEXP_gen)); | |
40 | } | |
41 | UNPROTECT(1); | |
42 | return rcpp_result_gen; | |
43 | } | |
44 | // populate_env_string_imp | |
45 | Environment populate_env_string_imp(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload); | |
46 | static SEXP bindrcpp_populate_env_string_imp_try(SEXP envSEXP, SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP) { | |
47 | BEGIN_RCPP | |
48 | Rcpp::RObject rcpp_result_gen; | |
49 | Rcpp::traits::input_parameter< Environment >::type env(envSEXP); | |
50 | Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP); | |
51 | Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_STRING >::type fun(funSEXP); | |
52 | Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP); | |
53 | rcpp_result_gen = Rcpp::wrap(populate_env_string_imp(env, names, fun, payload)); | |
54 | return rcpp_result_gen; | |
55 | END_RCPP_RETURN_ERROR | |
56 | } | |
57 | RcppExport SEXP bindrcpp_populate_env_string_imp(SEXP envSEXP, SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP) { | |
58 | SEXP rcpp_result_gen; | |
59 | { | |
60 | Rcpp::RNGScope rcpp_rngScope_gen; | |
61 | rcpp_result_gen = PROTECT(bindrcpp_populate_env_string_imp_try(envSEXP, namesSEXP, funSEXP, payloadSEXP)); | |
62 | } | |
63 | Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error"); | |
64 | if (rcpp_isInterrupt_gen) { | |
65 | UNPROTECT(1); | |
66 | Rf_onintr(); | |
67 | } | |
68 | Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error"); | |
69 | if (rcpp_isError_gen) { | |
70 | SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen); | |
71 | UNPROTECT(1); | |
72 | Rf_error(CHAR(rcpp_msgSEXP_gen)); | |
73 | } | |
74 | UNPROTECT(1); | |
75 | return rcpp_result_gen; | |
76 | } | |
77 | // create_env_symbol_imp | |
78 | Environment create_env_symbol_imp(CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload, Environment enclos); | |
79 | static SEXP bindrcpp_create_env_symbol_imp_try(SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP, SEXP enclosSEXP) { | |
80 | BEGIN_RCPP | |
81 | Rcpp::RObject rcpp_result_gen; | |
82 | Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP); | |
83 | Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_SYMBOL >::type fun(funSEXP); | |
84 | Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP); | |
85 | Rcpp::traits::input_parameter< Environment >::type enclos(enclosSEXP); | |
86 | rcpp_result_gen = Rcpp::wrap(create_env_symbol_imp(names, fun, payload, enclos)); | |
87 | return rcpp_result_gen; | |
88 | END_RCPP_RETURN_ERROR | |
89 | } | |
90 | RcppExport SEXP bindrcpp_create_env_symbol_imp(SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP, SEXP enclosSEXP) { | |
91 | SEXP rcpp_result_gen; | |
92 | { | |
93 | Rcpp::RNGScope rcpp_rngScope_gen; | |
94 | rcpp_result_gen = PROTECT(bindrcpp_create_env_symbol_imp_try(namesSEXP, funSEXP, payloadSEXP, enclosSEXP)); | |
95 | } | |
96 | Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error"); | |
97 | if (rcpp_isInterrupt_gen) { | |
98 | UNPROTECT(1); | |
99 | Rf_onintr(); | |
100 | } | |
101 | Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error"); | |
102 | if (rcpp_isError_gen) { | |
103 | SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen); | |
104 | UNPROTECT(1); | |
105 | Rf_error(CHAR(rcpp_msgSEXP_gen)); | |
106 | } | |
107 | UNPROTECT(1); | |
108 | return rcpp_result_gen; | |
109 | } | |
110 | // populate_env_symbol_imp | |
111 | Environment populate_env_symbol_imp(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload); | |
112 | static SEXP bindrcpp_populate_env_symbol_imp_try(SEXP envSEXP, SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP) { | |
113 | BEGIN_RCPP | |
114 | Rcpp::RObject rcpp_result_gen; | |
115 | Rcpp::traits::input_parameter< Environment >::type env(envSEXP); | |
116 | Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP); | |
117 | Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_SYMBOL >::type fun(funSEXP); | |
118 | Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP); | |
119 | rcpp_result_gen = Rcpp::wrap(populate_env_symbol_imp(env, names, fun, payload)); | |
120 | return rcpp_result_gen; | |
121 | END_RCPP_RETURN_ERROR | |
122 | } | |
123 | RcppExport SEXP bindrcpp_populate_env_symbol_imp(SEXP envSEXP, SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP) { | |
124 | SEXP rcpp_result_gen; | |
125 | { | |
126 | Rcpp::RNGScope rcpp_rngScope_gen; | |
127 | rcpp_result_gen = PROTECT(bindrcpp_populate_env_symbol_imp_try(envSEXP, namesSEXP, funSEXP, payloadSEXP)); | |
128 | } | |
129 | Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error"); | |
130 | if (rcpp_isInterrupt_gen) { | |
131 | UNPROTECT(1); | |
132 | Rf_onintr(); | |
133 | } | |
134 | Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error"); | |
135 | if (rcpp_isError_gen) { | |
136 | SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen); | |
137 | UNPROTECT(1); | |
138 | Rf_error(CHAR(rcpp_msgSEXP_gen)); | |
139 | } | |
140 | UNPROTECT(1); | |
141 | return rcpp_result_gen; | |
142 | } | |
143 | // init_logging | |
144 | void init_logging(const std::string& log_level); | |
145 | RcppExport SEXP bindrcpp_init_logging(SEXP log_levelSEXP) { | |
146 | BEGIN_RCPP | |
147 | Rcpp::RNGScope rcpp_rngScope_gen; | |
148 | Rcpp::traits::input_parameter< const std::string& >::type log_level(log_levelSEXP); | |
149 | init_logging(log_level); | |
150 | return R_NilValue; | |
151 | END_RCPP | |
152 | } | |
153 | // callback_string | |
154 | SEXP callback_string(Symbol name, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload); | |
155 | RcppExport SEXP bindrcpp_callback_string(SEXP nameSEXP, SEXP funSEXP, SEXP payloadSEXP) { | |
156 | BEGIN_RCPP | |
157 | Rcpp::RObject rcpp_result_gen; | |
158 | Rcpp::traits::input_parameter< Symbol >::type name(nameSEXP); | |
159 | Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_STRING >::type fun(funSEXP); | |
160 | Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP); | |
161 | rcpp_result_gen = Rcpp::wrap(callback_string(name, fun, payload)); | |
162 | return rcpp_result_gen; | |
163 | END_RCPP | |
164 | } | |
165 | // callback_symbol | |
166 | SEXP callback_symbol(Symbol name, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload); | |
167 | RcppExport SEXP bindrcpp_callback_symbol(SEXP nameSEXP, SEXP funSEXP, SEXP payloadSEXP) { | |
168 | BEGIN_RCPP | |
169 | Rcpp::RObject rcpp_result_gen; | |
170 | Rcpp::traits::input_parameter< Symbol >::type name(nameSEXP); | |
171 | Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_SYMBOL >::type fun(funSEXP); | |
172 | Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP); | |
173 | rcpp_result_gen = Rcpp::wrap(callback_symbol(name, fun, payload)); | |
174 | return rcpp_result_gen; | |
175 | END_RCPP | |
176 | } | |
177 | // do_test_create_environment | |
178 | List do_test_create_environment(CharacterVector names, String xform, Environment parent); | |
179 | RcppExport SEXP bindrcpp_do_test_create_environment(SEXP namesSEXP, SEXP xformSEXP, SEXP parentSEXP) { | |
180 | BEGIN_RCPP | |
181 | Rcpp::RObject rcpp_result_gen; | |
182 | Rcpp::RNGScope rcpp_rngScope_gen; | |
183 | Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP); | |
184 | Rcpp::traits::input_parameter< String >::type xform(xformSEXP); | |
185 | Rcpp::traits::input_parameter< Environment >::type parent(parentSEXP); | |
186 | rcpp_result_gen = Rcpp::wrap(do_test_create_environment(names, xform, parent)); | |
187 | return rcpp_result_gen; | |
188 | END_RCPP | |
189 | } | |
190 | ||
191 | // validate (ensure exported C++ functions exist before calling them) | |
192 | static int bindrcpp_RcppExport_validate(const char* sig) { | |
193 | static std::set<std::string> signatures; | |
194 | if (signatures.empty()) { | |
195 | signatures.insert("Environment(*create_env_string)(CharacterVector,bindrcpp::GETTER_FUNC_STRING,bindrcpp::PAYLOAD,Environment)"); | |
196 | signatures.insert("Environment(*populate_env_string)(Environment,CharacterVector,bindrcpp::GETTER_FUNC_STRING,bindrcpp::PAYLOAD)"); | |
197 | signatures.insert("Environment(*create_env_symbol)(CharacterVector,bindrcpp::GETTER_FUNC_SYMBOL,bindrcpp::PAYLOAD,Environment)"); | |
198 | signatures.insert("Environment(*populate_env_symbol)(Environment,CharacterVector,bindrcpp::GETTER_FUNC_SYMBOL,bindrcpp::PAYLOAD)"); | |
199 | } | |
200 | return signatures.find(sig) != signatures.end(); | |
201 | } | |
202 | ||
203 | // registerCCallable (register entry points for exported C++ functions) | |
204 | RcppExport SEXP bindrcpp_RcppExport_registerCCallable() { | |
205 | R_RegisterCCallable("bindrcpp", "bindrcpp_create_env_string", (DL_FUNC)bindrcpp_create_env_string_imp_try); | |
206 | R_RegisterCCallable("bindrcpp", "bindrcpp_populate_env_string", (DL_FUNC)bindrcpp_populate_env_string_imp_try); | |
207 | R_RegisterCCallable("bindrcpp", "bindrcpp_create_env_symbol", (DL_FUNC)bindrcpp_create_env_symbol_imp_try); | |
208 | R_RegisterCCallable("bindrcpp", "bindrcpp_populate_env_symbol", (DL_FUNC)bindrcpp_populate_env_symbol_imp_try); | |
209 | R_RegisterCCallable("bindrcpp", "bindrcpp_RcppExport_validate", (DL_FUNC)bindrcpp_RcppExport_validate); | |
210 | return R_NilValue; | |
211 | } | |
212 | ||
213 | static const R_CallMethodDef CallEntries[] = { | |
214 | {"bindrcpp_create_env_string_imp", (DL_FUNC) &bindrcpp_create_env_string_imp, 4}, | |
215 | {"bindrcpp_populate_env_string_imp", (DL_FUNC) &bindrcpp_populate_env_string_imp, 4}, | |
216 | {"bindrcpp_create_env_symbol_imp", (DL_FUNC) &bindrcpp_create_env_symbol_imp, 4}, | |
217 | {"bindrcpp_populate_env_symbol_imp", (DL_FUNC) &bindrcpp_populate_env_symbol_imp, 4}, | |
218 | {"bindrcpp_init_logging", (DL_FUNC) &bindrcpp_init_logging, 1}, | |
219 | {"bindrcpp_callback_string", (DL_FUNC) &bindrcpp_callback_string, 3}, | |
220 | {"bindrcpp_callback_symbol", (DL_FUNC) &bindrcpp_callback_symbol, 3}, | |
221 | {"bindrcpp_do_test_create_environment", (DL_FUNC) &bindrcpp_do_test_create_environment, 3}, | |
222 | {"bindrcpp_RcppExport_registerCCallable", (DL_FUNC) &bindrcpp_RcppExport_registerCCallable, 0}, | |
223 | {NULL, NULL, 0} | |
224 | }; | |
225 | ||
226 | RcppExport void R_init_bindrcpp(DllInfo *dll) { | |
227 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); | |
228 | R_useDynamicSymbols(dll, FALSE); | |
229 | } |
0 | #include <Rcpp.h> | |
1 | ||
2 | #include <bindrcpp.h> | |
3 | ||
4 | #include <plogr.h> | |
5 | ||
6 | using namespace Rcpp; | |
7 | ||
8 | Environment pkg_env = Environment::namespace_env("bindrcpp"); | |
9 | Function R_create_env("create_env", pkg_env); | |
10 | Function R_populate_env("populate_env", pkg_env); | |
11 | Function R_callback_string("callback_string", pkg_env); | |
12 | Function R_callback_symbol("callback_symbol", pkg_env); | |
13 | ||
14 | // [[Rcpp::interfaces(cpp)]] | |
15 | // [[Rcpp::export(create_env_string)]] | |
16 | Environment create_env_string_imp(CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload, Environment enclos) { | |
17 | using namespace bindrcpp; | |
18 | ||
19 | LOG_VERBOSE << payload.p; | |
20 | return R_create_env(names, R_callback_string, fun, payload, _[".enclos"] = enclos); | |
21 | } | |
22 | ||
23 | // [[Rcpp::interfaces(cpp)]] | |
24 | // [[Rcpp::export(populate_env_string)]] | |
25 | Environment populate_env_string_imp(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload) { | |
26 | using namespace bindrcpp; | |
27 | ||
28 | LOG_VERBOSE << payload.p; | |
29 | return R_populate_env(env, names, R_callback_string, fun, payload); | |
30 | } | |
31 | ||
32 | // [[Rcpp::interfaces(cpp)]] | |
33 | // [[Rcpp::export(create_env_symbol)]] | |
34 | Environment create_env_symbol_imp(CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload, Environment enclos) { | |
35 | using namespace bindrcpp; | |
36 | ||
37 | LOG_VERBOSE << payload.p; | |
38 | return R_create_env(names, R_callback_symbol, fun, payload, _[".enclos"] = enclos); | |
39 | } | |
40 | ||
41 | // [[Rcpp::interfaces(cpp)]] | |
42 | // [[Rcpp::export(populate_env_symbol)]] | |
43 | Environment populate_env_symbol_imp(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload) { | |
44 | using namespace bindrcpp; | |
45 | ||
46 | LOG_VERBOSE << payload.p; | |
47 | return R_populate_env(env, names, R_callback_symbol, fun, payload); | |
48 | } |
0 | #include <plogr.h> | |
1 | ||
2 | //' Enable internal logging | |
3 | //' | |
4 | //' Log entries, depending on the log level, will be printed to the standard | |
5 | //' error stream. | |
6 | //' | |
7 | //' @param log_level A character value, one of "WARN", "INFO", "DEBUG", "VERB", | |
8 | //' or "NONE". | |
9 | //' | |
10 | //' @keywords internal | |
11 | // [[Rcpp::export]] | |
12 | void init_logging(const std::string& log_level) { | |
13 | plog::init_r(log_level); | |
14 | } |
0 | #include <Rcpp.h> | |
1 | ||
2 | #include <bindrcpp.h> | |
3 | ||
4 | #include <plogr.h> | |
5 | ||
6 | #include <algorithm> | |
7 | #include <string> | |
8 | ||
9 | using namespace Rcpp; | |
10 | ||
11 | using namespace bindrcpp; | |
12 | ||
13 | // [[Rcpp::export(rng = FALSE)]] | |
14 | SEXP callback_string(Symbol name, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload) { | |
15 | LOG_VERBOSE << type2name(name); | |
16 | LOG_VERBOSE << payload.p; | |
17 | ||
18 | String name_string = name.c_str(); | |
19 | name_string.set_encoding(CE_NATIVE); | |
20 | ||
21 | return fun(name_string, payload); | |
22 | } | |
23 | ||
24 | // [[Rcpp::export(rng = FALSE)]] | |
25 | SEXP callback_symbol(Symbol name, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload) { | |
26 | LOG_VERBOSE << type2name(name); | |
27 | LOG_VERBOSE << payload.p; | |
28 | ||
29 | return fun(name, payload); | |
30 | } | |
31 | ||
32 | class CallbackTester { | |
33 | enum { MAGIC = 20161014 }; | |
34 | const int magic; | |
35 | ||
36 | public: | |
37 | CallbackTester() : magic(MAGIC) { LOG_VERBOSE; } | |
38 | ~CallbackTester() { LOG_VERBOSE; } | |
39 | ||
40 | static SEXP tolower_static(const Rcpp::String& name, PAYLOAD payload) { | |
41 | LOG_VERBOSE << payload.p; | |
42 | CallbackTester* this_ = reinterpret_cast<CallbackTester*>(payload.p); | |
43 | return this_->tolower(name); | |
44 | } | |
45 | ||
46 | static SEXP toupper_static(const Rcpp::String& name, PAYLOAD payload) { | |
47 | LOG_VERBOSE << payload.p; | |
48 | CallbackTester* this_ = reinterpret_cast<CallbackTester*>(payload.p); | |
49 | return this_->toupper(name); | |
50 | } | |
51 | ||
52 | private: | |
53 | SEXP tolower(Rcpp::String name) { | |
54 | LOG_VERBOSE << magic; | |
55 | if (magic != MAGIC) | |
56 | stop("payload lost"); | |
57 | std::string name_string = name; | |
58 | std::transform(name_string.begin(), name_string.end(), name_string.begin(), ::tolower); | |
59 | return CharacterVector(name_string); | |
60 | } | |
61 | ||
62 | SEXP toupper(Rcpp::String name) { | |
63 | LOG_VERBOSE << magic; | |
64 | if (magic != MAGIC) | |
65 | stop("payload lost"); | |
66 | std::string name_string = name; | |
67 | std::transform(name_string.begin(), name_string.end(), name_string.begin(), ::toupper); | |
68 | return CharacterVector(name_string); | |
69 | } | |
70 | }; | |
71 | ||
72 | // [[Rcpp::export]] | |
73 | List do_test_create_environment(CharacterVector names, String xform, Environment parent) { | |
74 | CallbackTester* pc = new CallbackTester; | |
75 | ||
76 | List ret = List::create(_["callback"] = XPtr<CallbackTester>(pc)); | |
77 | ||
78 | if (xform == "tolower") { | |
79 | ret["env"] = bindrcpp::create_env_string( | |
80 | names, &CallbackTester::tolower_static, PAYLOAD(pc), parent); | |
81 | } | |
82 | else if (xform == "toupper") { | |
83 | ret["env"] = bindrcpp::create_env_string( | |
84 | names, &CallbackTester::toupper_static, PAYLOAD(pc), parent); | |
85 | } | |
86 | else | |
87 | stop("unknown xform"); | |
88 | ||
89 | return ret; | |
90 | } |
0 | context("create") | |
1 | ||
2 | test_that("cpp_create_environment()", { | |
3 | env_cb <- cpp_create_environment(letters, "toupper") | |
4 | env <- env_cb$env | |
5 | expect_equal(env$a, "A") | |
6 | expect_equal(env$x, "X") | |
7 | expect_null(env$X) | |
8 | expect_equal(length(ls(env)), length(letters)) | |
9 | expect_error(env$a <- "a", "read-only") | |
10 | }) | |
11 | ||
12 | test_that("cpp_create_environment() with inheritance", { | |
13 | env_cb <- cpp_create_environment(letters, "toupper") | |
14 | env <- env_cb$env | |
15 | env2_cb <- cpp_create_environment(LETTERS, "tolower", parent = env) | |
16 | env2 <- env2_cb$env | |
17 | expect_equal(get("a", env2), "A") | |
18 | expect_equal(get("x", env2), "X") | |
19 | expect_null(env2$a) | |
20 | expect_null(env2$x) | |
21 | expect_equal(env2$B, "b") | |
22 | expect_equal(env2$Y, "y") | |
23 | expect_equal(length(ls(env2)), length(letters)) | |
24 | expect_error(env2$B <- "B", "read-only") | |
25 | expect_error(env2$a <- "a", NA) | |
26 | expect_equal(get("a", env2), "a") | |
27 | }) |