Merge pull request #694 from RcppCore/feature/register-native-routines

Register native routines automatically within compileAttributes

Author: jjallaire

ChangeLog

@@ -1,3 +1,10 @@
+2017-05-16  JJ Allaire  <[email protected]>
+
+        * R/Attributes.R: Automatically generate native routine registrations.
+        * src/attributes.cpp: Automatically generate native routine registrations.
+        * R/Rcpp.package.skeleton.R: Don't generate native routines when creating
+        a package using attributes.
+
 2017-05-09  Dirk Eddelbuettel  <[email protected]>
 
         * R/Rcpp.package.skeleton.R (Rcpp.package.skeleton): Under R 3.4.0, run

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Rcpp
 Title: Seamless R and C++ Integration
-Version: 0.12.10.4
+Version: 0.12.10.5
 Date: 2017-05-07
 Author: Dirk Eddelbuettel, Romain Francois, JJ Allaire, Kevin Ushey, Qiang Kou,
  Nathan Russell, Douglas Bates and John Chambers

R/Attributes.R

@@ -404,6 +404,13 @@ compileAttributes <- function(pkgdir = ".", verbose = getOption("verbose")) {
     depends <- unique(.splitDepends(depends))
     depends <- depends[depends != "R"]
 
+    # check the NAMESPACE file to see if dynamic registration is enabled
+    namespaceFile <- file.path(pkgdir, "NAMESPACE")
+    if (!file.exists(namespaceFile))
+        stop("pkgdir must refer to the directory containing an R package")
+    pkgNamespace <- readLines(namespaceFile, warn = FALSE)
+    registration <- any(grepl("^\\s*useDynLib.*\\.registration\\s*=\\s*TRUE.*$", pkgNamespace))
+
     # determine source directory
     srcDir <- file.path(pkgdir, "src")
     if (!file.exists(srcDir))
@@ -415,7 +422,7 @@ compileAttributes <- function(pkgdir = ".", verbose = getOption("verbose")) {
         dir.create(rDir)
 
     # get a list of all source files
-    cppFiles <- list.files(srcDir, pattern = "\\.((c(c|pp))|(h(pp)?))$")
+    cppFiles <- list.files(srcDir, pattern = "\\.((c(c|pp)?)|(h(pp)?))$")
 
     # derive base names (will be used for modules)
     cppFileBasenames <- tools::file_path_sans_ext(cppFiles)
@@ -449,7 +456,7 @@ compileAttributes <- function(pkgdir = ".", verbose = getOption("verbose")) {
 
     # generate exports
     invisible(.Call("compileAttributes", PACKAGE="Rcpp",
-                    pkgdir, pkgname, depends, cppFiles, cppFileBasenames,
+                    pkgdir, pkgname, depends, registration, cppFiles, cppFileBasenames,
                     includes, verbose, .Platform))
 }
 
@@ -1147,3 +1154,43 @@ sourceCppFunction <- function(func, isVoid, dll, symbol) {
     as.character(token)
 }
 
+.extraRoutineRegistrations <- function(routines) {
+
+    declarations = character()
+    call_entries = character()
+
+    # if we are running R 3.4 or higher we can use an internal utility function
+    # to automatically discover additional native routines that require registration
+    if (getRversion() >= "3.4") {
+
+        # get the generated code from R
+        con <- textConnection(object = NULL, open = "w")
+        on.exit(close(con), add = TRUE)
+        tools::package_native_routine_registration_skeleton(
+            dir = ".",
+            con = con,
+            character_only = FALSE
+        )
+        code <- textConnectionValue(con)
+
+        # look for lines containing call entries
+        matches <- regexec('^\\s+\\{"([^"]+)",.*$', code)
+        matches <- regmatches(code, matches)
+        matches <- Filter(x = matches, function(x) {
+            length(x) > 0
+        })
+        for (match in matches) {
+            routine <- match[[2]]
+            if (!routine %in% routines) {
+                declaration <- grep(sprintf("^extern .* %s\\(.*$", routine), code,
+                                    value = TRUE)
+                declarations <- c(declarations, sub("^extern", "RcppExport", declaration))
+                call_entries <- c(call_entries, match[[1]])
+            }
+        }
+    }
+
+    # return extra declaratiosn and call entries
+    list(declarations = declarations,
+         call_entries = call_entries)
+}

R/Rcpp.package.skeleton.R

@@ -185,13 +185,17 @@ Rcpp.package.skeleton <- function(name = "anRpackage", list = character(),
         message(" >> copied the example module file ")
     }
 
-    if (getRversion() >= "3.4.0") {
-        con <- file(file.path(src, "init.c"), "wt")
-        tools::package_native_routine_registration_skeleton(root, con=con)
-        close(con)
-        message(" >> created init.c for package registration")
-    } else {
-        message(" >> R version older than 3.4.0 detected, so NO file init.c created.")
+    # generate native routines if we aren't using attributes (which already generate
+    # them automatically) and we have at least R 3.4
+    if (!attributes) {
+        if (getRversion() >= "3.4.0") {
+            con <- file(file.path(src, "init.c"), "wt")
+            tools::package_native_routine_registration_skeleton(root, con=con)
+            close(con)
+            message(" >> created init.c for package registration")
+        } else {
+            message(" >> R version older than 3.4.0 detected, so NO file init.c created.")
+        }
     }
 
     lines <- readLines(package.doc <- file.path( root, "man", sprintf("%s-package.Rd", name)))

inst/NEWS.Rd

@@ -40,6 +40,7 @@
     }
     \item Changes in Rcpp Attributes:
     \itemize{
+      \item Automatically generate native routine registrations.
       \item The plugins for C++11, C++14, C++17 now set the values R 3.4.0 or
       later expects; a plugin for C++98 was added (Dirk in \ghpr{684} addressing
       \ghit{683}).