[Rcpp-devel] sourceCpp issue: code vs. file

[Rodney Sparapani]

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