On 05/23/2013 03:01 PM, Rodney Sparapani wrote:
possibly, just add ".cpp" to any file that does not already have it
before copying it to TEMP.
Actually, this latter suggestion is rather easy to implement
and, I believe, simplifies life for spaces in filenames, etc.
It adds 5 lines, but eliminates 7: a win of -2 lines!
sourceCpp <-function (file = "", code = NULL, env = globalenv(), rebuild
= FALSE,
showOutput = verbose, verbose = getOption("verbose"))
{
if (!missing(code)) {
file <- tempfile(fileext = ".cpp")
con <- file(file, open = "w")
writeLines(code, con)
close(con)
}
## 05/24/13 workaround to ensure a .cpp extension
else {
file[2] <- tempfile(fileext = ".cpp")
file.copy(file[1], file[2])
file <- file[2]
}
## 05/24/13 as a side effect, no longer needed with this fix
## file <- normalizePath(file, winslash = "/")
## if (.Platform$OS.type == "windows") {
## if (grepl(" ", basename(file), fixed = TRUE)) {
## stop("The filename '", basename(file), "' contains
spaces. This ",
## "is not permitted.")
## }
## }
context <- .Call("sourceCppContext", PACKAGE = "Rcpp", file,
code, rebuild, .Platform)
if (context$buildRequired || rebuild) {
if (verbose)
.printVerboseOutput(context)
succeeded <- FALSE
output <- NULL
depends <- .getSourceCppDependencies(context$depends,
file)
.validatePackages(depends, context$cppSourceFilename)
envRestore <- .setupBuildEnvironment(depends, context$plugins,
file)
cwd <- getwd()
setwd(context$buildDirectory)
fromCode <- !missing(code)
if (!.callBuildHook(context$cppSourcePath, fromCode,
showOutput)) {
.restoreEnvironment(envRestore)
setwd(cwd)
return(invisible(NULL))
}
on.exit({
if (!succeeded) .showBuildFailureDiagnostics()
.callBuildCompleteHook(succeeded, output)
setwd(cwd)
.restoreEnvironment(envRestore)
})
if (file.exists(context$previousDynlibPath)) {
try(silent = T, dyn.unload(context$previousDynlibPath))
file.remove(context$previousDynlibPath)
}
cmd <- paste(R.home(component = "bin"), .Platform$file.sep,
"R ", "CMD SHLIB ", "-o ", shQuote(context$dynlibFilename),
" ", ifelse(rebuild, "--preclean ", ""),
shQuote(context$cppSourceFilename),
sep = "")
if (showOutput)
cat(cmd, "\n")
result <- suppressWarnings(system(cmd, intern = !showOutput))
if (!showOutput) {
output <- result
attributes(output) <- NULL
status <- attr(result, "status")
if (!is.null(status)) {
cat(result, "\n")
succeeded <- FALSE
stop("Error ", status, " occurred building shared
library.")
}
else if (!file.exists(context$dynlibFilename)) {
cat(result, "\n")
succeeded <- FALSE
stop("Error occurred building shared library.")
}
else {
succeeded <- TRUE
}
}
else if (!identical(as.character(result), "0")) {
succeeded <- FALSE
stop("Error ", result, " occurred building shared library.")
}
else {
succeeded <- TRUE
}
}
else {
if (verbose)
cat("\nNo rebuild required (use rebuild = TRUE to ",
"force a rebuild)\n\n", sep = "")
}
if (length(context$exportedFunctions) > 0 || length(context$modules) >
0) {
exports <- c(context$exportedFunctions, context$modules)
removeObjs <- exports[exports %in% ls(envir = env, all.names = T)]
remove(list = removeObjs, envir = env)
scriptPath <- file.path(context$buildDirectory,
context$rSourceFilename)
source(scriptPath, local = env)
}
else if (getOption("rcpp.warnNoExports", default = TRUE)) {
warning("No Rcpp::export attributes or RCPP_MODULE declarations ",
"found in source")
}
if (length(context$embeddedR) > 0) {
srcConn <- textConnection(context$embeddedR)
source(file = srcConn, echo = TRUE)
}
invisible(list(functions = context$exportedFunctions, modules =
context$modules))
}
environment(sourceCpp) <- asNamespace("Rcpp")
--
Rodney Sparapani, PhD Center for Patient Care and Outcomes Research
Sr. Biostatistician http://www.mcw.edu/pcor
4 wheels good, 2 wheels better! Medical College of Wisconsin (MCW)
WWLD?: What Would Lombardi Do? Milwaukee, WI, USA
_______________________________________________
Rcpp-devel mailing list
Rcpp-devel@lists.r-forge.r-project.org
https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-devel
