[med-svn] [r-cran-bindrcpp] 01/02: New upstream version 0.2
Andreas Tille
tille at debian.org
Sat Sep 30 11:35:42 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-bindrcpp.
commit 976f0351da9c1ea3b3e9390d542e94957c49ab15
Author: Andreas Tille <tille at debian.org>
Date: Sat Sep 30 13:35:12 2017 +0200
New upstream version 0.2
---
DESCRIPTION | 27 +++++
LICENSE | 2 +
MD5 | 23 ++++
NAMESPACE | 8 ++
NEWS.md | 22 ++++
R/RcppExports.R | 32 +++++
R/bindr.R | 5 +
R/bindrcpp-package.R | 19 +++
R/test.R | 3 +
README.md | 71 +++++++++++
inst/include/bindrcpp.h | 9 ++
inst/include/bindrcpp_RcppExports.h | 106 +++++++++++++++++
inst/include/bindrcpp_types.h | 45 +++++++
man/bindrcpp-package.Rd | 45 +++++++
man/init_logging.Rd | 17 +++
man/reexports.Rd | 18 +++
src/Makevars | 1 +
src/Makevars.win | 1 +
src/RcppExports.cpp | 230 ++++++++++++++++++++++++++++++++++++
src/create.cpp | 49 ++++++++
src/plogr.cpp | 15 +++
src/test.cpp | 91 ++++++++++++++
tests/testthat.R | 4 +
tests/testthat/test-create.R | 28 +++++
24 files changed, 871 insertions(+)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..df83725
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,27 @@
+Package: bindrcpp
+Title: An 'Rcpp' Interface to Active Bindings
+Description: Provides an easy way to fill an environment with active bindings
+ that call a C++ function.
+Authors at R: c(
+ person("Kirill", "Müller", role = c("aut", "cre"), email = "krlmlr+r at mailbox.org"),
+ person("RStudio", role = "cph")
+ )
+Version: 0.2
+Date: 2017-06-15
+URL: https://github.com/krlmlr/bindrcpp,
+ https://krlmlr.github.io/bindrcpp
+BugReports: https://github.com/krlmlr/bindrcpp/issues
+Imports: Rcpp, bindr
+Suggests: testthat
+LinkingTo: Rcpp, plogr
+RoxygenNote: 6.0.1
+LazyData: true
+License: MIT + file LICENSE
+Encoding: UTF-8
+NeedsCompilation: yes
+Packaged: 2017-06-15 20:53:22 UTC; muelleki
+Author: Kirill Müller [aut, cre],
+ RStudio [cph]
+Maintainer: Kirill Müller <krlmlr+r at mailbox.org>
+Repository: CRAN
+Date/Publication: 2017-06-17 23:52:40 UTC
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..120294d
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,2 @@
+YEAR: 2016
+COPYRIGHT HOLDER: RStudio
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..20d769c
--- /dev/null
+++ b/MD5
@@ -0,0 +1,23 @@
+52470b405afa4c0d5172a439604ad6bd *DESCRIPTION
+d3d2f503f5c96ac395a270e7c295ec0b *LICENSE
+3a9c92677932609677f9a6370d097c29 *NAMESPACE
+876a0477e3f61e936ef0fdb7211fdaaf *NEWS.md
+7ddf9467cba4519d4692e5f6f1795806 *R/RcppExports.R
+1ce0e6f00f32e2d0765fb57749317ec9 *R/bindr.R
+b04097e5dbb70ea2d7bf5b0fee8acb46 *R/bindrcpp-package.R
+2cdf48ce2f31adb3aea16cd398507126 *R/test.R
+35837e0fbb8b9a53760fd747e6bdac89 *README.md
+ebff110d87c1681eda6f30b93fa7ffde *inst/include/bindrcpp.h
+fc7eea695d0dd9253a05637f8d7601da *inst/include/bindrcpp_RcppExports.h
+51590efce84ef7ff9bf547c265cd66bf *inst/include/bindrcpp_types.h
+aaf228a83c0e8d48ab132a5523ab5ccf *man/bindrcpp-package.Rd
+fed1d0a4957c37ae234ceb655095f717 *man/init_logging.Rd
+bfebf612b38c0d8e41f4f3449c290aa7 *man/reexports.Rd
+3a3c839566f06a1eb4cb3c960b7cab62 *src/Makevars
+3a3c839566f06a1eb4cb3c960b7cab62 *src/Makevars.win
+9436f19309a6dcd8adc4fd9cb33930fd *src/RcppExports.cpp
+5917fdf0957beca52727bb02dad6a90f *src/create.cpp
+6492f645509837fe7c735958d71079d3 *src/plogr.cpp
+4c5fafc9e32aea31f70fd316f4f0af9e *src/test.cpp
+9d12bc91cc42c506ca4ac9a2184614b8 *tests/testthat.R
+56632f0010990dc5ab5d734dfe763b95 *tests/testthat/test-create.R
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..527adb0
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,8 @@
+# Generated by roxygen2: do not edit by hand
+
+export(create_env)
+export(populate_env)
+importFrom(Rcpp,sourceCpp)
+importFrom(bindr,create_env)
+importFrom(bindr,populate_env)
+useDynLib(bindrcpp)
diff --git a/NEWS.md b/NEWS.md
new file mode 100644
index 0000000..f663e63
--- /dev/null
+++ b/NEWS.md
@@ -0,0 +1,22 @@
+# bindrcpp 0.2 (2017-06-15)
+
+- Fixed very rare segmentation fault due to missing protection of function arguments in autogenerated boilerplate code.
+- Fix compilation errors on FreeBSD due to use of nonstandard Make features (#5).
+- Native symbol registration added by Rcpp.
+
+
+# bindrcpp 0.1 (2016-12-08)
+
+Initial CRAN release.
+
+## Exported C++ functions
+
+- `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*`).
+- `create_env_symbol()` is similar, the callback function accepts the name of the binding as symbol instead of
+ character (`GETTER_FUNC_SYMBOL`).
+- `populate_env_string()` and `populate_env_symbol()` populate an existing environment instead of creating a new one.
+- Use `LinkingTo: bindrcpp` and `#include <bindrcpp.h>` to access these functions from your package.
+
+## Exported R functions
+
+- Reexported from `bindr`: `create_env()` and `populate_env()`.
diff --git a/R/RcppExports.R b/R/RcppExports.R
new file mode 100644
index 0000000..07be4ab
--- /dev/null
+++ b/R/RcppExports.R
@@ -0,0 +1,32 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#' Enable internal logging
+#'
+#' Log entries, depending on the log level, will be printed to the standard
+#' error stream.
+#'
+#' @param log_level A character value, one of "WARN", "INFO", "DEBUG", "VERB",
+#' or "NONE".
+#'
+#' @keywords internal
+init_logging <- function(log_level) {
+ invisible(.Call('bindrcpp_init_logging', PACKAGE = 'bindrcpp', log_level))
+}
+
+callback_string <- function(name, fun, payload) {
+ .Call('bindrcpp_callback_string', PACKAGE = 'bindrcpp', name, fun, payload)
+}
+
+callback_symbol <- function(name, fun, payload) {
+ .Call('bindrcpp_callback_symbol', PACKAGE = 'bindrcpp', name, fun, payload)
+}
+
+do_test_create_environment <- function(names, xform, parent) {
+ .Call('bindrcpp_do_test_create_environment', PACKAGE = 'bindrcpp', names, xform, parent)
+}
+
+# Register entry points for exported C++ functions
+methods::setLoadAction(function(ns) {
+ .Call('bindrcpp_RcppExport_registerCCallable', PACKAGE = 'bindrcpp')
+})
diff --git a/R/bindr.R b/R/bindr.R
new file mode 100644
index 0000000..b729759
--- /dev/null
+++ b/R/bindr.R
@@ -0,0 +1,5 @@
+#' @export
+bindr::create_env
+
+#' @export
+bindr::populate_env
diff --git a/R/bindrcpp-package.R b/R/bindrcpp-package.R
new file mode 100644
index 0000000..8e23a0d
--- /dev/null
+++ b/R/bindrcpp-package.R
@@ -0,0 +1,19 @@
+#' @details Use `LinkingTo: bindrcpp` in `DESCRIPTION` and
+#' `#include <bindrcpp.h>` in your C++ headers and/or modules to access the
+#' C++ functions provided by this package:
+#'
+#' - `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*`).
+#' - `create_env_symbol()` is similar, the callback function accepts the name of
+#' the binding as symbol instead of character (`GETTER_FUNC_SYMBOL`).
+#' - `populate_env_string()` and `populate_env_symbol()` populate an existing
+#' environment instead of creating a new one.
+"_PACKAGE"
+
+#' @useDynLib bindrcpp
+#' @importFrom Rcpp sourceCpp
+#' @importFrom bindr create_env populate_env
+NULL
diff --git a/R/test.R b/R/test.R
new file mode 100644
index 0000000..1aab19d
--- /dev/null
+++ b/R/test.R
@@ -0,0 +1,3 @@
+cpp_create_environment <- function(names, xform, parent = parent.frame()) {
+ do_test_create_environment(names, xform, parent)
+}
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..628c52b
--- /dev/null
+++ b/README.md
@@ -0,0 +1,71 @@
+
+<!-- README.md is generated from README.Rmd. Please edit that file -->
+bindrcpp [](https://travis-ci.org/krlmlr/bindrcpp) [](https://ci.appveyor.com/project/krlmlr/bindrcpp) [](https://cran.r-project.org/package=bindrcpp)
+===============================================================================================================================================================================================================================================================================================================================================================================================================================
+
+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.
+
+Installation
+------------
+
+You can install bindrcpp from github with:
+
+``` r
+# install.packages("devtools")
+devtools::install_github("krlmlr/bindrcpp")
+```
+
+Example
+-------
+
+The following C++ module exports a function `test_tolower_bindings()` that creates active bindings that return the binding name in lowercase.
+
+``` cpp
+#include <Rcpp.h>
+
+// [[Rcpp::depends(bindrcpp)]]
+#include <bindrcpp.h>
+
+#include <algorithm>
+#include <string>
+
+using namespace Rcpp;
+
+using namespace bindrcpp;
+
+SEXP tolower_callback(const String& name, PAYLOAD) {
+ std::string name_string = name;
+ std::transform(name_string.begin(), name_string.end(), name_string.begin(), ::tolower);
+ return CharacterVector(name_string);
+}
+
+// [[Rcpp::export]]
+SEXP test_tolower_bindings(CharacterVector names, Environment parent) {
+ // We don't pass any payload here
+ return bindrcpp::create_env_string(
+ names, &tolower_callback, PAYLOAD(NULL), parent);
+}
+```
+
+This function can be called from R:
+
+``` r
+env <- test_tolower_bindings(c("Converting", "to", "LOWERCASE"), .GlobalEnv)
+ls(env)
+#> [1] "Converting" "LOWERCASE" "to"
+env$Converting
+#> [1] "converting"
+env$to
+#> [1] "to"
+env$LOWERCASE
+#> [1] "lowercase"
+env$y
+#> NULL
+```
+
+The bindings are read-only:
+
+``` r
+env$Converting <- "CONVERTING"
+#> Error: Binding is read-only.
+```
diff --git a/inst/include/bindrcpp.h b/inst/include/bindrcpp.h
new file mode 100644
index 0000000..ae327dd
--- /dev/null
+++ b/inst/include/bindrcpp.h
@@ -0,0 +1,9 @@
+// Generated by using Rcpp::compileAttributes() -> do not edit by hand
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#ifndef RCPP_bindrcpp_H_GEN_
+#define RCPP_bindrcpp_H_GEN_
+
+#include "bindrcpp_RcppExports.h"
+
+#endif // RCPP_bindrcpp_H_GEN_
diff --git a/inst/include/bindrcpp_RcppExports.h b/inst/include/bindrcpp_RcppExports.h
new file mode 100644
index 0000000..44c1214
--- /dev/null
+++ b/inst/include/bindrcpp_RcppExports.h
@@ -0,0 +1,106 @@
+// Generated by using Rcpp::compileAttributes() -> do not edit by hand
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#ifndef RCPP_bindrcpp_RCPPEXPORTS_H_GEN_
+#define RCPP_bindrcpp_RCPPEXPORTS_H_GEN_
+
+#include "bindrcpp_types.h"
+#include <Rcpp.h>
+
+namespace bindrcpp {
+
+ using namespace Rcpp;
+
+ namespace {
+ void validateSignature(const char* sig) {
+ Rcpp::Function require = Rcpp::Environment::base_env()["require"];
+ require("bindrcpp", Rcpp::Named("quietly") = true);
+ typedef int(*Ptr_validate)(const char*);
+ static Ptr_validate p_validate = (Ptr_validate)
+ R_GetCCallable("bindrcpp", "bindrcpp_RcppExport_validate");
+ if (!p_validate(sig)) {
+ throw Rcpp::function_not_exported(
+ "C++ function with signature '" + std::string(sig) + "' not found in bindrcpp");
+ }
+ }
+ }
+
+ inline Environment create_env_string(CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload, Environment enclos) {
+ typedef SEXP(*Ptr_create_env_string)(SEXP,SEXP,SEXP,SEXP);
+ static Ptr_create_env_string p_create_env_string = NULL;
+ if (p_create_env_string == NULL) {
+ validateSignature("Environment(*create_env_string)(CharacterVector,bindrcpp::GETTER_FUNC_STRING,bindrcpp::PAYLOAD,Environment)");
+ p_create_env_string = (Ptr_create_env_string)R_GetCCallable("bindrcpp", "bindrcpp_create_env_string");
+ }
+ RObject rcpp_result_gen;
+ {
+ RNGScope RCPP_rngScope_gen;
+ 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)));
+ }
+ if (rcpp_result_gen.inherits("interrupted-error"))
+ throw Rcpp::internal::InterruptedException();
+ if (rcpp_result_gen.inherits("try-error"))
+ throw Rcpp::exception(as<std::string>(rcpp_result_gen).c_str());
+ return Rcpp::as<Environment >(rcpp_result_gen);
+ }
+
+ inline Environment populate_env_string(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload) {
+ typedef SEXP(*Ptr_populate_env_string)(SEXP,SEXP,SEXP,SEXP);
+ static Ptr_populate_env_string p_populate_env_string = NULL;
+ if (p_populate_env_string == NULL) {
+ validateSignature("Environment(*populate_env_string)(Environment,CharacterVector,bindrcpp::GETTER_FUNC_STRING,bindrcpp::PAYLOAD)");
+ p_populate_env_string = (Ptr_populate_env_string)R_GetCCallable("bindrcpp", "bindrcpp_populate_env_string");
+ }
+ RObject rcpp_result_gen;
+ {
+ RNGScope RCPP_rngScope_gen;
+ 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)));
+ }
+ if (rcpp_result_gen.inherits("interrupted-error"))
+ throw Rcpp::internal::InterruptedException();
+ if (rcpp_result_gen.inherits("try-error"))
+ throw Rcpp::exception(as<std::string>(rcpp_result_gen).c_str());
+ return Rcpp::as<Environment >(rcpp_result_gen);
+ }
+
+ inline Environment create_env_symbol(CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload, Environment enclos) {
+ typedef SEXP(*Ptr_create_env_symbol)(SEXP,SEXP,SEXP,SEXP);
+ static Ptr_create_env_symbol p_create_env_symbol = NULL;
+ if (p_create_env_symbol == NULL) {
+ validateSignature("Environment(*create_env_symbol)(CharacterVector,bindrcpp::GETTER_FUNC_SYMBOL,bindrcpp::PAYLOAD,Environment)");
+ p_create_env_symbol = (Ptr_create_env_symbol)R_GetCCallable("bindrcpp", "bindrcpp_create_env_symbol");
+ }
+ RObject rcpp_result_gen;
+ {
+ RNGScope RCPP_rngScope_gen;
+ 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)));
+ }
+ if (rcpp_result_gen.inherits("interrupted-error"))
+ throw Rcpp::internal::InterruptedException();
+ if (rcpp_result_gen.inherits("try-error"))
+ throw Rcpp::exception(as<std::string>(rcpp_result_gen).c_str());
+ return Rcpp::as<Environment >(rcpp_result_gen);
+ }
+
+ inline Environment populate_env_symbol(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload) {
+ typedef SEXP(*Ptr_populate_env_symbol)(SEXP,SEXP,SEXP,SEXP);
+ static Ptr_populate_env_symbol p_populate_env_symbol = NULL;
+ if (p_populate_env_symbol == NULL) {
+ validateSignature("Environment(*populate_env_symbol)(Environment,CharacterVector,bindrcpp::GETTER_FUNC_SYMBOL,bindrcpp::PAYLOAD)");
+ p_populate_env_symbol = (Ptr_populate_env_symbol)R_GetCCallable("bindrcpp", "bindrcpp_populate_env_symbol");
+ }
+ RObject rcpp_result_gen;
+ {
+ RNGScope RCPP_rngScope_gen;
+ 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)));
+ }
+ if (rcpp_result_gen.inherits("interrupted-error"))
+ throw Rcpp::internal::InterruptedException();
+ if (rcpp_result_gen.inherits("try-error"))
+ throw Rcpp::exception(as<std::string>(rcpp_result_gen).c_str());
+ return Rcpp::as<Environment >(rcpp_result_gen);
+ }
+
+}
+
+#endif // RCPP_bindrcpp_RCPPEXPORTS_H_GEN_
diff --git a/inst/include/bindrcpp_types.h b/inst/include/bindrcpp_types.h
new file mode 100644
index 0000000..6225d5f
--- /dev/null
+++ b/inst/include/bindrcpp_types.h
@@ -0,0 +1,45 @@
+#ifndef _bindrcpp_bindrcpp_types_H_
+#define _bindrcpp_bindrcpp_types_H_
+
+#include <RcppCommon.h>
+
+#include <Rcpp.h>
+
+namespace bindrcpp {
+
+struct PAYLOAD { void* p; explicit PAYLOAD(void* p_) : p(p_) {}; };
+typedef SEXP (*GETTER_FUNC_STRING)(const Rcpp::String& name, bindrcpp::PAYLOAD payload);
+typedef SEXP (*GETTER_FUNC_SYMBOL)(const Rcpp::Symbol& name, bindrcpp::PAYLOAD payload);
+
+}
+
+namespace Rcpp {
+ using namespace bindrcpp;
+
+ template <> inline SEXP wrap(const PAYLOAD& payload) {
+ return List::create(XPtr<PAYLOAD>(new PAYLOAD(payload)));
+ }
+ template <> inline SEXP wrap(const GETTER_FUNC_STRING& fun) {
+ return List::create(XPtr<GETTER_FUNC_STRING>(new GETTER_FUNC_STRING(fun)));
+ }
+ template <> inline SEXP wrap(const GETTER_FUNC_SYMBOL& fun) {
+ return List::create(XPtr<GETTER_FUNC_SYMBOL>(new GETTER_FUNC_SYMBOL(fun)));
+ }
+ template <> inline PAYLOAD as(SEXP x) {
+ List xl = x;
+ XPtr<PAYLOAD> xpayload(static_cast<SEXP>(xl[0]));
+ return *xpayload.get();
+ }
+ template <> inline GETTER_FUNC_STRING as(SEXP x) {
+ List xl = x;
+ XPtr<GETTER_FUNC_STRING> xfun(static_cast<SEXP>(xl[0]));
+ return *xfun.get();
+ }
+ template <> inline GETTER_FUNC_SYMBOL as(SEXP x) {
+ List xl = x;
+ XPtr<GETTER_FUNC_SYMBOL> xfun(static_cast<SEXP>(xl[0]));
+ return *xfun.get();
+ }
+}
+
+#endif
diff --git a/man/bindrcpp-package.Rd b/man/bindrcpp-package.Rd
new file mode 100644
index 0000000..c94222b
--- /dev/null
+++ b/man/bindrcpp-package.Rd
@@ -0,0 +1,45 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/bindrcpp-package.R
+\docType{package}
+\name{bindrcpp-package}
+\alias{bindrcpp}
+\alias{bindrcpp-package}
+\title{bindrcpp: An 'Rcpp' Interface to Active Bindings}
+\description{
+Provides an easy way to fill an environment with active bindings
+that call a C++ function.
+}
+\details{
+Use \code{LinkingTo: bindrcpp} in \code{DESCRIPTION} and
+\code{#include <bindrcpp.h>} in your C++ headers and/or modules to access the
+C++ functions provided by this package:
+\itemize{
+\item \code{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 (\code{GETTER_FUNC_STRING});
+this call contains the name of the binding (as character) and an arbitrary
+payload (\code{PAYLOAD}, essentially a wrapped \code{void*}).
+\item \code{create_env_symbol()} is similar, the callback function accepts the name of
+the binding as symbol instead of character (\code{GETTER_FUNC_SYMBOL}).
+\item \code{populate_env_string()} and \code{populate_env_symbol()} populate an existing
+environment instead of creating a new one.
+}
+}
+\seealso{
+Useful links:
+\itemize{
+ \item \url{https://github.com/krlmlr/bindrcpp}
+ \item \url{https://krlmlr.github.io/bindrcpp}
+ \item Report bugs at \url{https://github.com/krlmlr/bindrcpp/issues}
+}
+
+}
+\author{
+\strong{Maintainer}: Kirill Müller \email{krlmlr+r at mailbox.org}
+
+Other contributors:
+\itemize{
+ \item RStudio [copyright holder]
+}
+
+}
diff --git a/man/init_logging.Rd b/man/init_logging.Rd
new file mode 100644
index 0000000..e9510f4
--- /dev/null
+++ b/man/init_logging.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/RcppExports.R
+\name{init_logging}
+\alias{init_logging}
+\title{Enable internal logging}
+\usage{
+init_logging(log_level)
+}
+\arguments{
+\item{log_level}{A character value, one of "WARN", "INFO", "DEBUG", "VERB",
+or "NONE".}
+}
+\description{
+Log entries, depending on the log level, will be printed to the standard
+error stream.
+}
+\keyword{internal}
diff --git a/man/reexports.Rd b/man/reexports.Rd
new file mode 100644
index 0000000..ce5a27c
--- /dev/null
+++ b/man/reexports.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/bindr.R
+\docType{import}
+\name{reexports}
+\alias{reexports}
+\alias{create_env}
+\alias{reexports}
+\alias{populate_env}
+\title{Objects exported from other packages}
+\keyword{internal}
+\description{
+These objects are imported from other packages. Follow the links
+below to see their documentation.
+
+\describe{
+ \item{bindr}{\code{\link[bindr]{create_env}}, \code{\link[bindr]{populate_env}}}
+}}
+
diff --git a/src/Makevars b/src/Makevars
new file mode 100644
index 0000000..c2c61c6
--- /dev/null
+++ b/src/Makevars
@@ -0,0 +1 @@
+PKG_CPPFLAGS = -I../inst/include -I.
diff --git a/src/Makevars.win b/src/Makevars.win
new file mode 100644
index 0000000..c2c61c6
--- /dev/null
+++ b/src/Makevars.win
@@ -0,0 +1 @@
+PKG_CPPFLAGS = -I../inst/include -I.
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
new file mode 100644
index 0000000..caf6b65
--- /dev/null
+++ b/src/RcppExports.cpp
@@ -0,0 +1,230 @@
+// Generated by using Rcpp::compileAttributes() -> do not edit by hand
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#include "../inst/include/bindrcpp.h"
+#include "../inst/include/bindrcpp_types.h"
+#include <Rcpp.h>
+#include <string>
+#include <set>
+
+using namespace Rcpp;
+
+// create_env_string_imp
+Environment create_env_string_imp(CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload, Environment enclos);
+static SEXP bindrcpp_create_env_string_imp_try(SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP, SEXP enclosSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP);
+ Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_STRING >::type fun(funSEXP);
+ Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP);
+ Rcpp::traits::input_parameter< Environment >::type enclos(enclosSEXP);
+ rcpp_result_gen = Rcpp::wrap(create_env_string_imp(names, fun, payload, enclos));
+ return rcpp_result_gen;
+END_RCPP_RETURN_ERROR
+}
+RcppExport SEXP bindrcpp_create_env_string_imp(SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP, SEXP enclosSEXP) {
+ SEXP rcpp_result_gen;
+ {
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ rcpp_result_gen = PROTECT(bindrcpp_create_env_string_imp_try(namesSEXP, funSEXP, payloadSEXP, enclosSEXP));
+ }
+ Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
+ if (rcpp_isInterrupt_gen) {
+ UNPROTECT(1);
+ Rf_onintr();
+ }
+ Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error");
+ if (rcpp_isError_gen) {
+ SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen);
+ UNPROTECT(1);
+ Rf_error(CHAR(rcpp_msgSEXP_gen));
+ }
+ UNPROTECT(1);
+ return rcpp_result_gen;
+}
+// populate_env_string_imp
+Environment populate_env_string_imp(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload);
+static SEXP bindrcpp_populate_env_string_imp_try(SEXP envSEXP, SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::traits::input_parameter< Environment >::type env(envSEXP);
+ Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP);
+ Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_STRING >::type fun(funSEXP);
+ Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP);
+ rcpp_result_gen = Rcpp::wrap(populate_env_string_imp(env, names, fun, payload));
+ return rcpp_result_gen;
+END_RCPP_RETURN_ERROR
+}
+RcppExport SEXP bindrcpp_populate_env_string_imp(SEXP envSEXP, SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP) {
+ SEXP rcpp_result_gen;
+ {
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ rcpp_result_gen = PROTECT(bindrcpp_populate_env_string_imp_try(envSEXP, namesSEXP, funSEXP, payloadSEXP));
+ }
+ Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
+ if (rcpp_isInterrupt_gen) {
+ UNPROTECT(1);
+ Rf_onintr();
+ }
+ Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error");
+ if (rcpp_isError_gen) {
+ SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen);
+ UNPROTECT(1);
+ Rf_error(CHAR(rcpp_msgSEXP_gen));
+ }
+ UNPROTECT(1);
+ return rcpp_result_gen;
+}
+// create_env_symbol_imp
+Environment create_env_symbol_imp(CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload, Environment enclos);
+static SEXP bindrcpp_create_env_symbol_imp_try(SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP, SEXP enclosSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP);
+ Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_SYMBOL >::type fun(funSEXP);
+ Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP);
+ Rcpp::traits::input_parameter< Environment >::type enclos(enclosSEXP);
+ rcpp_result_gen = Rcpp::wrap(create_env_symbol_imp(names, fun, payload, enclos));
+ return rcpp_result_gen;
+END_RCPP_RETURN_ERROR
+}
+RcppExport SEXP bindrcpp_create_env_symbol_imp(SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP, SEXP enclosSEXP) {
+ SEXP rcpp_result_gen;
+ {
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ rcpp_result_gen = PROTECT(bindrcpp_create_env_symbol_imp_try(namesSEXP, funSEXP, payloadSEXP, enclosSEXP));
+ }
+ Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
+ if (rcpp_isInterrupt_gen) {
+ UNPROTECT(1);
+ Rf_onintr();
+ }
+ Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error");
+ if (rcpp_isError_gen) {
+ SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen);
+ UNPROTECT(1);
+ Rf_error(CHAR(rcpp_msgSEXP_gen));
+ }
+ UNPROTECT(1);
+ return rcpp_result_gen;
+}
+// populate_env_symbol_imp
+Environment populate_env_symbol_imp(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload);
+static SEXP bindrcpp_populate_env_symbol_imp_try(SEXP envSEXP, SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::traits::input_parameter< Environment >::type env(envSEXP);
+ Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP);
+ Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_SYMBOL >::type fun(funSEXP);
+ Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP);
+ rcpp_result_gen = Rcpp::wrap(populate_env_symbol_imp(env, names, fun, payload));
+ return rcpp_result_gen;
+END_RCPP_RETURN_ERROR
+}
+RcppExport SEXP bindrcpp_populate_env_symbol_imp(SEXP envSEXP, SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP) {
+ SEXP rcpp_result_gen;
+ {
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ rcpp_result_gen = PROTECT(bindrcpp_populate_env_symbol_imp_try(envSEXP, namesSEXP, funSEXP, payloadSEXP));
+ }
+ Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
+ if (rcpp_isInterrupt_gen) {
+ UNPROTECT(1);
+ Rf_onintr();
+ }
+ Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error");
+ if (rcpp_isError_gen) {
+ SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen);
+ UNPROTECT(1);
+ Rf_error(CHAR(rcpp_msgSEXP_gen));
+ }
+ UNPROTECT(1);
+ return rcpp_result_gen;
+}
+// init_logging
+void init_logging(const std::string& log_level);
+RcppExport SEXP bindrcpp_init_logging(SEXP log_levelSEXP) {
+BEGIN_RCPP
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< const std::string& >::type log_level(log_levelSEXP);
+ init_logging(log_level);
+ return R_NilValue;
+END_RCPP
+}
+// callback_string
+SEXP callback_string(Symbol name, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload);
+RcppExport SEXP bindrcpp_callback_string(SEXP nameSEXP, SEXP funSEXP, SEXP payloadSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::traits::input_parameter< Symbol >::type name(nameSEXP);
+ Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_STRING >::type fun(funSEXP);
+ Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP);
+ rcpp_result_gen = Rcpp::wrap(callback_string(name, fun, payload));
+ return rcpp_result_gen;
+END_RCPP
+}
+// callback_symbol
+SEXP callback_symbol(Symbol name, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload);
+RcppExport SEXP bindrcpp_callback_symbol(SEXP nameSEXP, SEXP funSEXP, SEXP payloadSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::traits::input_parameter< Symbol >::type name(nameSEXP);
+ Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_SYMBOL >::type fun(funSEXP);
+ Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP);
+ rcpp_result_gen = Rcpp::wrap(callback_symbol(name, fun, payload));
+ return rcpp_result_gen;
+END_RCPP
+}
+// do_test_create_environment
+List do_test_create_environment(CharacterVector names, String xform, Environment parent);
+RcppExport SEXP bindrcpp_do_test_create_environment(SEXP namesSEXP, SEXP xformSEXP, SEXP parentSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP);
+ Rcpp::traits::input_parameter< String >::type xform(xformSEXP);
+ Rcpp::traits::input_parameter< Environment >::type parent(parentSEXP);
+ rcpp_result_gen = Rcpp::wrap(do_test_create_environment(names, xform, parent));
+ return rcpp_result_gen;
+END_RCPP
+}
+
+// validate (ensure exported C++ functions exist before calling them)
+static int bindrcpp_RcppExport_validate(const char* sig) {
+ static std::set<std::string> signatures;
+ if (signatures.empty()) {
+ signatures.insert("Environment(*create_env_string)(CharacterVector,bindrcpp::GETTER_FUNC_STRING,bindrcpp::PAYLOAD,Environment)");
+ signatures.insert("Environment(*populate_env_string)(Environment,CharacterVector,bindrcpp::GETTER_FUNC_STRING,bindrcpp::PAYLOAD)");
+ signatures.insert("Environment(*create_env_symbol)(CharacterVector,bindrcpp::GETTER_FUNC_SYMBOL,bindrcpp::PAYLOAD,Environment)");
+ signatures.insert("Environment(*populate_env_symbol)(Environment,CharacterVector,bindrcpp::GETTER_FUNC_SYMBOL,bindrcpp::PAYLOAD)");
+ }
+ return signatures.find(sig) != signatures.end();
+}
+
+// registerCCallable (register entry points for exported C++ functions)
+RcppExport SEXP bindrcpp_RcppExport_registerCCallable() {
+ R_RegisterCCallable("bindrcpp", "bindrcpp_create_env_string", (DL_FUNC)bindrcpp_create_env_string_imp_try);
+ R_RegisterCCallable("bindrcpp", "bindrcpp_populate_env_string", (DL_FUNC)bindrcpp_populate_env_string_imp_try);
+ R_RegisterCCallable("bindrcpp", "bindrcpp_create_env_symbol", (DL_FUNC)bindrcpp_create_env_symbol_imp_try);
+ R_RegisterCCallable("bindrcpp", "bindrcpp_populate_env_symbol", (DL_FUNC)bindrcpp_populate_env_symbol_imp_try);
+ R_RegisterCCallable("bindrcpp", "bindrcpp_RcppExport_validate", (DL_FUNC)bindrcpp_RcppExport_validate);
+ return R_NilValue;
+}
+
+static const R_CallMethodDef CallEntries[] = {
+ {"bindrcpp_create_env_string_imp", (DL_FUNC) &bindrcpp_create_env_string_imp, 4},
+ {"bindrcpp_populate_env_string_imp", (DL_FUNC) &bindrcpp_populate_env_string_imp, 4},
+ {"bindrcpp_create_env_symbol_imp", (DL_FUNC) &bindrcpp_create_env_symbol_imp, 4},
+ {"bindrcpp_populate_env_symbol_imp", (DL_FUNC) &bindrcpp_populate_env_symbol_imp, 4},
+ {"bindrcpp_init_logging", (DL_FUNC) &bindrcpp_init_logging, 1},
+ {"bindrcpp_callback_string", (DL_FUNC) &bindrcpp_callback_string, 3},
+ {"bindrcpp_callback_symbol", (DL_FUNC) &bindrcpp_callback_symbol, 3},
+ {"bindrcpp_do_test_create_environment", (DL_FUNC) &bindrcpp_do_test_create_environment, 3},
+ {"bindrcpp_RcppExport_registerCCallable", (DL_FUNC) &bindrcpp_RcppExport_registerCCallable, 0},
+ {NULL, NULL, 0}
+};
+
+RcppExport void R_init_bindrcpp(DllInfo *dll) {
+ R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
+ R_useDynamicSymbols(dll, FALSE);
+}
diff --git a/src/create.cpp b/src/create.cpp
new file mode 100644
index 0000000..820145e
--- /dev/null
+++ b/src/create.cpp
@@ -0,0 +1,49 @@
+#include <Rcpp.h>
+
+#include <bindrcpp.h>
+
+#include <plogr.h>
+
+using namespace Rcpp;
+
+Environment pkg_env = Environment::namespace_env("bindrcpp");
+Function R_create_env("create_env", pkg_env);
+Function R_populate_env("populate_env", pkg_env);
+Function R_callback_string("callback_string", pkg_env);
+Function R_callback_symbol("callback_symbol", pkg_env);
+
+// [[Rcpp::interfaces(cpp)]]
+// [[Rcpp::export(create_env_string)]]
+Environment create_env_string_imp(CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload, Environment enclos) {
+ using namespace bindrcpp;
+
+ LOG_VERBOSE << payload.p;
+ return R_create_env(names, R_callback_string, fun, payload, _[".enclos"] = enclos);
+}
+
+// [[Rcpp::interfaces(cpp)]]
+// [[Rcpp::export(populate_env_string)]]
+Environment populate_env_string_imp(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload) {
+ using namespace bindrcpp;
+
+ LOG_VERBOSE << payload.p;
+ return R_populate_env(env, names, R_callback_string, fun, payload);
+}
+
+// [[Rcpp::interfaces(cpp)]]
+// [[Rcpp::export(create_env_symbol)]]
+Environment create_env_symbol_imp(CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload, Environment enclos) {
+ using namespace bindrcpp;
+
+ LOG_VERBOSE << payload.p;
+ return R_create_env(names, R_callback_symbol, fun, payload, _[".enclos"] = enclos);
+}
+
+// [[Rcpp::interfaces(cpp)]]
+// [[Rcpp::export(populate_env_symbol)]]
+Environment populate_env_symbol_imp(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload) {
+ using namespace bindrcpp;
+
+ LOG_VERBOSE << payload.p;
+ return R_populate_env(env, names, R_callback_symbol, fun, payload);
+}
diff --git a/src/plogr.cpp b/src/plogr.cpp
new file mode 100644
index 0000000..d725129
--- /dev/null
+++ b/src/plogr.cpp
@@ -0,0 +1,15 @@
+#include <plogr.h>
+
+//' Enable internal logging
+//'
+//' Log entries, depending on the log level, will be printed to the standard
+//' error stream.
+//'
+//' @param log_level A character value, one of "WARN", "INFO", "DEBUG", "VERB",
+//' or "NONE".
+//'
+//' @keywords internal
+// [[Rcpp::export]]
+void init_logging(const std::string& log_level) {
+ plog::init_r(log_level);
+}
diff --git a/src/test.cpp b/src/test.cpp
new file mode 100644
index 0000000..285dc74
--- /dev/null
+++ b/src/test.cpp
@@ -0,0 +1,91 @@
+#include <Rcpp.h>
+
+#include <bindrcpp.h>
+
+#include <plogr.h>
+
+#include <algorithm>
+#include <string>
+
+using namespace Rcpp;
+
+using namespace bindrcpp;
+
+// [[Rcpp::export(rng = FALSE)]]
+SEXP callback_string(Symbol name, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload) {
+ LOG_VERBOSE << type2name(name);
+ LOG_VERBOSE << payload.p;
+
+ String name_string = name.c_str();
+ name_string.set_encoding(CE_NATIVE);
+
+ return fun(name_string, payload);
+}
+
+// [[Rcpp::export(rng = FALSE)]]
+SEXP callback_symbol(Symbol name, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload) {
+ LOG_VERBOSE << type2name(name);
+ LOG_VERBOSE << payload.p;
+
+ return fun(name, payload);
+}
+
+class CallbackTester {
+ enum { MAGIC = 20161014 };
+ const int magic;
+
+public:
+ CallbackTester() : magic(MAGIC) { LOG_VERBOSE; }
+ ~CallbackTester() { LOG_VERBOSE; }
+
+ static SEXP tolower_static(const Rcpp::String& name, PAYLOAD payload) {
+ LOG_VERBOSE << payload.p;
+ CallbackTester* this_ = reinterpret_cast<CallbackTester*>(payload.p);
+ return this_->tolower(name);
+ }
+
+ static SEXP toupper_static(const Rcpp::String& name, PAYLOAD payload) {
+ LOG_VERBOSE << payload.p;
+ CallbackTester* this_ = reinterpret_cast<CallbackTester*>(payload.p);
+ return this_->toupper(name);
+ }
+
+private:
+ SEXP tolower(Rcpp::String name) {
+ LOG_VERBOSE << magic;
+ if (magic != MAGIC)
+ stop("payload lost");
+ std::string name_string = name;
+ std::transform(name_string.begin(), name_string.end(), name_string.begin(), ::tolower);
+ return CharacterVector(name_string);
+ }
+
+ SEXP toupper(Rcpp::String name) {
+ LOG_VERBOSE << magic;
+ if (magic != MAGIC)
+ stop("payload lost");
+ std::string name_string = name;
+ std::transform(name_string.begin(), name_string.end(), name_string.begin(), ::toupper);
+ return CharacterVector(name_string);
+ }
+};
+
+// [[Rcpp::export]]
+List do_test_create_environment(CharacterVector names, String xform, Environment parent) {
+ CallbackTester* pc = new CallbackTester;
+
+ List ret = List::create(_["callback"] = XPtr<CallbackTester>(pc));
+
+ if (xform == "tolower") {
+ ret["env"] = bindrcpp::create_env_string(
+ names, &CallbackTester::tolower_static, PAYLOAD(pc), parent);
+ }
+ else if (xform == "toupper") {
+ ret["env"] = bindrcpp::create_env_string(
+ names, &CallbackTester::toupper_static, PAYLOAD(pc), parent);
+ }
+ else
+ stop("unknown xform");
+
+ return ret;
+}
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..6354124
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(bindrcpp)
+
+test_check("bindrcpp")
diff --git a/tests/testthat/test-create.R b/tests/testthat/test-create.R
new file mode 100644
index 0000000..4f18f5a
--- /dev/null
+++ b/tests/testthat/test-create.R
@@ -0,0 +1,28 @@
+context("create")
+
+test_that("cpp_create_environment()", {
+ env_cb <- cpp_create_environment(letters, "toupper")
+ env <- env_cb$env
+ expect_equal(env$a, "A")
+ expect_equal(env$x, "X")
+ expect_null(env$X)
+ expect_equal(length(ls(env)), length(letters))
+ expect_error(env$a <- "a", "read-only")
+})
+
+test_that("cpp_create_environment() with inheritance", {
+ env_cb <- cpp_create_environment(letters, "toupper")
+ env <- env_cb$env
+ env2_cb <- cpp_create_environment(LETTERS, "tolower", parent = env)
+ env2 <- env2_cb$env
+ expect_equal(get("a", env2), "A")
+ expect_equal(get("x", env2), "X")
+ expect_null(env2$a)
+ expect_null(env2$x)
+ expect_equal(env2$B, "b")
+ expect_equal(env2$Y, "y")
+ expect_equal(length(ls(env2)), length(letters))
+ expect_error(env2$B <- "B", "read-only")
+ expect_error(env2$a <- "a", NA)
+ expect_equal(get("a", env2), "a")
+})
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-bindrcpp.git
More information about the debian-med-commit
mailing list