Binary files /tmp/tmpod_ZGm/wHF_pEKvBM/r-cran-inline-0.3.16/build/partial.rdb and /tmp/tmpod_ZGm/A1gx638q90/r-cran-inline-0.3.17/build/partial.rdb differ diff -Nru r-cran-inline-0.3.16/debian/changelog r-cran-inline-0.3.17/debian/changelog --- r-cran-inline-0.3.16/debian/changelog 2020-09-06 16:17:27.000000000 +0000 +++ r-cran-inline-0.3.17/debian/changelog 2020-12-01 00:56:03.000000000 +0000 @@ -1,3 +1,12 @@ +r-cran-inline (0.3.17-1) unstable; urgency=medium + + * New upstream release + + * debian/control: Set Build-Depends: to current R version + * debian/control: Switch to virtual debhelper-compat (= 11) + + -- Dirk Eddelbuettel Mon, 30 Nov 2020 18:56:03 -0600 + r-cran-inline (0.3.16-1) unstable; urgency=medium * New upstream release diff -Nru r-cran-inline-0.3.16/debian/control r-cran-inline-0.3.17/debian/control --- r-cran-inline-0.3.16/debian/control 2020-09-06 16:17:04.000000000 +0000 +++ r-cran-inline-0.3.17/debian/control 2020-12-01 00:55:45.000000000 +0000 @@ -2,7 +2,7 @@ Section: gnu-r Priority: optional Maintainer: Dirk Eddelbuettel -Build-Depends: debhelper-compat (= 10), r-base-dev (>= 4.0.2), dh-r +Build-Depends: debhelper-compat (= 11), r-base-dev (>= 4.0.3), dh-r Standards-Version: 4.5.0 Vcs-Browser: https://salsa.debian.org/edd/r-cran-inline Vcs-Git: https://salsa.debian.org/edd/r-cran-inline.git @@ -10,7 +10,7 @@ Package: r-cran-inline Architecture: all -Depends: ${misc:Depends}, ${R:Depends}, +Depends: ${misc:Depends}, ${R:Depends} Description: GNU R package to inline C, C++, Fortran functions from R This package provides functionality to dynamically define R functions and S4 methods with in-lined C, C++ or Fortran code supporting .C and .Call calling diff -Nru r-cran-inline-0.3.16/DESCRIPTION r-cran-inline-0.3.17/DESCRIPTION --- r-cran-inline-0.3.16/DESCRIPTION 2020-09-06 15:40:02.000000000 +0000 +++ r-cran-inline-0.3.17/DESCRIPTION 2020-12-01 00:50:17.000000000 +0000 @@ -1,13 +1,12 @@ Package: inline -Version: 0.3.16 -Date: 2020-09-06 +Version: 0.3.17 +Date: 2020-11-30 Title: Functions to Inline C, C++, Fortran Function Calls from R Author: Oleg Sklyar, Duncan Murdoch, Mike Smith, Dirk Eddelbuettel, - Romain Francois, Karline Soetaert + Romain Francois, Karline Soetaert, Johannes Ranke Maintainer: Dirk Eddelbuettel -Depends: R (>= 2.4.0) Imports: methods -Suggests: Rcpp (>= 0.11.0) +Suggests: Rcpp (>= 0.11.0), tinytest Description: Functionality to dynamically define R functions and S4 methods with 'inlined' C, C++ or Fortran code supporting the .C and .Call calling conventions. @@ -16,6 +15,6 @@ LazyLoad: yes BugReports: https://github.com/eddelbuettel/inline/issues NeedsCompilation: no -Packaged: 2020-09-06 15:07:35.725083 UTC; edd +Packaged: 2020-11-30 21:07:24 UTC; edd Repository: CRAN -Date/Publication: 2020-09-06 15:40:02 UTC +Date/Publication: 2020-12-01 00:50:17 UTC diff -Nru r-cran-inline-0.3.16/inst/NEWS.Rd r-cran-inline-0.3.17/inst/NEWS.Rd --- r-cran-inline-0.3.16/inst/NEWS.Rd 2020-09-03 16:31:37.000000000 +0000 +++ r-cran-inline-0.3.17/inst/NEWS.Rd 2020-11-30 20:59:10.000000000 +0000 @@ -3,7 +3,22 @@ \newcommand{\ghpr}{\href{https://github.com/eddelbuettel/inline/pull/#1}{##1}} \newcommand{\ghit}{\href{https://github.com/eddelbuettel/inline/issues/#1}{##1}} -\section{Changes in inline version 0.3.16 (2020-09-xx)}{ +\section{Changes in inline version 0.3.17 (2020-11-30)}{ + \itemize{ + \item Unit testing is now supported via \pkg{tinytest} (Johannes in + \ghpr{15} addressing \ghit{14}). + \item CI was updated to use focal and run.sh from r-ci on Travis and + GitHub Actions (Dirk) + \item The writing and reading of compiled code was refactored and + extended (Johannes in \ghpr{16} fixing \ghit{13}). + \item Some minor problems related to CRAN checks and tests were corrected + (Johannes and Dirk in \ghpr{17}, Johannes in \ghpr{18}, \ghpr{19}, \ghpr{20}). + \item Small stylistic updates have been applied to some R and Rd + files (Dirk). + } +} + +\section{Changes in inline version 0.3.16 (2020-09-06)}{ \itemize{ \item Maintenance updates to README.md standardizing badges (Dirk). \item Maintenance update to Travis CI setup (Dirk). diff -Nru r-cran-inline-0.3.16/inst/tinytest/test_cfunction.R r-cran-inline-0.3.17/inst/tinytest/test_cfunction.R --- r-cran-inline-0.3.16/inst/tinytest/test_cfunction.R 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-inline-0.3.17/inst/tinytest/test_cfunction.R 2020-11-26 23:08:36.000000000 +0000 @@ -0,0 +1,115 @@ +library(inline) + +n <- 10L +x <- 1:10 + +## A simple Fortran example - n and x: assumed-size vector +code <- " + integer i + do 1 i=1, n(1) + 1 x(i) = x(i)**3 +" + +cubefn <- cfunction(signature(n = "integer", x = "numeric"), code, + convention = ".Fortran") + +res_cube <- list( + n = 10L, + x = c(1, 8, 27, 64, 125, 216, 343, 512, 729, 1000)) + +res_1 <- cubefn(n, x) +expect_identical(res_cube, res_1) + +cubefn_named <- cfunction(signature(n = "integer", x = "numeric"), code, + convention = ".Fortran", name = "cubefn") +expect_identical(cubefn_named(n, x), res_1) + +expect_true(grepl("cubefn", cubefn_named@code)) + +## Same Fortran example - now n is one number +code2 <- " + integer i + do 1 i=1, n + 1 x(i) = x(i)**3 +" +cubefn2 <- cfunction(signature(n = "integer", x = "numeric"), + implicit = "none", dim = c("", "(*)"), code2, convention=".Fortran") + +res_2 <- cubefn2(n, x) +expect_identical(res_2, res_cube) + +## Same in F95, now x is fixed-size vector (length = n) +code3 <- "x = x*x*x" +cubefn3 <- cfunction(signature(n = "integer", x = "numeric"), + implicit = "none", dim = c("", "(n)"), code3, language="F95") +res_3 <- cubefn3(n, x) +expect_identical(res_3, res_cube) + +## Same example in C +code4 <- " + int i; + for (i = 0; i < *n; i++) + x[i] = x[i]*x[i]*x[i]; +" +cubefn4 <- cfunction(signature(n = "integer", x = "numeric"), code4, + language = "C", convention = ".C") +res_4 <- cubefn4(n, x) +expect_identical(res_4, res_cube) + + + ## use of a module in F95 +modct <- "module modcts +double precision, parameter :: pi = 3.14159265358979 +double precision, parameter :: e = 2.71828182845905 +end" + +getconstants <- "x(1) = pi +x(2) = e" + +cgetcts <- cfunction(body = getconstants, module = "modcts", implicit = "none", + includes = modct, sig = c(x = "double"), dim = c("(2)"), language = "F95") + +res_5 <- cgetcts(x = c(1, 2)) +expect_equal(res_5$x, c(pi, exp(1)), tolerance = 1e-7) + +## Use of .C convention with C code +## Defining two functions, one of which calls the other +sigSq <- signature(n = "integer", x = "numeric") +codeSq <- " + for (int i=0; i < *n; i++) { + x[i] = x[i]*x[i]; + }" +sigQd <- signature(n = "integer", x = "numeric") +codeQd <- " + squarefn(n, x); + squarefn(n, x); +" + +fns <- cfunction( + sig = list(squarefn = sigSq, quadfn = sigQd), + body = list(codeSq, codeQd), + convention = ".C") + +res_square <- list( + n = 10L, + x = c(1, 4, 9, 16, 25, 36, 49, 64, 81, 100)) + +res_quad <- list( + n = 10L, + x = c(1, 16, 81, 256, 625, 1296, 2401, 4096, 6561, 10000)) + +res_6_square <- fns[["squarefn"]](n, x) +res_6_quad <- fns[["quadfn"]](n, x) + +expect_identical(res_6_square, res_square) +expect_identical(res_6_quad, res_quad) + +## Alternative declaration using 'setCMethod' +setCMethod(c("squarefn", "quadfn"), list(sigSq, sigQd), + list(codeSq, codeQd), convention = ".C") + +res_7_square <- squarefn(n, x) +res_7_quad <- quadfn(n, x) + +expect_identical(res_7_square, res_square) +expect_identical(res_7_quad, res_quad) diff -Nru r-cran-inline-0.3.16/inst/tinytest/test_cxxfunction.R r-cran-inline-0.3.17/inst/tinytest/test_cxxfunction.R --- r-cran-inline-0.3.16/inst/tinytest/test_cxxfunction.R 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-inline-0.3.17/inst/tinytest/test_cxxfunction.R 2020-11-27 21:51:06.000000000 +0000 @@ -0,0 +1,22 @@ + +library(inline) + +## basic examples from manual page +fx <- cxxfunction(signature(x = "integer", y = "numeric"), + "return ScalarReal(INTEGER(x)[0] * REAL(y)[0]);") +expect_true(is(fx, "CFunc")) +expect_equal(fx(2L, 5), 10) + +if (!requireNamespace("Rcpp", quietly=TRUE)) exit_file("Need Rcpp for remainder of tests") + +fx <- cxxfunction(signature(x = "integer", y = "numeric"), + "return wrap(as(x) * as(y));", + plugin = "Rcpp") +expect_true(is(fx, "CFunc")) +expect_equal(fx(2L, 5), 10) + +## equivalent shorter form using rcpp() +fx <- rcpp(signature(x = "integer", y = "numeric"), + "return wrap(as(x) * as(y));") +expect_true(is(fx, "CFunc")) +expect_equal(fx(2L, 5), 10) diff -Nru r-cran-inline-0.3.16/inst/tinytest/test_utilities.R r-cran-inline-0.3.17/inst/tinytest/test_utilities.R --- r-cran-inline-0.3.16/inst/tinytest/test_utilities.R 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-inline-0.3.17/inst/tinytest/test_utilities.R 2020-11-30 03:50:28.000000000 +0000 @@ -0,0 +1,81 @@ +library(inline) + +code <- " + int i; + for (i = 0; i < *n; i++) + x[i] = x[i]*x[i]; +" +quadfn <- cfunction(signature(n = "integer", x = "numeric"), code, + language = "C", convention = ".C") + +res_known <- list(n = 5L, x = c(1, 4, 9, 16, 25)) +expect_identical(quadfn(5, 1:5), res_known) + +# Saving and restoring the function removes the pointer to the DLL +quadfn_path <- file.path(tempdir(), "quadfn.rda") +save(quadfn, file = quadfn_path) +rm(quadfn) +load(quadfn_path) +expect_error(quadfn(5, 1:5), "NULL value passed as symbol address") + +# The DLL is removed by garbage collection +gc() +expect_false(file.exists(environment(quadfn)$libLFile)) + +# So we recreate the function and move the DLL to a user defined location +quadfn <- cfunction(signature(n = "integer", x = "numeric"), code, + language = "C", convention = ".C") +moveDLL(quadfn, name = "testname", directory = tempdir()) +expect_identical(quadfn(5, 1:5), res_known) + +expect_error( + moveDLL(quadfn, name = "testname", directory = tempdir()), + "DLL .* in use") + +expect_error( + moveDLL(quadfn, name = "testname", directory = tempdir(), unload = TRUE), + "Failed to copy") + +expect_error( + moveDLL(quadfn, name = "testname", directory = tempdir(), unload = TRUE, + overwrite = TRUE), + "file can not be copied both 'from' and 'to'") + +# We recreate the function to have a new temporary DLL name +quadfn <- cfunction(signature(n = "integer", x = "numeric"), code, + language = "C", convention = ".C") + +expect_identical(quadfn(5, 1:5), res_known) + +# Now the new path is taken and loaded, but we can unload and overwrite +moveDLL(quadfn, name = "testname", directory = tempdir(), unload = TRUE, + overwrite = TRUE) +expect_identical(quadfn(5, 1:5), res_known) + +# Now the DLL is not removed by garbage collection +gc() +expect_true(file.exists(environment(quadfn)$libLFile)) +# But we still get the pointer removed when saving and restoring +save(quadfn, file = quadfn_path) +rm(quadfn) +load(quadfn_path) +expect_error(quadfn(5, 1:5), "NULL value passed as symbol address") + +# So we recreate the function again, move the DLL, write and restore +quadfn <- cfunction(signature(n = "integer", x = "numeric"), code, + language = "C", convention = ".C") +moveDLL(quadfn, name = "testname", directory = tempdir(), unload = TRUE, + overwrite = TRUE) +writeCFunc(quadfn, quadfn_path) +quadfn_reloaded <- readCFunc(quadfn_path) + +# Create a function with a user defined function name in the source code, +# save and restore +quadfn_named <- cfunction(signature(n = "integer", x = "numeric"), code, + language = "C", convention = ".C", name = "quadfn") +moveDLL(quadfn_named, name = "quadfn_dll", directory = tempdir(), unload = TRUE, + overwrite = TRUE) +writeCFunc(quadfn_named, quadfn_path) +quadfn_named_reloaded <- readCFunc(quadfn_path) +expect_identical(quadfn_named_reloaded(5, 1:5), res_known) +expect_true(grepl("quadfn", quadfn_named_reloaded@code)) diff -Nru r-cran-inline-0.3.16/man/cfunction.Rd r-cran-inline-0.3.17/man/cfunction.Rd --- r-cran-inline-0.3.16/man/cfunction.Rd 2015-04-11 12:43:10.000000000 +0000 +++ r-cran-inline-0.3.17/man/cfunction.Rd 2020-11-26 23:08:36.000000000 +0000 @@ -8,24 +8,24 @@ \title{ Inline C, C++, Fortran function calls from R } \description{ - Functionality to dynamically define R functions and S4 methods with in-lined C, + Functionality to dynamically define R functions and S4 methods with in-lined C, C++ or Fortran code supporting .C and .Call calling conventions. } \usage{ cfunction(sig=character(), body=character(), includes=character(), - otherdefs=character(), + otherdefs=character(), language=c("C++", "C", "Fortran", "F95", "ObjectiveC", "ObjectiveC++"), - verbose=FALSE, + verbose=FALSE, convention=c(".Call", ".C", ".Fortran"), Rcpp=FALSE, cppargs=character(), cxxargs=character(), libargs=character(), - dim=NULL, implicit=NULL, module=NULL) + dim=NULL, implicit=NULL, module=NULL, name=NULL) ## S4 methods for signatures # f='character', sig='list', body='list' # f='character', sig='character', body='character' - + setCMethod(f, sig, body, ...) ## Further arguments: @@ -37,38 +37,41 @@ \item{f}{A single character value if \code{sig} and \code{body} are character vectors or a character vector of the same length and the length of \code{sig} or \code{body} with the name(s) of methods to create.} - + \item{sig}{A match of formal argument names for the function with the - character-string names of corresponding classes. Alternatively, - a list of such character vectors. } + character-string names of corresponding classes. Alternatively, + a named list of such character vectors. The names of the list elements will + be used as function names (see example). If \code{sig} is not a list, + the function name used in the code can be specified by the \code{name} + argument. } \item{body}{ A character vector with C, C++ or Fortran code omitting function - declaration (only the body, i.e. in case of C starting after the function - opening curly bracket and ending before the closing curly bracket, + declaration (only the body, i.e. in case of C starting after the function + opening curly bracket and ending before the closing curly bracket, brackets excluded). In case of \code{setCMethod} with signature - \code{list} -- a list of such character vectors. } + \code{list} -- a list of such character vectors. } \item{includes}{ A character vector of additional includes and preprocessor statements etc that will be put between the R includes and the user function(s).} - \item{otherdefs}{ A characted vector with the code for any further definitions of - functions, classes, types, forward declarations, namespace usage clauses etc + \item{otherdefs}{ A characted vector with the code for any further definitions of + functions, classes, types, forward declarations, namespace usage clauses etc which is inserted between the includes and the declarations of the functions defined in \code{sig}.} \item{language}{ A character value that specifies the source language of the - inline code. The possible values for \code{language} include all those - supported by \code{R CMD SHLIB} on any platform, which are currently C, + inline code. The possible values for \code{language} include all those + supported by \code{R CMD SHLIB} on any platform, which are currently C, C++, Fortran, F95, ObjectiveC and ObjectiveC++; they may not all be supported - on your platform. One can specify the language either in full as above, or - using any of the following case insensitive shortened forms: \code{c, cpp, + on your platform. One can specify the language either in full as above, or + using any of the following case insensitive shortened forms: \code{c, cpp, c++, f, f95, objc, objcpp, objc++}. Defaults to \code{C++}.} - + \item{verbose}{ If \code{TRUE} prints the compilation output, the source code of the resulting program and the definitions of all declared methods. If \code{FALSE}, the function is silent, but it prints compiler warning and error messages and the source code if compilation fails. } - + \item{convention}{ Which calling convention to use? See the Details section.} \item{Rcpp}{If \code{TRUE} adds inclusion of \code{Rcpp.h} to @@ -92,34 +95,39 @@ compiler via the \code{PKG_LIBS} environment variable. Elements should be fully formed as for example \code{c("-L/usr/local/lib/foo -lfoo", "--lpthread")} and are passed along verbatim.} - - \item{dim}{Optional character vector defining the dimensionality of the + + \item{dim}{Optional character vector defining the dimensionality of the function arguments. Of same length as \code{sig}. Fortran or F95 only.} - - \item{implicit}{A character vector defining the implicit declaration in - Fortran or F95; the default is to use the implicit typing rules for Fortran, + + \item{implicit}{A character vector defining the implicit declaration in + Fortran or F95; the default is to use the implicit typing rules for Fortran, which is \code{integer} for names starting with the letters \code{I} through \code{N}, and \code{real} for names beginning with any other letter. - As \code{R} passes double precision, this is not the best choice. + As \code{R} passes double precision, this is not the best choice. Safest is to choose \code{implicit = "none"} which will require all names in the subroutine to be explicitly declared.} - \item{module}{Name(s) of any modules to be used in the \code{Fortran} or + \item{module}{Name(s) of any modules to be used in the \code{Fortran} or \code{F95} subroutine.} + \item{name}{Function name to be used in the code. Only used if \code{sig} is + not a list. This is useful if the DLL created is to be used in conjunction + with the \code{ode} function of the \code{deSolve} package. + } + \item{...}{ Reserved.} } \value{ If \code{sig} is a single character vector, \code{cfunction} returns a single \code{\link{function}}; if it is a list, it returns a list of functions. - + \code{setCMethod} declares new methods with given names and signatures and returns invisible \code{NULL}. } \details{ - + To declare multiple functions in the same library one can use \code{setCMethod} supplying lists of signatures and implementations. In this case, provide as many method names in \code{f} as you define methods. Avoid clashes when selecting @@ -130,26 +138,26 @@ "front-matter" of the function or the close, e.g. in C or C++ it must start after the C-function opening curly bracket and end before the C-function closing curly bracket, brackets should not be - included. The header will be automatically generated from the R-\code{signature} - argument. Arguments will will carry the same name as used in the signature, - so avoid variable names that are not legal in the target language + included. The header will be automatically generated from the R-\code{signature} + argument. Arguments will will carry the same name as used in the signature, + so avoid variable names that are not legal in the target language (e.g. names with dots). - - C/C++: If \code{convention == ".Call"} (the default), the \code{\link{.Call}} mechanism - is used and its result is returned directly as the result of the call of the - generated function. As the last line of the generated C/C++ code a - \code{return R_NilValue;} is added in this case and a warning is generated - in case the user has forgotten to provide a return value. To suppress the + + C/C++: If \code{convention == ".Call"} (the default), the \code{\link{.Call}} mechanism + is used and its result is returned directly as the result of the call of the + generated function. As the last line of the generated C/C++ code a + \code{return R_NilValue;} is added in this case and a warning is generated + in case the user has forgotten to provide a return value. To suppress the warning and still return NULL, add \code{return R_NilValue;} explicitly. - + Special care is needed with types, memory allocation and protection -- exactly the same as if the code was not inline: see the - Writing R Extension manual for information on \code{\link{.Call}}. - + Writing R Extension manual for information on \code{\link{.Call}}. + If \code{convention == ".C"} or \code{convention == ".Fortran"}, the \code{\link{.C}} or \code{\link{.Fortran}} mechanism respectively is used, and the return value is a list containing all arguments. - + Attached R includes include \code{R.h} for \code{".C"}, and additionally \code{Rdefines.h} and \code{R_ext\\Error.h} for \code{".Call"}. @@ -179,17 +187,17 @@ ## Same Fortran example - now n is one number code2 <- " integer i - do 1 i=1, n + do 1 i=1, n 1 x(i) = x(i)**3 " -cubefn2 <- cfunction(signature(n="integer", x="numeric"), implicit = "none", +cubefn2 <- cfunction(signature(n="integer", x="numeric"), implicit = "none", dim = c("", "(*)"), code2, convention=".Fortran") cubefn2(n, x)$x ## Same in F95, now x is fixed-size vector (length = n) code3 <- "x = x*x*x" -cubefn3 <- cfunction(sig = signature(n="integer", x="numeric"), implicit = "none", +cubefn3 <- cfunction(sig = signature(n="integer", x="numeric"), implicit = "none", dim = c("", "(n)"), code3, language="F95") cubefn3(20, 1:20) print(cubefn3) @@ -197,12 +205,16 @@ ## Same example in C code4 <- " int i; - for (i = 0; i < *n; i++) + for (i = 0; i < *n; i++) x[i] = x[i]*x[i]*x[i]; " cubefn4 <- cfunction(signature(n="integer", x="numeric"), code4, language = "C", convention = ".C") cubefn4(20, 1:20) +## Give the function in the source code a name +cubefn5 <- cfunction(signature(n="integer", x="numeric"), code4, language = "C", convention = ".C", + name = "cubefn") +code(cubefn5) } ## use of a module in F95 @@ -217,7 +229,7 @@ cgetcts <- cfunction(getconstants, module = "modcts", implicit = "none", includes = modct, sig = c(x = "double"), dim = c("(2)"), language = "F95") -cgetcts(x = 1:2) +cgetcts(x = 1:2) print(cgetcts) ## Use of .C convention with C code @@ -233,8 +245,8 @@ squarefn(n, x); " -fns <- cfunction( list(squarefn=sigSq, quadfn=sigQd), - list(codeSq, codeQd), +fns <- cfunction( list(squarefn=sigSq, quadfn=sigQd), + list(codeSq, codeQd), convention=".C") squarefn <- fns[["squarefn"]] @@ -244,9 +256,9 @@ quadfn(n, x)$x ## Alternative declaration using 'setCMethod' -setCMethod(c("squarefn", "quadfn"), list(sigSq, sigQd), +setCMethod(c("squarefn", "quadfn"), list(sigSq, sigQd), list(codeSq, codeQd), convention=".C") - + squarefn(n, x)$x quadfn(n, x)$x diff -Nru r-cran-inline-0.3.16/man/cxxfunction.Rd r-cran-inline-0.3.17/man/cxxfunction.Rd --- r-cran-inline-0.3.16/man/cxxfunction.Rd 2014-08-28 22:24:44.000000000 +0000 +++ r-cran-inline-0.3.17/man/cxxfunction.Rd 2020-11-28 15:24:39.000000000 +0000 @@ -1,9 +1,7 @@ \name{cxxfunction} \alias{cxxfunction} \alias{rcpp} -\title{ -inline C++ function -} +\title{inline C++ function} \description{ Functionality to dynamically define an R function with inlined C++ code using the \code{\link{.Call}} calling convention. @@ -13,8 +11,8 @@ } \usage{ cxxfunction(sig = character(), body = character(), - plugin = "default", includes = "", - settings = getPlugin(plugin), ..., verbose = FALSE) + plugin = "default", includes = "", + settings = getPlugin(plugin), ..., verbose = FALSE) rcpp(..., plugin="Rcpp") } \arguments{ @@ -26,48 +24,38 @@ \item{\dots}{Further arguments to the plugin} \item{verbose}{verbose output} } -\value{ -A function -} -\seealso{ - \code{\link{cfunction}} -} +\value{A function} +\seealso{\code{\link{cfunction}}} \examples{ \dontrun{ - # default plugin -fx <- cxxfunction( signature(x = "integer", y = "numeric" ) , ' - return ScalarReal( INTEGER(x)[0] * REAL(y)[0] ) ; -' ) -fx( 2L, 5 ) +fx <- cxxfunction(signature(x = "integer", y = "numeric"), + "return ScalarReal(INTEGER(x)[0] * REAL(y)[0]);") +fx(2L, 5) # Rcpp plugin -if( require( Rcpp ) ){ - - fx <- cxxfunction( signature(x = "integer", y = "numeric" ) , ' - return wrap( as(x) * as(y) ) ; - ', plugin = "Rcpp" ) - fx( 2L, 5 ) - - ## equivalent shorter form using rcpp() - fx <- rcpp(signature(x = "integer", y = "numeric"), - ' return wrap( as(x) * as(y) ) ; ') +if (requireNamespace("Rcpp", quietly=TRUE)) { + fx <- cxxfunction(signature(x = "integer", y = "numeric"), + "return wrap( as(x) * as(y));", + plugin = "Rcpp" ) + fx(2L, 5) + + ## equivalent shorter form using rcpp() + fx <- rcpp(signature(x = "integer", y = "numeric"), + "return wrap(as(x) * as(y));") } # RcppArmadillo plugin -if( require( RcppArmadillo ) ){ - - fx <- cxxfunction( signature(x = "integer", y = "numeric" ) , ' - int dim = as( x ) ; - arma::mat z = as(y) * arma::eye( dim, dim ) ; - return wrap( arma::accu(z) ) ; - ', plugin = "RcppArmadillo" ) - fx( 2L, 5 ) - +if (requireNamespace(RcppArmadillo)) { + fx <- cxxfunction(signature(x = "integer", y = "numeric"), + "int dim = as(x); + arma::mat z = as(y) * arma::eye(dim, dim); + return wrap(arma::accu(z));", + plugin = "RcppArmadillo") + fx(2L, 5) } - } } \keyword{programming} diff -Nru r-cran-inline-0.3.16/man/package.skeleton.Rd r-cran-inline-0.3.17/man/package.skeleton.Rd --- r-cran-inline-0.3.16/man/package.skeleton.Rd 2014-08-28 22:24:44.000000000 +0000 +++ r-cran-inline-0.3.17/man/package.skeleton.Rd 2020-11-28 21:43:31.000000000 +0000 @@ -28,20 +28,15 @@ \examples{ \dontrun{ -fx <- cxxfunction( signature(x = "integer", y = "numeric" ) , ' - return ScalarReal( INTEGER(x)[0] * REAL(y)[0] ) ; -' ) -package.skeleton( "foo", fx ) +fx <- cxxfunction(signature(x = "integer", y = "numeric"), + "return ScalarReal( INTEGER(x)[0] * REAL(y)[0]);") +package.skeleton("foo", fx) - -functions <- cxxfunction( - list( - ff = signature(), - gg = signature( x = "integer", y = "numeric" ) - ), - c( "return R_NilValue ;", "return ScalarReal( INTEGER(x)[0] * REAL(y)[0] ) ;") -) -package.skeleton( "foobar", functions ) +functions <- cxxfunction(list(ff = signature(), + gg = signature(x = "integer", y = "numeric")), + c("return R_NilValue ;", + "return ScalarReal(INTEGER(x)[0] * REAL(y)[0]);")) +package.skeleton("foobar", functions) } } diff -Nru r-cran-inline-0.3.16/man/utilities.Rd r-cran-inline-0.3.17/man/utilities.Rd --- r-cran-inline-0.3.16/man/utilities.Rd 2015-04-11 12:43:10.000000000 +0000 +++ r-cran-inline-0.3.17/man/utilities.Rd 2020-11-28 21:39:17.000000000 +0000 @@ -1,8 +1,11 @@ \name{utilities} \alias{utilities} -\alias{writeDynLib} -\alias{readDynLib} +\alias{moveDLL} +\alias{moveDLL-methods} +\alias{moveDLL,CFunc-method} +\alias{writeCFunc} +\alias{readCFunc} \alias{print,CFunc-method} \alias{print,CFuncList-method} \alias{code} @@ -11,93 +14,109 @@ \alias{code,CFunc-method} \alias{code,CFuncList-method} -\title{ printing, reading and writing CFunc objects } +\title{ Printing, reading and writing compiled function objects } \description{ - \code{writeDynLib} saves the DLL and the CFunc or CFuncList object as - generated by \link{cfunction}; \code{readDynLib} loads it. - - The \code{print} and \code{code} methods respectively print the entire - object or the code parts. + \code{moveDLL} moves the DLL used by a compiled function to a user defined + location. + + \code{writeCFunc} saves a \code{CFunc} object after the DLL has been moved to + the desired location using \code{moveDLL}. + + \code{readCFunc} reads a \code{CFunc} object that has been saved using + \code{writeCFunc}. + + The \code{print} and \code{code} methods respectively print the entire + object or only the code parts. } \usage{ - writeDynLib(x, file) - readDynLib(file) -} +moveDLL(x, ...) +\S4method{moveDLL}{CFunc}(x, name, directory, unload = FALSE, overwrite = FALSE, verbose = FALSE) -\section{Methods}{ +writeCFunc(x, file) +readCFunc(file) -\itemize{ - \item Method \code{print(x, ...)} prints the entire object \code{x} +\S4method{print}{CFunc}(x) +\S4method{print}{CFuncList}(x) - \describe{ +\S4method{code}{CFunc}(x, linenumbers = TRUE) +\S4method{code}{CFuncList}(x, linenumbers = TRUE) +} - \item{\code{signature(x = "CFunc")}}{Prints the CFunc object -generated by \code{\link{cfunction}}, including the code that generated it. } +\arguments{ - \item{\code{signature(x = "CFuncList")}}{Print all CFunc objects -generated by \code{\link{cfunction}}, including the code that generated them. } + \item{x}{A \code{CFunc} or \code{CFuncList} object as created by \code{\link{cfunction}}} - } + \item{name}{The base of the file name that the DLL should be moved to. The file name + extension will depend on the operating system used} - \item Method \code{code(x, linenumbers = TRUE, ...)} prints the code only + \item{directory}{The directory that the DLL should be written to} - \describe{ + \item{unload}{In case the new path constructed from \code{name} and + \code{directory} points to a loaded DLL, should we unload it?} - \item{\code{signature(x)}}{The \code{CFunc} or \code{CFuncList} object as generated by -\code{\link{cfunction}}. } + \item{overwrite}{In case there is a file at the new path constructed from + \code{name} and \code{directory} should we overwrite that file?} - \item{\code{linenumbers}}{If \code{TRUE} all code lines will be numbered. } + \item{verbose}{Should we print a message stating where the DLL was copied + if the operation was successful?} + \item{file}{The file path for writing and reading the object generated by + \code{\link{cfunction}}. Consider using a file name extension like + \code{.rda} or \code{.RData} to indicate that this is a serialized + R object. } -} -} -\arguments{ + \item{linenumbers}{If \code{TRUE} all code lines will be numbered.} - \item{x}{A \code{CFunc} or \code{CFuncList} object as created by \code{\link{cfunction}} to be saved.} - - \item{file}{base name of the file to write the object to or to read from. - Two files will be saved, one for the shared object or DLL (extension \code{so} - or \code{DLL}) and one that holds the \code{CFunc} or \code{CFuncList} specification, without - the function address (extension \code{CFunc}).} + \item{\dots}{May be used in future methods} } \value{ - Function \code{readDynLib} returns a \code{CFunc} or \code{CFuncList} object. + + Function \code{readDynLib} returns a \code{CFunc} object. + + Function \code{writeDynLib} returns the name of the \code{.CFunc} file that + was created. } \details{ - - Both the CFunc or CFuncList object and the shared object or DLL are saved, - in two files; the first has extension \code{CFunc}; the second \code{so} or - \code{DLL}, depending on the operating system used. - - When reading, both files are loaded, and the compiled function address - added to the object. - + + If you move the DLL to a user defined location with \code{moveDLL}, this will + prevent removal of the DLL at garbage collection and, if not written to the + session \code{\link{tempdir}}, removal at session termination. However, + saving and reloading an object will still loose the pointer to the DLL. + + Only if their DLL has been moved, \code{CFunc} objects can be saved by + \code{writeCFunc} and restored by \code{readCFunc}. + } \note{ -\itemize{ -\item The code of a \code{CFunc} or \code{CFuncList} object \code{x} can be extracted -(rather than printed), using: + \itemize{ -\code{x@code}. -\item To write the code to a file (here called \code{"fn"}), -without the new-line character \code{"\n"}: + \item The code of a \code{CFunc} or \code{CFuncList} object \code{x} can be extracted + (rather than printed), using: -\code{write (strsplit(x, "\n")[[1]], file = "fn")} -} + \code{x@code}. + + \item To write the code to a file (here called \code{"fn"}), without the + new-line character \code{"\n"}: + + \code{write (strsplit(x, "\n")[[1]], file = "fn")} + + } } -\seealso{ \code{ - \link{getDynLib} -}} +\seealso{ + + \code{\link{getDynLib}} + +} \examples{ @@ -109,25 +128,24 @@ do 1 i=1, n(1) 1 x(i) = x(i)**3 " -cubefn <- cfunction(signature(n="integer", x="numeric"), code, convention=".Fortran") +cubefn <- cfunction(signature(n="integer", x="numeric"), code, + convention=".Fortran") code(cubefn) cubefn(n, x)$x -\dontrun{ - fname <- tempfile() - writeDynLib(cubefn, file = fname) - # load and assign different name to object - cfn <- readDynLib(fname) - print(cfn) - cfn(2, 1:2) -} +moveDLL(cubefn, name = "cubefn", directory = tempdir()) +path <- file.path(tempdir(), "cubefn.rda") +writeCFunc(cubefn, path) +rm(cubefn) + +cfn <- readCFunc(path) +cfn(3, 1:3)$x } \author{ - Karline Soetaert + Karline Soetaert and Johannes Ranke } \keyword{file} - diff -Nru r-cran-inline-0.3.16/MD5 r-cran-inline-0.3.17/MD5 --- r-cran-inline-0.3.16/MD5 2020-09-06 15:40:02.000000000 +0000 +++ r-cran-inline-0.3.17/MD5 2020-12-01 00:50:17.000000000 +0000 @@ -1,19 +1,23 @@ -54c53e55ac32f46ef7bc11d39c967493 *DESCRIPTION -acb01a354fa4c74771a494262ec731a5 *NAMESPACE -d1e6182545ffed972cfba40480631406 *R/cfunction.R +57822d4e6018ed9c3612d65029a410d0 *DESCRIPTION +04fb0b89d8e5bfdf5a6a3c8742fbb497 *NAMESPACE +646c24f533ad74b80c175366fcb49808 *R/cfunction.R 3661ee24e0f177e278d23dc97797e056 *R/cmethods.R -ab9db57362e717900c85751f401727dd *R/cxxfunction.R +aac2d2db93459cdd03d169d8ef50f622 *R/cxxfunction.R 7e32cd42ac56d4e281a1fe82b38738a7 *R/getDynLib.R b060d5e5093bf71dd36ba4ca26001cac *R/package.skeleton.R -0ff2d922761c7431a93e590fb88ac727 *R/utilities.R -60051991ed71c83a5ced7369724d6bb5 *README.md -2e6fb7a9a9a11667eb01fbc6e64948d5 *build/partial.rdb -45ac80fac9fe765e706c67f5ec244598 *inst/NEWS.Rd -d208cc9df3d3ada1ea8e854868e3c814 *man/cfunction.Rd -601bf59c3a06707ae4084c79f9b49aad *man/cxxfunction.Rd +0c07ecc05d91dd41ea0e0663b0ef90c5 *R/utilities.R +a2ee040ec35c5f7c11ea23c5ed56b1a8 *README.md +71acf885d00324937137bd5330e6bed4 *build/partial.rdb +795cc1b14064f8abd0546622c8753ce8 *inst/NEWS.Rd +fde8bc34d810722d1394392c5e345488 *inst/tinytest/test_cfunction.R +39c248bfe8f8db1ceacb5291ac6c6db3 *inst/tinytest/test_cxxfunction.R +ccb7e04a6d7a0c9f511a4a1891aecc85 *inst/tinytest/test_utilities.R +f763aeb09afa824ff93e53c61b522424 *man/cfunction.Rd +ff7a3754cb0b9ebf56b01bf7b15720e1 *man/cxxfunction.Rd 18b89221354bc68a777c5ea418e6efbe *man/getDynLib.Rd d29d73247a35885fa13c0fa020866986 *man/inline-package.Rd c0c301365881f1f019e9ecae2df2a062 *man/internals.Rd -062a91de3b64623d6a67ef6efc1e5103 *man/package.skeleton.Rd +dca9bbdf2e3bd0052d048097c715116e *man/package.skeleton.Rd 04a5e1e601e5da5565578ae818a848f6 *man/plugins.Rd -78c7e87d5955074e35908b161a7ea90c *man/utilities.Rd +8409ec24ccc19dafed4d5baaa2052ab3 *man/utilities.Rd +46ed7ffcd19192844b681001be5cffcd *tests/tinytest.R diff -Nru r-cran-inline-0.3.16/NAMESPACE r-cran-inline-0.3.17/NAMESPACE --- r-cran-inline-0.3.16/NAMESPACE 2020-09-03 16:17:08.000000000 +0000 +++ r-cran-inline-0.3.17/NAMESPACE 2020-11-26 23:08:36.000000000 +0000 @@ -5,14 +5,17 @@ "cfunction", "cxxfunction", "getPlugin", + "readCFunc", "registerPlugin", - "rcpp" + "rcpp", + "writeCFunc" ) exportMethods( "setCMethod", "getDynLib", "package.skeleton", + "moveDLL", "print", "code" ) diff -Nru r-cran-inline-0.3.16/R/cfunction.R r-cran-inline-0.3.17/R/cfunction.R --- r-cran-inline-0.3.16/R/cfunction.R 2020-09-03 16:17:08.000000000 +0000 +++ r-cran-inline-0.3.17/R/cfunction.R 2020-11-29 15:27:37.000000000 +0000 @@ -16,7 +16,7 @@ language=c("C++", "C", "Fortran", "F95", "ObjectiveC", "ObjectiveC++"), verbose=FALSE, convention=c(".Call", ".C", ".Fortran"), Rcpp=FALSE, cppargs=character(), cxxargs=character(), libargs=character(), - dim = NULL, implicit = NULL, module = NULL) { + dim = NULL, implicit = NULL, module = NULL, name = NULL) { if (missing (convention) & !missing(language)) convention <- switch (EXPR = language, "Fortran" = ".Fortran", "F95" = ".Fortran", ".C" = ".C", ObjectiveC = ".Call", "ObjectiveC++" = ".Call", "C++" = ".Call") @@ -31,11 +31,16 @@ f <- basename(tempfile()) + if (is.null(name)) { + name <- f + } + if ( !is.list(sig) ) { sig <- list(sig) - names(sig) <- f - names(body) <- f + names(sig) <- name + names(body) <- name } + if( length(sig) != length(body) ) stop("mismatch between the number of functions declared in 'sig' and the number of function bodies provided in 'body'") @@ -51,7 +56,9 @@ if (Rcpp) { if (!requireNamespace("Rcpp", quietly=TRUE)) stop("Rcpp cannot be loaded, install it or use the default Rcpp=FALSE", call.=FALSE) - cxxargs <- c(Rcpp:::RcppCxxFlags(), cxxargs) # prepend information from Rcpp + rcppdir <- system.file("include", package="Rcpp") + if (.Platform$OS.type == "windows") rcppdir <- utils::shortPathName(normalizePath(rcppdir)) + cxxargs <- c(paste("-I", rcppdir, sep=""), cxxargs) # prepend information from Rcpp } if (length(cppargs) != 0) { args <- paste(cppargs, collapse=" ") @@ -188,10 +195,14 @@ ## WRITE AND COMPILE THE CODE libLFile <- compileCode(f, code, language, verbose) + ## SET A FINALIZER TO PERFORM CLEANUP + # Make a copy of libLFile, as we may overwrite it later in writeDynLib(), and + # we don't want the finalizer to remove the new libLFile + libLFile_orig <- libLFile cleanup <- function(env) { - if ( f %in% names(getLoadedDLLs()) ) dyn.unload(libLFile) - unlink(libLFile) + if ( f %in% names(getLoadedDLLs()) ) dyn.unload(libLFile_orig) + unlink(libLFile_orig) } reg.finalizer(environment(), cleanup, onexit=TRUE) @@ -255,7 +266,7 @@ remove(list = c("args", "body", "fn", "funCsig", "i", "includes", "j")) ## RETURN THE FUNCTION - if (length(res) == 1 && names(res) == f) return( res[[1]] ) + if (length(res) == 1 && names(res) == name) return( res[[1]] ) else return( new( "CFuncList", res ) ) } @@ -264,29 +275,16 @@ wd = getwd() on.exit(setwd(wd)) ## Prepare temp file names - if ( .Platform$OS.type == "windows" ) { - ## windows files - dir <- gsub("\\\\", "/", tempdir()) - libCFile <- paste(dir, "/", f, ".EXT", sep="") - libLFile <- paste(dir, "/", f, ".dll", sep="") - libLFile2 <- paste(dir, "/", f, ".dll", sep="") - } - else { - ## UNIX-alike build - libCFile <- paste(tempdir(), "/", f, ".EXT", sep="") - libLFile <- paste(tempdir(), "/", f, .Platform$dynlib.ext, sep="") - libLFile2 <- paste(tempdir(), "/", f, ".sl", sep="") - } extension <- switch(language, "C++"=".cpp", C=".c", Fortran=".f", F95=".f95", ObjectiveC=".m", "ObjectiveC++"=".mm") - libCFile <- sub(".EXT$", extension, libCFile) + libCFile <- file.path(tempdir(), paste0(f, extension)) + libLFile <- file.path(tempdir(), paste0(f, .Platform$dynlib.ext)) ## Write the code to the temp file for compilation write(code, libCFile) ## Compile the code using the running version of R if several available if ( file.exists(libLFile) ) file.remove( libLFile ) - if ( file.exists(libLFile2) ) file.remove( libLFile2 ) setwd(dirname(libCFile)) errfile <- paste( basename(libCFile), ".err.txt", sep = "" ) @@ -297,7 +295,6 @@ errmsg <- readLines( errfile ) unlink( errfile ) - if ( !file.exists(libLFile) && file.exists(libLFile2) ) libLFile <- libLFile2 if ( !file.exists(libLFile) ) { cat("\nERROR(s) during compilation: source code errors or compiler configuration errors!\n") if ( !verbose ) system2(cmd, args = paste(" CMD SHLIB --dry-run --preclean", basename(libCFile))) diff -Nru r-cran-inline-0.3.16/R/cxxfunction.R r-cran-inline-0.3.17/R/cxxfunction.R --- r-cran-inline-0.3.16/R/cxxfunction.R 2016-07-28 11:04:47.000000000 +0000 +++ r-cran-inline-0.3.17/R/cxxfunction.R 2020-11-28 15:24:39.000000000 +0000 @@ -1,88 +1,82 @@ plugins <- new.env() -plugins[["default"]] <- function( ){ - includes = '#include +plugins[["default"]] <- function() { + includes = ' +#include #include #include ' - list( - includes = includes, - body = function( x ) paste( x, '\nRf_warning("your C++ program does not return anything"); \n return R_NilValue ; ' ) - ) -} - -registerPlugin <- function( name, plugin ){ - plugins[[ name ]] <- plugin -} -getPlugin <- function( name, ... ){ - if( name %in% ls( plugins ) ){ - plugins[[ name ]]( ... ) - } else if( sprintf("package:%s", name) %in% search() || requireNamespace( name, quietly = TRUE) ){ - plugin <- get( "inlineCxxPlugin" , asNamespace(name) ) - if( is.null(plugin) ){ - stop( sprintf( "package '%s' does not define an inline plugin", name ) ) - } - registerPlugin( name, plugin ) - plugin( ... ) - } else { - stop( sprintf( "could not find plugin '%s'", name ) ) - } - + list(includes = includes, + body = function(x) { + paste0(x, + '\nRf_warning("your C++ program does not return anything");', + '\nreturn R_NilValue;')}) +} + +registerPlugin <- function(name, plugin) { + plugins[[ name ]] <- plugin +} + +getPlugin <- function(name, ...) { + if (name %in% ls(plugins)) { + plugins[[ name ]](...) + } else if (sprintf("package:%s", name) %in% search() || requireNamespace(name, quietly = TRUE)) { + plugin <- get("inlineCxxPlugin", asNamespace(name)) + if (is.null(plugin)) { + stop(sprintf("package '%s' does not define an inline plugin", name)) + } + registerPlugin(name, plugin) + plugin(...) + } else { + stop(sprintf("could not find plugin '%s'", name)) + } } paste0 <- function(...) paste(..., sep="") -addLineNumbers <- function( code ){ - code <- strsplit( paste( code, collapse = "\n" ), "\n" )[[1]] - sprintf( "%4d : %s", 1:length(code), code) -} - -cxxfunction <- function ( - sig = character(), body = character(), - plugin = "default", - includes = "", - settings = getPlugin(plugin), - ..., - verbose = FALSE - ){ - - f <- basename( tempfile( ) ) - - if( ! is.list( sig ) ){ - sig <- list( sig ) - names( sig ) <- f - if( ! length( body ) ) body <- "" - names( body ) <- f - } - if( length(sig) != length(body) ) - stop("mismatch between the number of functions declared in 'sig' and the number of function bodies provided in 'body'") - - signature <- lapply( sig, function(x) { - if( ! length(x) ){ - "" - } else { - paste( sprintf( "SEXP %s", names(x) ), collapse = ", " ) - } - } ) - - decl <- lapply( 1:length(sig) , function(index) { - sprintf( 'SEXP %s( %s) ;', names(signature)[index] , signature[[index]] ) - } ) - - def <- lapply( 1:length(sig), function(index){ - sprintf( ' -SEXP %s( %s ){ -%s -} -', names(signature)[index], - signature[[index]], - if(is.null(settings$body)) body[[index]] else settings$body(body[[index]]) ) - } ) +addLineNumbers <- function(code) { + code <- strsplit(paste(code, collapse = "\n" ), "\n")[[1]] + sprintf("%4d : %s", 1:length(code), code) +} + +cxxfunction <- function(sig = character(), body = character(), + plugin = "default", includes = "", + settings = getPlugin(plugin), + ..., verbose = FALSE) { + f <- basename(tempfile()) + + if (!is.list(sig)) { + sig <- list(sig) + names(sig) <- f + if (!length(body)) body <- "" + names(body) <- f + } + if (length(sig) != length(body)) + stop("mismatch between the number of functions declared in 'sig' and the number of function bodies provided in 'body'") + + signature <- lapply( sig, function(x) { + if (!length(x)){ + "" + } else { + paste(sprintf("SEXP %s", names(x) ), collapse = ", ") + } + }) + + decl <- lapply(1:length(sig) , function(index) { + sprintf('SEXP %s( %s) ;', names(signature)[index], signature[[index]]) + } ) + + def <- lapply(1:length(sig), function(index){ + sprintf('SEXP %s(%s) {\n%s\n}', + names(signature)[index], + signature[[index]], + if (is.null(settings$body)) body[[index]] else settings$body(body[[index]]) ) + }) - settings_includes <- if( is.null( settings$includes ) ) "" else paste( settings$includes, collapse = "\n" ) + settings_includes <- if (is.null(settings$includes)) "" else paste(settings$includes, collapse = "\n") - code <- sprintf( ' + code <- sprintf(' // includes from the plugin %s @@ -96,68 +90,66 @@ // definition %s - -', settings_includes , paste( includes, collapse = "\n" ), - paste( decl, collapse = "\n" ), - paste( def, collapse = "\n") - ) - - - if( !is.null( env <- settings$env ) ){ - do.call( Sys.setenv, env ) - if( isTRUE(verbose) ){ - cat( " >> setting environment variables: \n" ) - writeLines( sprintf( "%s = %s", names(env), env ) ) - } - } - - LinkingTo <- settings$LinkingTo - if( !is.null( LinkingTo ) ){ - paths <- find.package(LinkingTo, quiet=TRUE) - if( length( paths ) ){ - flag <- paste( - paste0( '-I"', paths, '/include"' ), - collapse = " " ) - Sys.setenv( CLINK_CPPFLAGS = flag ) - if( isTRUE( verbose ) ){ - cat( sprintf( "\n >> LinkingTo : %s\n", paste( LinkingTo, collapse = ", " ) ) ) - cat( "CLINK_CPPFLAGS = ", flag, "\n\n" ) - } - } - - } - - if( isTRUE( verbose ) ){ - writeLines( " >> Program source :\n" ) - writeLines( addLineNumbers( code ) ) - } - - language <- "C++" - - ## WRITE AND COMPILE THE CODE - libLFile <- compileCode( f, code, language = language, verbose = verbose ) - - ## SET A FINALIZER TO PERFORM CLEANUP - cleanup <- function(env) { - if ( f %in% names(getLoadedDLLs()) ) dyn.unload(libLFile) - unlink(libLFile) - } - reg.finalizer(environment(), cleanup, onexit=TRUE) - - ## Create new objects of class CFunc, each containing the code of ALL inline - ## functions. This will be used to recompile the whole shared lib when needed - res <- vector("list", length(sig)) - names(res) <- names(sig) - res <- new( "CFuncList", res ) - - DLL <- dyn.load( libLFile ) - - for( i in seq_along(sig) ){ - res[[i]] <- new( "CFunc", code = code ) - - fn <- function(arg) { - NULL - } +', + settings_includes, + paste(includes, collapse = "\n"), + paste(decl, collapse = "\n"), + paste(def, collapse = "\n")) + + + if (!is.null(env <- settings$env)) { + do.call(Sys.setenv, env) + if (isTRUE(verbose)) { + cat(" >> setting environment variables: \n") + writeLines(sprintf("%s = %s", names(env), env)) + } + } + + LinkingTo <- settings$LinkingTo + if (!is.null(LinkingTo)) { + paths <- find.package(LinkingTo, quiet=TRUE) + if (length(paths)) { + flag <- paste(paste0('-I"', paths, '/include"'), collapse = " ") + Sys.setenv(CLINK_CPPFLAGS = flag) + if (isTRUE(verbose)) { + cat(sprintf("\n >> LinkingTo : %s\n", paste(LinkingTo, collapse = ", "))) + cat("CLINK_CPPFLAGS = ", flag, "\n\n") + } + } + + } + + if (isTRUE(verbose)) { + writeLines(" >> Program source :\n") + writeLines(addLineNumbers(code)) + } + + language <- "C++" + + ## WRITE AND COMPILE THE CODE + libLFile <- compileCode(f, code, language = language, verbose = verbose) + + ## SET A FINALIZER TO PERFORM CLEANUP + cleanup <- function(env) { + if (f %in% names(getLoadedDLLs())) dyn.unload(libLFile) + unlink(libLFile) + } + reg.finalizer(environment(), cleanup, onexit=TRUE) + + ## Create new objects of class CFunc, each containing the code of ALL inline + ## functions. This will be used to recompile the whole shared lib when needed + res <- vector("list", length(sig)) + names(res) <- names(sig) + res <- new("CFuncList", res) + + DLL <- dyn.load(libLFile) + + for (i in seq_along(sig)) { + res[[i]] <- new("CFunc", code = code) + + fn <- function(arg) { + NULL + } ## Modify the function formals to give the right argument list args <- formals(fn)[ rep(1, length(sig[[i]])) ] @@ -165,21 +157,21 @@ formals(fn) <- args ## create .Call function call that will be added to 'fn' - body <- quote( .Call( EXTERNALNAME, ARG) )[ c(1:2, rep(3, length(sig[[i]]))) ] - for ( j in seq_along(sig[[i]]) ) body[[j+2]] <- as.name(names(sig[[i]])[j]) + body <- quote(.Call(EXTERNALNAME, ARG))[ c(1:2, rep(3, length(sig[[i]]))) ] + for (j in seq_along(sig[[i]])) body[[j+2]] <- as.name(names(sig[[i]])[j]) - body[[1L]] <- .Call - body[[2L]] <- getNativeSymbolInfo( names(sig)[[i]], DLL )$address - ## update the body of 'fn' - body(fn) <- body - ## set fn as THE function in CFunc of res[[i]] - res[[i]]@.Data <- fn - } - - ## clear the environment - rm( j ) - convention <- ".Call" - if( identical( length(sig), 1L ) ) res[[1L]] else res + body[[1L]] <- .Call + body[[2L]] <- getNativeSymbolInfo(names(sig)[[i]], DLL)$address + ## update the body of 'fn' + body(fn) <- body + ## set fn as THE function in CFunc of res[[i]] + res[[i]]@.Data <- fn + } + + ## clear the environment + rm(j) + convention <- ".Call" + if (identical(length(sig), 1L)) res[[1L]] else res } rcpp <- function(..., plugin="Rcpp") cxxfunction(..., plugin=plugin) diff -Nru r-cran-inline-0.3.16/R/utilities.R r-cran-inline-0.3.17/R/utilities.R --- r-cran-inline-0.3.16/R/utilities.R 2015-04-11 12:43:10.000000000 +0000 +++ r-cran-inline-0.3.17/R/utilities.R 2020-11-30 21:06:32.000000000 +0000 @@ -1,91 +1,82 @@ -## --------------------------------------------------------------------------- -# saving and loading CFunc objects (called write and read as it needs to -# be assigned. - -writeDynLib <- function(x, file) { - - DLL <- getDynLib(x) - - if (is.null(DLL)) - stop ("'x' DLL not loaded") - - DLLname <- DLL[["path"]] - if (!file.exists(DLLname)) - stop ("'x' does not point to an existing DLL") - - # correct extension of filename (dll, so) - dname <- dirname(file) - bname <- unlist(strsplit(basename(file), ".", fixed = TRUE))[1] - extension <- unlist(strsplit(basename(DLLname), ".", fixed = TRUE))[2] - file <- paste(dname,bname, extension, sep = ".") - - try(dyn.unload(file), silent = TRUE) - - file.copy(from = DLLname, to = file, overwrite = TRUE) - - # accessory file with compiled code information (DLL name has changed) - fileCF <- paste(dname,"/",bname, ".Cfunc", sep = "") - attributes(x)$DLL <- file - - # names of functions in compiled code - if (class(x) == "CFunc") - attributes(x)$fname <- DLL[["name"]] - else - attributes(x)$fname <- names(x) - - save(file = fileCF, x) -} +setGeneric("moveDLL", + function(x, ...) { + standardGeneric("moveDLL") + } +) -## --------------------------------------------------------------------------- +setMethod("moveDLL", + signature(x = "CFunc"), + function(x, name, directory, unload = FALSE, overwrite = FALSE, verbose = FALSE) { + + # Check arguments + if (length(name) > 1) stop("Please only supply only one name") + if (length(directory) > 1) stop("Please only supply only one directory name") + + # Obtain path to DLL + old_path <- environment(x)$libLFile + + # Create new path + if (!dir.exists(directory)) stop("There is no directory ", directory) + extension <- tools::file_ext(old_path) + new_path <- normalizePath(file.path(directory, paste(name, extension, sep = ".")), + mustWork = FALSE) + + active_paths <- sapply(getLoadedDLLs()[-1], + function(di) normalizePath(di[["path"]])) + if (new_path %in% active_paths) { + if (unload) { + if (inherits(try(dyn.unload(new_path)), "try-error")) + stop("Could not unload ", new_path) + } else { + stop("DLL from ", new_path, " is in use") + } + } + + # Copy the DLL + copy_success <- file.copy(old_path, new_path, overwrite = overwrite) + if (!copy_success) stop("Failed to copy DLL from ", old_path, " to ", new_path) + if (verbose) message("Copied DLL from ", old_path, " to ", new_path) + + # Unload DLL and reload from its new location + dyn.unload(old_path) + new_dll_info <- dyn.load(new_path) + + # Adjust the path that getDynLib uses + environment(x)$libLFile <- new_path + + # Adjust the symbol info in the function body + function_name <- environment(x)$name + body(x)[[2]] <- getNativeSymbolInfo(function_name, new_dll_info[["name"]])$address -readDynLib <- function(file) { + invisible(new_dll_info) + } +) -# open all the required files - extension <- unlist(strsplit(basename(file), ".", fixed = TRUE))[2] +writeCFunc <- function(x, file) { + env <- environment(x) + if (identical(env$libLFile, env$libLFile_orig)) + stop("Use moveDLL to prevent losing the DLL by garbage collection or session termination") - if (is.na(extension)) { - extension <- "CFunc" - file <- paste(file, extension, sep = ".") - } - - if (extension != "CFunc") - stop ("'file' should point to a CFunc object, extension '.CFunc'") - - if (!file.exists(file)) - stop ("'file' does not exist") - - CF <- get(load(file = file)) - attrs <- attributes(CF) - DLLname <- attrs$DLL - - if (!file.exists(DLLname)) - stop ("'file' does not point to valid CFunc object: DLL ", DLLname, " does not exist") - -# cleanup <- function(env) { -# unlink(DLLname) -# } -# reg.finalizer(environment(), cleanup, onexit = TRUE) - - -# load routines in DLL - - DLL <- dyn.load(DLLname) - fn <- attributes(CF)$fname - if (class(CF) == "CFunc") { - CFi <- CF - code <- CFi@code - body(CFi)[[2]] <- getNativeSymbolInfo(fn, DLL)$address - CF@.Data <- CFi - } else - for (i in 1:length(CF)) { - CFi <- CF[[i]] - code <- CFi@code - body(CFi)[[2]] <- getNativeSymbolInfo(fn[i], DLL)$address - CF[[i]]@.Data <- CFi - } - - attributes(CF) <- attrs - return(CF) + saveRDS(x, file = file) +} + +readCFunc <- function(file) { + x <- readRDS(file) + if (class(x) != "CFunc") stop(file, " does not contain a serialized CFunc object") + + # Get code for restoring after updating the function body + source_code <- x@code + + # Load the DLL + env <- environment(x) + dll_info <- dyn.load(env$libLFile) + + # Set the symbol info in the function body + body(x)[[2]] <- getNativeSymbolInfo(env$name, dll_info[["name"]])[["address"]] + x_cf <- as(x, "CFunc") + x_cf@code <- source_code + + return(x_cf) } setGeneric("code", function(x, ...) standardGeneric("code") ) @@ -93,11 +84,11 @@ function( x, linenumbers = TRUE ){ lines <- strsplit(x, "\n") if (linenumbers) - for (i in 1:length(lines[[1]])) cat(format(i, width = 3), + for (i in 1:length(lines[[1]])) cat(format(i, width = 3), ": ", lines[[1]][i], "\n", sep = "") else for (i in 1:length(lines[[1]])) cat(lines[[1]][i], "\n", sep = "") - + } ) setMethod( "code", signature( x = "CFunc" ), function( x, linenumbers = TRUE ) code (x@code, linenumbers)) setMethod( "code", signature( x = "CFuncList" ), function(x, linenumbers = TRUE ) code( x[[1L]], linenumbers ) ) @@ -107,8 +98,8 @@ setMethod( "print", signature( x = "CFunc" ), function( x ){ cat("An object of class 'CFunc'\n") - Dat <- x@.Data - print(Dat) + Dat <- x@.Data + print(Dat) cat("code:\n") code(x) } ) @@ -116,7 +107,7 @@ setMethod( "print", signature( x = "CFuncList" ), function(x) { cat("An object of class 'CFuncList'\n") for (i in 1:length(x)) { - print(names(x)[i]) + print(names(x)[i]) print(x[[i]]@.Data ) cat("\n") } diff -Nru r-cran-inline-0.3.16/README.md r-cran-inline-0.3.17/README.md --- r-cran-inline-0.3.16/README.md 2020-09-06 15:07:19.000000000 +0000 +++ r-cran-inline-0.3.17/README.md 2020-11-28 16:09:34.000000000 +0000 @@ -1,8 +1,11 @@ ## inline: Inline C, C++ and Fortran code from R [![Build Status](https://travis-ci.org/eddelbuettel/inline.png)](https://travis-ci.org/eddelbuettel/inline) +[![Build Status](https://github.com/eddelbuettel/inline/workflows/ci/badge.svg)](https://github.com/eddelbuettel/inline/actions?query=workflow%3Aci) [![License](https://img.shields.io/badge/license-LGPL%20%28%3E%3D%202%29-brightgreen)](https://www.gnu.org/licenses/lgpl-3.0.html) [![CRAN](https://www.r-pkg.org/badges/version/inline)](https://cran.r-project.org/package=inline) +[![CRAN use](https://jangorecki.gitlab.io/rdeps/inline/CRAN_usage.svg?sanitize=true)](https://cran.r-project.org/package=inline) +[![CRAN indirect](https://jangorecki.gitlab.io/rdeps/inline/indirect_usage.svg?sanitize=true)](https://cran.r-project.org/package=inline) [![Dependencies](https://tinyverse.netlify.com/badge/inline)](https://cran.r-project.org/package=inline) [![Downloads](https://cranlogs.r-pkg.org/badges/inline?color=brightgreen)](https://www.r-pkg.org/pkg/inline) [![Debian package](https://img.shields.io/debian/v/r-cran-inline/sid?color=brightgreen)](https://packages.debian.org/sid/r-cran-inline) @@ -19,12 +22,17 @@ The package was originally written while Oleg Sklyar was at [EMBL-EBI](https://www.ebi.ac.uk/). It was then extended by Dirk Eddelbuettel and Romain Francois for use by -[Rcpp](https://dirk.eddelbuettel.com/code/rcpp.html). Karline Soetaert added -support for Fortran. +[Rcpp](https://dirk.eddelbuettel.com/code/rcpp.html). Years later, Karline +Soetaert added support for Fortran. Johannes Ranke refactored some internals +and added the ability to store and retrieve compiled code. ### Authors -Oleg Sklyar, Dirk Eddelbuettel, Romain Francois, Karline Soetaert +Oleg Sklyar, Dirk Eddelbuettel, Romain Francois, Karline Soetaert, Johannes Ranke + +### Maintainer + +Dirk Eddelbuettel ### License diff -Nru r-cran-inline-0.3.16/tests/tinytest.R r-cran-inline-0.3.17/tests/tinytest.R --- r-cran-inline-0.3.16/tests/tinytest.R 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-inline-0.3.17/tests/tinytest.R 2020-11-25 13:24:08.000000000 +0000 @@ -0,0 +1,9 @@ + +if (requireNamespace("tinytest", quietly=TRUE) && + utils::packageVersion("tinytest") >= "1.1.0") { + + ## Set a seed to make the tests deterministic + set.seed(42) + + tinytest::test_package("inline") +}