diff --git a/com.oracle.truffle.r.test.packages/r/install.package.R b/com.oracle.truffle.r.test.packages/r/install.package.R
index 5a537407b2308e5592aef7a9f82c53b3f1e5e1e7..2ac70611c5920a9f8f9b172ce5f25fe5644c39f3 100644
--- a/com.oracle.truffle.r.test.packages/r/install.package.R
+++ b/com.oracle.truffle.r.test.packages/r/install.package.R
@@ -28,6 +28,81 @@
# args:
# pkgname, contriburl, lib
+log.message <- function(..., level=0) {
+ cat(..., "\n")
+}
+
+ignored.packages <- c("boot", "class", "cluster", "codetools", "foreign", "KernSmooth", "lattice", "MASS", "Matrix", "mgcv", "nlme", "nnet", "rpart", "spatial", "survival", "base", "compiler", "datasets", "grDevices", "graphics", "grid", "methods", "parallel", "splines", "stats", "stats4", "tools", "utils")
+
+package.dependencies <- function(pkg, lib, dependencies = c("Depends", "Imports", "LinkingTo"), pl = available.packages()) {
+ if (!(pkg %in% rownames(pl))) {
+ # TODO: logging
+ cat("Package", pkg, "not on CRAN\n")
+ return (NULL)
+ }
+ fields <- pl[pkg, dependencies]
+ fields <- fields[!is.na(fields)]
+
+ # remove newline artefacts '\n' and split by ','
+ deps <- unlist(strsplit(gsub("\\n", " ", fields), ","))
+
+ # remove version
+ deps <- trimws(sub("\\(.*\\)", "", deps))
+
+ # ignore dependency to "R" and ignore already installed packages
+ installed.packages <- tryCatch({
+ # query base and recommended packages
+ ip <- available.packages(lib.loc=lib)
+ ip[as.logical(match(ip[,"Priority"], c("base", "recommended"), nomatch=0L)),"Package"]
+ installed.pacakges(lib.loc=lib)
+ }, error = function(e) {
+ character(0)
+ }, warning = function(e) {
+ character(0)
+ })
+ setdiff(deps, c("R", installed.packages, ignored.packages))
+}
+
+transitive.dependencies <- function(pkg, lib, pl = available.packages(), deptype=c("Depends", "Imports", "LinkingTo"), suggests=FALSE) {
+ deps <- c()
+ more <- pkg
+
+ # Also add "Suggests" to dependencies but do not recurse
+ if (suggests) {
+ this.suggests <- package.dependencies(pkg, dependencies = "Suggests", pl = pl)
+ if (!is.null(this.suggests)) {
+ more <- c(more, this.suggests)
+ }
+ }
+
+ # TODO: improve list operations for better performance
+ processed <- character(0)
+
+ # the loop can't have more iterations then available packages
+ max.iterations <- nrow(pl)
+ iteration <- 0L
+ while (length(more) > 0) {
+ if (iteration >= max.iterations) {
+ stop("Maximum number of iterations exceeded")
+ }
+ this <- head(more, 1)
+ more <- tail(more, -1)
+
+ if (!(this %in% processed)) {
+ cat("processing ", this, "\n")
+ processed <- unique(c(processed, this))
+ this.deps <- package.dependencies(this, lib, dependencies = deptype, pl = pl)
+ if (!is.null(this.deps)) {
+ deps <- c(deps, this.deps)
+ more <- c(more, this.deps[!(this.deps %in% processed)])
+ }
+ }
+
+ iteration <- iteration + 1L
+ }
+ unique(deps)
+}
+
args <- commandArgs(TRUE)
parse.args <- function() {
@@ -35,14 +110,49 @@ parse.args <- function() {
pkgname <<- args[[1]]
contriburl <<- strsplit(args[[2]], ",")[[1]]
lib.install <<- args[[3]]
+
+ pkg.cache <<- as.environment(list(enabled=FALSE, table.file.name="version.table", size=2L))
+ pkg.cache$enabled <- as.logical(args[[4]])
+ cat("system.install, cache enabled: ", pkg.cache$enabled, "\n")
+ if (pkg.cache$enabled) {
+ pkg.cache$version <- args[[5]]
+ pkg.cache$dir <- args[[6]]
+ }
}
}
+# return code: sucess == 0L, error == 1L
run <- function() {
parse.args()
+
tryCatch({
- res <- install.packages(pkgname, contriburl=contriburl, type="source", lib=lib.install, INSTALL_opts="--install-tests")
- if (res == NULL) 0L else 1L
+ # determine available packages
+ pkg.list <- available.packages(contriburl=contriburl)
+
+ # compute transitive dependencies of the package to install
+ cat("Computing transitive package hull for ", pkgname, "\n")
+ transitive.pkg.list <- c(transitive.dependencies(pkgname, lib=lib.install, pl=pkg.list), pkgname)
+ cat("transitive deps: ", transitive.pkg.list, "\n")
+
+ # apply pkg cache to fetch cached packages first
+ cat("Fetching from cache if possible\n")
+ cached.pkgs <- sapply(transitive.pkg.list, function(pkgname) pkg.cache.get(pkg.cache, pkgname, lib.install))
+ cat("Number of cached pkgs: ", length(cached.pkgs), "\n")
+
+ # 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)
+ res <- install.packages(pkgname, contriburl=contriburl, type="source", lib=lib.install, INSTALL_opts="--install-tests")
+ if (res == NULL) {
+ # cache packages that were not in the cache before
+ lapply(transitive.pkg.list[!cached.pkgs], function(pkgname) pkg.cache.insert(pkg.cache, pkgname, lib.install))
+ } else {
+ return (1L)
+ }
+ }
+
+ # if we reach here, installation was a success
+ 0L
}, error = function(e) {
cat(e$message, "\n")
return (1L)
@@ -52,6 +162,29 @@ run <- function() {
})
}
+# Determines the directory of the script assuming that there is a "--file=" argument on the command line.
+getCurrentScriptDir <- function() {
+ cmdArgs <- commandArgs()
+ res <- startsWith(cmdArgs, '--file=')
+ fileArg <- cmdArgs[res]
+ if (length(fileArg) > 0L) {
+ p <- strsplit(fileArg, "=")[[1]][[2]]
+ dirname(p)
+ } else {
+ NULL
+ }
+}
+
+# load package cache code
+curScriptDir <- getCurrentScriptDir()
+if (!is.null(curScriptDir)) {
+ source(file.path(curScriptDir, "install.cache.R"))
+} else {
+ log.message("Cannot use package cache since script directory cannot be determined")
+ pkg.cache.get <<- function(...) FALSE
+ pkg.cache.insert <<- function(...) FALSE
+}
+
if (!interactive()) {
status.code <- run()
quit(status = status.code)
diff --git a/com.oracle.truffle.r.test.packages/r/install.packages.R b/com.oracle.truffle.r.test.packages/r/install.packages.R
index d254206c339167b3b948ff082681e97820b685ba..5ea8efa9846188097a831d657d086c4d80a49d11 100644
--- a/com.oracle.truffle.r.test.packages/r/install.packages.R
+++ b/com.oracle.truffle.r.test.packages/r/install.packages.R
@@ -725,19 +725,30 @@ fastr_error_log_size <- function() {
install.pkg <- function(pkgname) {
error_log_size <- fastr_error_log_size()
if (run.mode == "system") {
- system.install.wrapper <- function() {
- tryCatch(
- system.install(pkgname)
- , error = function(e) {
- log.message(e$message)
- return (1)
- }, warning = function(e) {
- log.message(e$message)
- # According to the documentation of 'system2', a warning will provide a status field.
- return (e$status)
- })
- }
- pkg.cache.install(pkg.cache, pkgname, lib.install, system.install.wrapper)
+ #system.install.wrapper <- function() {
+ #tryCatch(
+ #system.install(pkgname)
+ #, error = function(e) {
+ #log.message(e$message)
+ #return (1L)
+ #}, warning = function(e) {
+ #log.message(e$message)
+ ## According to the documentation of 'system2', a warning will provide a status field.
+ #return (e$status)
+ #})
+ #}
+ #pkg.cache.install(pkg.cache, pkgname, lib.install, system.install.wrapper)
+
+ tryCatch(
+ system.install(pkgname)
+ , error = function(e) {
+ log.message(e$message)
+ 1L
+ }, warning = function(e) {
+ log.message(e$message)
+ # According to the documentation of 'system2', a warning will provide a status field.
+ e$status
+ })
} else if (run.mode == "internal") {
internal.install.wrapper <- function() {
tryCatch(
@@ -788,8 +799,11 @@ system.install <- function(pkgname) {
} else {
rscript = gnu_rscript()
}
- args <- c(script, pkgname, paste0(contrib.url(getOption("repos"), "source"), collapse=","), lib.install)
- rc <- system2(rscript, args)
+ args <- c(script, pkgname, paste0(contrib.url(getOption("repos"), "source"), collapse=","), lib.install, as.character(pkg.cache$enabled))
+ if (pkg.cache$enabled) {
+ args <- c(args, pkg.cache$version, pkg.cache$dir)
+ }
+ rc <- system2(rscript, args)
rc
}
@@ -1055,16 +1069,6 @@ getCurrentScriptDir <- function() {
run <- function() {
parse.args()
-
- if (pkg.cache$enabled) {
- curScriptDir <- getCurrentScriptDir()
- if (!is.null(curScriptDir)) {
- source(file.path(curScriptDir, "install.cache.R"))
- } else {
- log.message("Cannot use package cache since script directory cannot be determined")
- }
- }
-
if (find.top100) {
set.repos()
do.find.top100()
@@ -1074,6 +1078,19 @@ run <- function() {
}
}
+# load package cache code
+curScriptDir <- getCurrentScriptDir()
+if (!is.null(curScriptDir)) {
+ source(file.path(curScriptDir, "install.cache.R"))
+} else {
+ log.message("Cannot use package cache since script directory cannot be determined")
+
+ # avoid errors
+ pkg.cache.install <<- function(...) FALSE
+ pkg.cache.get <<- function(...) FALSE
+ pkg.cache.insert <<- function(...) FALSE
+}
+
quiet <- F
repo.list <- c("CRAN")
pkg.cache <- as.environment(list(enabled=FALSE, table.file.name="version.table", size=2L))