Permalink
Browse files

Rcpp attributes and improvements to load_all build environment

  • Loading branch information...
1 parent 3390aec commit 1d935716f6d11219d0f035f8583f09e323f20194 @jjallaire jjallaire committed Nov 3, 2012
View
@@ -15,13 +15,15 @@ Imports:
RCurl,
utils,
tools,
+ methods,
memoise,
whisker,
evaluate
Suggests:
testthat,
roxygen2,
- BiocInstaller
+ BiocInstaller,
+ Rcpp (>= 0.10.0)
License: GPL (>= 2)
Collate:
'bash.r'
@@ -78,3 +80,4 @@ Collate:
'run-example.r'
'dev-help.r'
'check_devtools.r'
+ 'rcpp-attributes.r'
View
4 NEWS
@@ -1,6 +1,10 @@
devtools 0.8.0.99
-----------------
+NEW FEATURES
+
+* Rcpp attributes are now automatically compiled during build
+
BUG FIXES
* Reloading a package that requires a forced-unload of the namespace now works.
View
@@ -15,6 +15,8 @@ build <- function(pkg = ".", path = NULL, binary = FALSE) {
if (is.null(path)) {
path <- dirname(pkg$path)
}
+
+ compile_rcpp_attributes(pkg)
if (binary) {
cmd <- paste("CMD INSTALL ", shQuote(pkg$path), " --build", sep = "")
View
@@ -29,15 +29,19 @@ compile_dll <- function(pkg = ".") {
if (!dir.exists(srcdir))
return(invisible())
+ # Compile Rcpp attributes if necessary
+ compile_rcpp_attributes(pkg)
+
# Check that there are source files to compile
srcfiles <- dir(srcdir, pattern = "\\.(c|cpp|f)$")
if (length(srcfiles) == 0)
return(invisible())
-
- # Compile the DLL
- srcfiles <- paste(srcfiles, collapse = " ")
- R(paste("CMD SHLIB", "-o", basename(dll_name(pkg)), srcfiles),
- path = srcdir)
+ # Compile the DLL using an approriately constructed build environment
+ with_env(build_env_vars(pkg), {
+ srcfiles <- paste(srcfiles, collapse = " ")
+ R(paste("CMD SHLIB", "-o", basename(dll_name(pkg)), srcfiles),
+ path = srcdir)
+ })
invisible(dll_name(pkg))
}
@@ -70,3 +74,48 @@ dll_name <- function(pkg = ".") {
file.path(pkg$path, "src", name)
}
+
+# Get the build environment variables for a package:
+# - CLINK_CPPFLAGS with include paths (inst/include and LinkingTo)
+# - PKG_LIBS for Rcpp if it's a dependency
+# Returns a named list of variables that can be passed to set_env
+build_env_vars <- function(pkg) {
+
+ # Environment variables to set for the build
+ buildEnv <- list()
+
+ # Include directories - start with the package inst/include directory then
+ # add any packages found in LinkingTo
+ includeDirs <- '-I"../inst/include"'
+ linkingTo <- pkg_linking_to(pkg)
+ includeDirs <- c(includeDirs, linking_to_includes(linkingTo))
+ buildEnv$CLINK_CPPFLAGS <- paste(includeDirs, collapse = " ")
+
+ # If the package depends on Rcpp then set PKG_LIBS as appropirate
+ if (links_to_rcpp(pkg)) {
+ if (!require("Rcpp", quietly = TRUE))
+ stop("Rcpp required for building this package")
+ buildEnv$PKG_LIBS <- Rcpp:::RcppLdFlags()
+ }
+
+ # Return variables
+ buildEnv
+}
+
+
+# Get the LinkingTo field of a package as a character vector
+pkg_linking_to <- function(pkg) {
+ parse_deps(pkg$linkingto)$name
+}
+
+# Build a list of include directories from a list of packages
+linking_to_includes <- function(linkingTo) {
+ includes <- character()
+ for (package in linkingTo) {
+ pkgPath <- find.package(package, NULL, quiet=TRUE)
+ pkgIncludes <- paste0('-I"', pkgPath, .Platform$file.sep, 'include"')
+ includes <- c(includes, pkgIncludes)
+ }
+ includes
+}
+
View
@@ -118,12 +118,15 @@ load_all <- function(pkg = ".", reset = FALSE, recompile = FALSE,
register_s3(pkg)
out$dll <- load_dll(pkg)
+ run_onload(pkg)
+
+ # Invoke namespace load actions
+ run_ns_load_actions(pkg)
+
# Set up the exports in the namespace metadata (this must happen after
# the objects are loaded)
setup_ns_exports(pkg, export_all)
-
- run_onload(pkg)
-
+
# Set up the package environment ------------------------------------
# Create the package environment if needed
if (!is_attached(pkg)) attach_ns(pkg)
View
@@ -12,6 +12,16 @@ attach_ns <- function(pkg = ".") {
attr(pkgenv, "path") <- getNamespaceInfo(nsenv, "path")
}
+# Invoke namespace load actions. According to the documentation for setLoadActions
+# these actions should be called at the end of processing of S4 metadata, after
+# dynamically linking any libraries, the call to .onLoad(), if any, and caching
+# method and class definitions, but before the namespace is sealed
+run_ns_load_actions <- function(pkg = ".") {
+ nsenv <- ns_env(pkg)
+ actions <- methods::getLoadActions(nsenv)
+ for (action in actions)
+ action(nsenv)
+}
# Copy over the objects from the namespace env to the package env
export_ns <- function(pkg = ".") {
View
@@ -0,0 +1,21 @@
+
+# Call the Rcpp::compileAttributes function for a package (only do so if the
+# package links to Rcpp and a recent enough version of Rcpp in installed).
+compile_rcpp_attributes <- function(pkg) {
+
+ # Only scan for attributes in packages explicitly linking to Rcpp
+ if (links_to_rcpp(pkg)) {
+
+ if (!require("Rcpp", quietly = TRUE))
+ stop("Rcpp required for building this package")
+
+ # Only compile attributes if we know we have the function available
+ if (utils::packageVersion("Rcpp") >= "0.10.0")
+ compileAttributes(pkg$path)
+ }
+}
+
+# Does this package have a compilation dependency on Rcpp?
+links_to_rcpp <- function(pkg) {
+ "Rcpp" %in% pkg_linking_to(pkg)
+}
View
@@ -40,8 +40,12 @@ is.named <- function(x) {
set_env <- function(envs) {
stopifnot(is.named(envs))
- old <- Sys.getenv(names(envs), names = TRUE)
- do.call("Sys.setenv", as.list(envs))
+ old <- Sys.getenv(names(envs), names = TRUE, unset = NA)
+
+ set <- !is.na(envs)
+ if (any(set)) do.call("Sys.setenv", as.list(envs[set]))
+ if (any(!set)) Sys.unsetenv(names(envs)[!set])
+
invisible(old)
}
#' @rdname with_something
@@ -0,0 +1,10 @@
+Package: dllrcpp
+Title: Test package for compiling DLLs that link to Rcpp
+License: GPL-2
+Description:
+Author: Hadley <h.wickham@gmail.com>
+Maintainer: Hadley <h.wickham@gmail.com>
+Version: 0.1
+Collate: a.r
+Depends: Rcpp (>= 0.10.0)
+LinkingTo: Rcpp
@@ -0,0 +1,3 @@
+useDynLib(dllrcpp)
+export(rcpp_hello_world)
+export(rcpp_test_attributes)
@@ -0,0 +1 @@
+RcppExports.R
@@ -0,0 +1,5 @@
+
+rcpp_hello_world <- function(){
+ .Call( "rcpp_hello_world", PACKAGE = "dllrcpp" )
+}
+
@@ -0,0 +1 @@
+RcppExports.cpp
@@ -0,0 +1,27 @@
+## Use the R_HOME indirection to support installations of multiple R version
+PKG_LIBS = `$(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()"`
+
+## As an alternative, one can also add this code in a file 'configure'
+##
+## PKG_LIBS=`${R_HOME}/bin/Rscript -e "Rcpp:::LdFlags()"`
+##
+## sed -e "s|@PKG_LIBS@|${PKG_LIBS}|" \
+## src/Makevars.in > src/Makevars
+##
+## which together with the following file 'src/Makevars.in'
+##
+## PKG_LIBS = @PKG_LIBS@
+##
+## can be used to create src/Makevars dynamically. This scheme is more
+## powerful and can be expanded to also check for and link with other
+## libraries. It should be complemented by a file 'cleanup'
+##
+## rm src/Makevars
+##
+## which removes the autogenerated file src/Makevars.
+##
+## Of course, autoconf can also be used to write configure files. This is
+## done by a number of packages, but recommended only for more advanced users
+## comfortable with autoconf and its related tools.
+
+
@@ -0,0 +1,3 @@
+
+## Use the R_HOME indirection to support installations of multiple R version
+PKG_LIBS = $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" -e "Rcpp:::LdFlags()")
@@ -0,0 +1,16 @@
+#include "rcpp_hello_world.h"
+
+SEXP rcpp_hello_world(){
+ using namespace Rcpp ;
+
+ CharacterVector x = CharacterVector::create( "foo", "bar" ) ;
+ NumericVector y = NumericVector::create( 0.0, 1.0 ) ;
+ List z = List::create( x, y ) ;
+
+ return z ;
+}
+
+// [[Rcpp::export]]
+bool rcpp_test_attributes() {
+ return true;
+}
@@ -0,0 +1,19 @@
+#ifndef _dllrcpp_RCPP_HELLO_WORLD_H
+#define _dllrcpp_RCPP_HELLO_WORLD_H
+
+#include <Rcpp.h>
+
+/*
+ * note : RcppExport is an alias to `extern "C"` defined by Rcpp.
+ *
+ * It gives C calling convention to the rcpp_hello_world function so that
+ * it can be called from .Call in R. Otherwise, the C++ compiler mangles the
+ * name of the function and .Call can't find it.
+ *
+ * It is only useful to use RcppExport when the function is intended to be called
+ * by .Call. See the thread http://thread.gmane.org/gmane.comp.lang.r.rcpp/649/focus=672
+ * on Rcpp-devel for a misuse of RcppExport
+ */
+RcppExport SEXP rcpp_hello_world() ;
+
+#endif
View
@@ -95,3 +95,23 @@ test_that("Specific functions from DLLs listed in NAMESPACE can be called", {
# Clean out compiled objects
clean_dll("dll-load")
})
+
+
+test_that("load_all() can compile and load DLLs linked to Rcpp", {
+
+ clean_dll("dll-rcpp")
+
+ load_all("dll-rcpp", reset = TRUE)
+
+ # Check that it's loaded properly by calling the hello world function
+ # which returns a list
+ expect_true(is.list(rcpp_hello_world()))
+
+ # Check whether attribute compilation occurred and that exported
+ # names are available from load_all
+ expect_true(rcpp_test_attributes())
+
+ # Unload and clean out compiled objects
+ unload("dll-rcpp")
+ clean_dll("dll-rcpp")
+})
View
@@ -0,0 +1,16 @@
+
+context("With")
+
+test_that("with_env sets and unsets variables", {
+
+ # Make sure the "set_env_testvar" environment var is not set.
+ Sys.unsetenv("set_env_testvar")
+ expect_false("set_env_testvar" %in% names(Sys.getenv()))
+
+ # Use with_env (which calls set_env) to temporarily set it to 1
+ expect_identical("1", with_env(c("set_env_testvar" = 1),
+ Sys.getenv("set_env_testvar")))
+
+ # set_env_testvar shouldn't stay in the list of environment vars
+ expect_false("set_env_testvar" %in% names(Sys.getenv()))
+})

0 comments on commit 1d93571

Please sign in to comment.