[GR-12858] Override installation of special packages like rJava and data.table.

PullRequest: fastr/1902

Author: fangerer

com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/utils/R/utils.R

@@ -25,7 +25,7 @@ eval(expression({
 
 	fastrRepoPath <- NULL
 
-	install.fastr.packages <- function(pkgs) {
+	install.fastr.packages <- function(pkgs, lib, INSTALL_opts=character(0)) {
 		if (is.null(fastrRepoPath) || !file.exists(fastrRepoPath)) {
 			workDir <- tempdir()
 			download.file('https://api.github.com/repos/oracle/fastr/tarball/master', file.path(workDir, 'fastr-repo.tar.gz'))
@@ -37,7 +37,11 @@ eval(expression({
 		for (pkg in pkgs) {
 			pkgPath <- file.path(fastrRepoPath, 'com.oracle.truffle.r.pkgs', pkg)
 			if (file.exists(pkgPath)) {
-				install.packages(pkgPath, repos=NULL)
+                if (missing(lib)) {
+				    install.packages(pkgPath, repos=NULL, INSTALL_opts=INSTALL_opts)
+                } else {
+				    install.packages(pkgPath, lib=lib, repos=NULL, INSTALL_opts=INSTALL_opts)
+                }
 			} else {
 				stop(paste0("FastR doesn't provide patched version of package ", pkg, ". Use install.packages to install it."));
 			}
@@ -92,4 +96,4 @@ eval(expression({
 
 # export new public functions
 exports <- asNamespace("utils")[[".__NAMESPACE__."]][['exports']]
-assign('install.fastr.packages', 'install.fastr.packages', envir = exports)
+assign('install.fastr.packages', 'install.fastr.packages', envir = exports)

com.oracle.truffle.r.test.packages/initial.package.blacklist

@@ -295,9 +295,6 @@ Reason: Bioconductor
 Package: lumi
 Reason: Bioconductor
 
-Package: rJava
-Reason: java
-
 Package: mzR
 Reason: Bioconductor
 

com.oracle.truffle.r.test.packages/pkgtest/__init__.py

@@ -95,6 +95,17 @@ def _installpkgs_script():
     return join(packages_test, 'r', 'install.packages.R')
 
 
+def commit_fastr_builtins():
+    '''
+    There are some FastR builtins which we also want to use in GnuR (i.e. 'install.fastr.packages').
+    This function deparses these functions and writes them into a file which is then loaded by GnuR.
+    '''
+    dest_file = join(_packages_test_project_dir(), 'r', 'fastr.functions.rdx')
+    cmd_line = [get_fastr_rscript(), "--silent", "-e", '{ fastrRepoPath <- NULL; save(fastrRepoPath, install.fastr.packages, file="%s") }' % dest_file]
+    logging.debug("Generating fastr.functions.R: " + str(cmd_line))
+    return pkgtest_run(cmd_line)
+
+
 def _installpkgs(args, **kwargs):
     '''
     Runs the R script that does package/installation and testing.
@@ -164,6 +175,9 @@ def pkgtest(args):
     env['FASTR_OPTION_PrintErrorStacktracesToFile'] = 'false'
     env['FASTR_OPTION_PrintErrorStacktraces'] = 'true'
 
+    # transfer required FastR functions to GnuR
+    commit_fastr_builtins()
+
     # If '--cache-pkgs' is set, then also set the native API version value
     _set_pkg_cache_api_version(install_args, get_fastr_include_path())
 

com.oracle.truffle.r.test.packages/r/install.cache.R

@@ -710,45 +710,69 @@ transitive.dependencies <- function(pkg, lib, pl = as.data.frame(available.packa
     unique(deps)
 }
 
+pkg.cache.in.overrides <- function(pkgname) pkgname %in% (if(is.fastr()) overrides$fastr else overrides$gnur)
+
+pkg.cache.full.install <- function(install.candidate.names, contriburl, lib.install) {
+    # separate uncached packages that are listed in 'overrides'
+    pkgs.in.overrides <- as.character(install.candidate.names[pkg.cache.in.overrides(install.candidate.names)])
+    pkgs.not.in.overrides <- as.character(install.candidate.names[!pkg.cache.in.overrides(install.candidate.names)])
+
+    # override packages need to be installed differently
+    if (length(pkgs.in.overrides) > 0) {
+        install.fastr.packages(as.character(pkgs.in.overrides), lib=lib.install, INSTALL_opts="--install-tests")
+    }
+
+    if (length(pkgs.not.in.overrides) > 0) {
+        install.packages(as.character(pkgs.not.in.overrides), contriburl=contriburl, type="source", lib=lib.install, INSTALL_opts="--install-tests")
+    }
+}
+
 # Fetches the package from the cache or installs it. This is also done for all transitive dependencies.
 pkg.cache.internal.install <- function(pkg.cache.env, pkgname, contriburl, lib.install) {
     tryCatch({
-        if (pkg.cache.is.enabled(pkg.cache.env)) {
-            # determine available packages
-            pkg.list <- as.data.frame(available.packages(contriburl=contriburl), stringAsFactors=FALSE)
+        # determine available packages
+        pkg.list <- as.data.frame(available.packages(contriburl=contriburl, filters=list(add=TRUE, function(x) x), stringAsFactors=FALSE))
 
-            # query version of the package
-            pkg <- pkg.list[pkgname, c("Package", "Version")]
+        # query version of the package
+        pkg <- pkg.list[pkgname, c("Package", "Version")]
 
-            # compute transitive dependencies of the package to install
-            log.message("Computing transitive package dependencies for ", paste0(pkgname, "_", as.character(pkg$Version)), level=1)
-            transitive.pkg.list <- rbind(transitive.dependencies(pkgname, lib=lib.install, pl=pkg.list), pkg)
-            log.message("transitive deps: ", as.character(transitive.pkg.list$Package), level=1)
+        # compute transitive dependencies of the package to install
+        log.message("Computing transitive package dependencies for ", paste0(pkgname, "_", as.character(pkg$Version)), level=1)
+        transitive.pkg.list <- rbind(transitive.dependencies(pkgname, lib=lib.install, pl=pkg.list), pkg)
+        log.message("transitive deps: ", as.character(transitive.pkg.list$Package), level=1)
 
+        if (pkg.cache.is.enabled(pkg.cache.env)) {
             # apply pkg cache to fetch cached packages first
             cached.pkgs <- apply(transitive.pkg.list, 1, function(pkg) pkg.cache.get(pkg.cache.env, pkg, lib.install))
             log.message("Number of uncached packages:", nrow(transitive.pkg.list[!cached.pkgs, ]), level=1)
 
             # if there was at least one non-cached package
             if (any(!cached.pkgs) || length(cached.pkgs) == 0L) {
                 # install the package (and the transitive dependencies implicitly)
-                install.packages(as.character(transitive.pkg.list[!cached.pkgs, "Package"]), contriburl=contriburl, type="source", lib=lib.install, INSTALL_opts="--install-tests")
+                uncached.pkg.names <- transitive.pkg.list[!cached.pkgs, "Package"]
+
+                # install uncached packages
+                pkg.cache.full.install(uncached.pkg.names, contriburl, lib.install)
 
                 # cache packages that were not in the cache before
                 log.message("Caching uncached dependencies:", as.character(transitive.pkg.list[!cached.pkgs, "Package"]), level=1)
                 apply(transitive.pkg.list[!cached.pkgs, ], 1, function(pkg) pkg.cache.insert(pkg.cache.env, pkg, lib.install))
             }
         } else {
-            install.packages(pkgname, contriburl=contriburl, type="source", lib=lib.install, INSTALL_opts="--install-tests")
+            # Even if we do not use the package cache, we need to compute the dependencies transitively 
+            # because the deps may contain overridden packages.
+            pkg.cache.full.install(transitive.pkg.list[, "Package"], contriburl, lib.install)
         }
 
         # if we reach here, installation was a success
         0L
     }, error = function(e) {
         log.message(e$message)
+        log.message(traceback())
         return (1L)
     }, warning = function(e) {
         log.message(e$message)
         return (1L)
     })
 }
+

com.oracle.truffle.r.test.packages/r/install.packages.R

@@ -162,7 +162,13 @@ ignore.suggests <- list(
 	mboost = ignore.all.but('TH.data', 'survival', 'RColorBrewer'), # this pkg has only vignettes and grepping then gave these libs
 	quantmod = '*', # probably not necessary, the tests output does not contain any 'library', 'require' or 'load' calls
 	forcats = ignore.all.but('testthat'), # other suggested: ggplot2 and covcor not used in tests
-	sqldf = 'tcltk|RPostgreSQL|RJDBC|rJava|RH2' # tcltk not on CRAN, RPostgreSQL can't be installed, RH2 and RJDBC depend on rJava which can't be installed
+	sqldf = 'tcltk|RPostgreSQL|RJDBC|RH2' # tcltk not on CRAN, RPostgreSQL can't be installed, RH2 and RJDBC depend on rJava which can't be installed
+)
+
+# manually maintained list of packages that need to be install with 'install.fastr.packages'
+overrides <- list(
+    fastr = c("rJava", "data.table"),
+    gnur = c("data.table")
 )
 
 choice.depends <- function(pkg, choice=c("direct","suggests")) {
@@ -464,7 +470,7 @@ get.pkgs <- function() {
 		quit(save="no", status=100)
 	}
 	tryCatch({
-	    avail.pkgs <<- available.packages(type="source")
+	    avail.pkgs <<- available.packages(type="source", filters = list(add=TRUE, function(x) x))
     }, warning=my.warning)
 
     # Owing to a FastR bug, we may not invoke the handler above, but
@@ -493,6 +499,8 @@ get.pkgs <- function() {
 
 	in.installed <- function(x) x["Package"] %in% installed.pkgs
 
+	in.overrides <- function(x) FALSE
+
 	basic.exclude <- function(x, exclude.installed = T) {
 		in.blacklist(x) || ifelse(exclude.installed, in.installed(x), F)
 	}
@@ -502,15 +510,15 @@ get.pkgs <- function() {
 		# if inverting, alter sense of the basic match but still exclude blacklist/installed
 		if (!is.na(pkg.filelistfile)) {
 			if (invert.pkgset) {
-				match.fun <- function(x) !in.filelist(x) && !basic.exclude(x, exclude.installed)
+				match.fun <- function(x) !in.filelist(x) && (in.overrides(x) || !basic.exclude(x, exclude.installed))
 			} else {
-				match.fun <- function(x) in.filelist(x) && !basic.exclude(x, exclude.installed)
+				match.fun <- function(x) in.filelist(x) && (in.overrides(x) || !basic.exclude(x, exclude.installed))
 			}
 		} else {
 			if (invert.pkgset) {
-				match.fun <- function(x) !in.pattern(x) && !basic.exclude(x, exclude.installed)
+				match.fun <- function(x) !in.pattern(x) && (in.overrides(x) || !basic.exclude(x, exclude.installed))
 			} else {
-				match.fun <- function(x) in.pattern(x) && !basic.exclude(x, exclude.installed)
+				match.fun <- function(x) in.pattern(x) && (in.overrides(x) || !basic.exclude(x, exclude.installed))
 			}
 		}
 	}
@@ -523,7 +531,6 @@ get.pkgs <- function() {
 	if (length(toinstall.pkgs) == 0 && !use.installed.pkgs) {
 		print("Fatal error: requested package(s) found in repo(s)")
 		quit(save="no", status=100)
-
 	}
 
 	if (!is.na(random.count)) {
@@ -970,7 +977,11 @@ parse.args <- function() {
             svalue <- strsplit(get.argvalue(), ",")[[1]]
 	        for (s in svalue) {
                 arg <- strsplit(s, "=", fixed=T)[[1]]
-                assign(arg[[1]], arg[[2]], envir=pkg.cache)
+                if (arg[[1]] == "dir") { 
+                    assign(arg[[1]], normalizePath(arg[[2]]), envir=pkg.cache)
+                } else {
+                    assign(arg[[1]], arg[[2]], envir=pkg.cache)
+                }
             }
 		} else if (a == "--random") {
 			random.count <<- as.integer(get.argvalue())
@@ -1230,20 +1241,32 @@ getCurrentScriptDir <- function() {
 }
 
 run <- function() {
-    parse.args()
-    if (!is.na(find.top.pkgs)) {
-        set.repos()
-        do.find.top.pkgs(find.top.pkgs)
-    } else {
-        run.setup()
-        do.it()
-    }
+    tryCatch({
+        parse.args()
+        if (!is.na(find.top.pkgs)) {
+            set.repos()
+            do.find.top.pkgs(find.top.pkgs)
+        } else {
+            run.setup()
+            do.it()
+        }
+    }, errors = function(e) traceback()
+    )
 }
 
 # load package cache code
 curScriptDir <- getCurrentScriptDir()
 if (!is.null(curScriptDir)) {
     source(file.path(curScriptDir, "install.cache.R"))
+    if (!is.fastr()) {
+        fastr.functions.path <- file.path(curScriptDir, "fastr.functions.rdx")
+        if (file.exists(fastr.functions.path)) {
+            loaded.names <- load(fastr.functions.path)
+            log.message("Loaded names: ", loaded.names)
+        } else {
+            log.message("Warning: Running with GnuR but could not find file '", fastr.functions.path, "'")
+        }
+    }
 } else {
     log.message("Cannot use package cache since script directory cannot be determined")