Improve R Package Dependency Resolution and Script Execution Time (#99)
* When resolving dependencies, consolidation of duplicates keeps binary pkgs. Dependency Calculation doesn't fetch linkingTo packages for binary pkgs. * Comment style for function now consistent. Updated comment phrasing * Removed hardcoded cran repo check and add proper data.frame row count check. Added tests for LinkingTo package inclusion for binary vs source. * Spacing consistency with connectionString argument * Adjust test for purpose of checking source package installed due to successful compilation from source
This commit is contained in:
Sean Leonard
GitHub
Родитель
f27e8f1495
Коммит
27612c6df1
|
|
@ -548,7 +548,7 @@ sqlRemoteExecuteFun <- function(connection, FUN, ..., useRemoteFun = FALSE, asus
|
|||
{
|
||||
result <- FALSE
|
||||
}
|
||||
|
||||
|
||||
if (!is.null(output))
|
||||
{
|
||||
for(o in output)
|
||||
|
|
@ -1155,7 +1155,35 @@ getDependentPackagesToInstall <- function(pkgs, availablePackages, installedPack
|
|||
write(sprintf("%s Resolving package dependencies for (%s)...", pkgTime(), paste(pkgs, collapse = ', ')), stdout())
|
||||
}
|
||||
|
||||
dependencies <- tools::package_dependencies(packages = pkgs, db = availablePackages, recursive = TRUE, verbose = FALSE)
|
||||
dependencies <- NULL
|
||||
repos <- getOption("repos")
|
||||
contribWinBinaryUrl <- utils::contrib.url(repos = repos, type = "win.binary")
|
||||
|
||||
#
|
||||
# Build list of dependencies
|
||||
#
|
||||
for (package in pkgs)
|
||||
{
|
||||
currentPackageDependencies <- NULL
|
||||
dependencyTypes <- c("Depends","Imports")
|
||||
|
||||
#
|
||||
# Determine if package is available as a binary package
|
||||
#
|
||||
packageProperties <- availablePackages[availablePackages$Package == package & availablePackages$Repository == contribWinBinaryUrl, ]
|
||||
|
||||
#
|
||||
# When only a source package is available, add LinkingTo dependencies
|
||||
#
|
||||
if ( nrow(packageProperties) < 1)
|
||||
{
|
||||
append(dependencyTypes, c("LinkingTo"))
|
||||
}
|
||||
|
||||
currentPackageDependencies <- tools::package_dependencies(packages = pkgs, db = availablePackages, which = dependencyTypes, recursive = TRUE, verbose = FALSE)
|
||||
|
||||
dependencies <- append(dependencies, currentPackageDependencies)
|
||||
}
|
||||
|
||||
#
|
||||
# get combined dependency closure w/o base packages
|
||||
|
|
@ -1255,7 +1283,7 @@ prunePackagesToInstallExtLib <- function(dependentPackages, topMostPackages, ins
|
|||
}
|
||||
|
||||
# if the available package is being requested as a top-level package we check
|
||||
# if the top-leve attribute on the package is set to false we will have to update it to true
|
||||
# if the top-level attribute on the package is set to false we will have to update it to true
|
||||
#
|
||||
if ('Attributes' %in% colnames(installedPackages))
|
||||
{
|
||||
|
|
@ -1590,11 +1618,16 @@ sqlInstallPackagesExtLib <- function(connectionString,
|
|||
binaryPackages <- if (serverVersion$serverIsWindows) utils::available.packages(contribWinBinary, type = "win.binary") else NULL
|
||||
row.names(binaryPackages) <- NULL
|
||||
|
||||
pkgsUnison <- data.frame(rbind(sourcePackages, binaryPackages), stringsAsFactors = FALSE)
|
||||
# Concatenate list source packages to the list of binary packages available within configured CRAN repo.
|
||||
#
|
||||
pkgsUnison <- data.frame(rbind(binaryPackages, sourcePackages), stringsAsFactors = FALSE)
|
||||
|
||||
# For packages available as binary and source types, prune the source packages.
|
||||
#
|
||||
pkgsUnison <- pkgsUnison[!duplicated(pkgsUnison$Package),,drop=FALSE]
|
||||
row.names(pkgsUnison) <- pkgsUnison$Package
|
||||
|
||||
# check for missing packages
|
||||
# check for missing packages (Package(s) requested to be installed, but not available on configured CRAN repo.)
|
||||
#
|
||||
missingPkgs <- pkgs[!(pkgs %in% pkgsUnison$Package) ]
|
||||
|
||||
|
|
@ -1603,7 +1636,7 @@ sqlInstallPackagesExtLib <- function(connectionString,
|
|||
stop(sprintf("Cannot find specified packages (%s) to install", paste(missingPkgs, collapse = ', ')), call. = FALSE)
|
||||
}
|
||||
|
||||
# get all installed packages
|
||||
# get list of all installed packages on the server
|
||||
#
|
||||
installedPackages <- sql_installed.packages(connectionString,
|
||||
fields = NULL,
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ test_that("single package install and removal with no dependencies",
|
|||
|
||||
connectionStringDBO <- helper_getSetting("connectionStringDBO")
|
||||
packageName <- c("glue")
|
||||
|
||||
|
||||
tryCatch({
|
||||
#
|
||||
# check package management is installed
|
||||
|
|
@ -32,29 +32,29 @@ test_that("single package install and removal with no dependencies",
|
|||
sql_remove.packages(connectionStringDBO, packageName, verbose = TRUE, scope = scope)
|
||||
}
|
||||
|
||||
helper_checkPackageStatusRequire( connectionStringDBO, packageName, FALSE)
|
||||
helper_checkPackageStatusRequire(connectionStringDBO, packageName, FALSE)
|
||||
|
||||
#
|
||||
# install single package (package has no dependencies)
|
||||
#
|
||||
output <- try(capture.output(sql_install.packages( connectionStringDBO, packageName, verbose = TRUE, scope = scope)))
|
||||
output <- try(capture.output(sql_install.packages(connectionStringDBO, packageName, verbose = TRUE, scope = scope)))
|
||||
print(output)
|
||||
expect_true(!inherits(output, "try-error"))
|
||||
expect_equal(1, sum(grepl("Successfully installed packages on SQL server", output)))
|
||||
|
||||
helper_checkPackageStatusRequire( connectionStringDBO, packageName, TRUE)
|
||||
helper_checkPackageStatusRequire(connectionStringDBO, packageName, TRUE)
|
||||
helper_checkSqlLibPaths(connectionStringDBO, 2)
|
||||
|
||||
#
|
||||
# remove the installed package and check again they are gone
|
||||
#
|
||||
cat("\nINFO:removing package...\n")
|
||||
output <- try(capture.output(sql_remove.packages( connectionStringDBO, packageName, verbose = TRUE, scope = scope)))
|
||||
output <- try(capture.output(sql_remove.packages(connectionStringDBO, packageName, verbose = TRUE, scope = scope)))
|
||||
print(output)
|
||||
expect_true(!inherits(output, "try-error"))
|
||||
expect_equal(1, sum(grepl("Successfully removed packages from SQL server", output)))
|
||||
|
||||
helper_checkPackageStatusRequire( connectionStringDBO, packageName, FALSE)
|
||||
helper_checkPackageStatusRequire(connectionStringDBO, packageName, FALSE)
|
||||
}, finally={
|
||||
helper_cleanAllExternalLibraries(connectionStringDBO)
|
||||
})
|
||||
|
|
@ -64,58 +64,58 @@ test_that( "package install and uninstall with dependency",
|
|||
{
|
||||
connectionStringAirlineUserdbowner <- helper_getSetting("connectionStringAirlineUserdbowner")
|
||||
scope <- "private"
|
||||
|
||||
|
||||
tryCatch({
|
||||
#
|
||||
# check package management is installed
|
||||
#
|
||||
cat("\nINFO: checking remote lib paths...\n")
|
||||
helper_checkSqlLibPaths(connectionStringAirlineUserdbowner, 1)
|
||||
|
||||
|
||||
packageName <- c("A3")
|
||||
dependentPackageName <- "xtable"
|
||||
|
||||
|
||||
#
|
||||
# remove old packages if any and verify they aren't there
|
||||
#
|
||||
if (helper_remote.require(connectionStringAirlineUserdbowner, packageName) == TRUE)
|
||||
{
|
||||
cat("\nINFO: removing package:", packageName,"\n")
|
||||
sql_remove.packages( connectionStringAirlineUserdbowner, c(packageName), verbose = TRUE, scope = scope)
|
||||
sql_remove.packages(connectionStringAirlineUserdbowner, c(packageName), verbose = TRUE, scope = scope)
|
||||
}
|
||||
|
||||
|
||||
if (helper_remote.require(connectionStringAirlineUserdbowner, dependentPackageName) == TRUE)
|
||||
{
|
||||
cat("\nINFO: removing package:", dependentPackageName,"\n")
|
||||
sql_remove.packages( connectionStringAirlineUserdbowner, c(dependentPackageName), verbose = TRUE, scope = scope)
|
||||
sql_remove.packages(connectionStringAirlineUserdbowner, c(dependentPackageName), verbose = TRUE, scope = scope)
|
||||
}
|
||||
|
||||
helper_checkPackageStatusRequire( connectionStringAirlineUserdbowner, packageName, FALSE)
|
||||
helper_checkPackageStatusRequire( connectionStringAirlineUserdbowner, dependentPackageName, FALSE)
|
||||
|
||||
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, packageName, FALSE)
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, dependentPackageName, FALSE)
|
||||
|
||||
#
|
||||
# install the package with its dependencies and check if its present
|
||||
#
|
||||
output <- try(capture.output(sql_install.packages( connectionStringAirlineUserdbowner, packageName, verbose = TRUE, scope = scope)))
|
||||
output <- try(capture.output(sql_install.packages(connectionStringAirlineUserdbowner, packageName, verbose = TRUE, scope = scope)))
|
||||
print(output)
|
||||
expect_true(!inherits(output, "try-error"))
|
||||
expect_equal(1, sum(grepl("Successfully installed packages on SQL server", output)))
|
||||
|
||||
helper_checkPackageStatusRequire( connectionStringAirlineUserdbowner, packageName, TRUE)
|
||||
helper_checkPackageStatusRequire( connectionStringAirlineUserdbowner, dependentPackageName, TRUE)
|
||||
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, packageName, TRUE)
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, dependentPackageName, TRUE)
|
||||
helper_checkSqlLibPaths(connectionStringAirlineUserdbowner, 2)
|
||||
|
||||
|
||||
#
|
||||
# remove the installed packages and check again they are gone
|
||||
#
|
||||
cat("\nINFO: removing packages...\n")
|
||||
output <- try(capture.output(sql_remove.packages( connectionStringAirlineUserdbowner, packageName, verbose = TRUE, scope = scope)))
|
||||
output <- try(capture.output(sql_remove.packages(connectionStringAirlineUserdbowner, packageName, verbose = TRUE, scope = scope)))
|
||||
print(output)
|
||||
expect_true(!inherits(output, "try-error"))
|
||||
expect_equal(1, sum(grepl("Successfully removed packages from SQL server", output)))
|
||||
|
||||
helper_checkPackageStatusRequire( connectionStringAirlineUserdbowner, packageName, FALSE)
|
||||
helper_checkPackageStatusRequire( connectionStringAirlineUserdbowner, dependentPackageName, FALSE)
|
||||
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, packageName, FALSE)
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, dependentPackageName, FALSE)
|
||||
}, finally={
|
||||
helper_cleanAllExternalLibraries(connectionStringAirlineUserdbowner)
|
||||
})
|
||||
|
|
@ -132,22 +132,153 @@ test_that( "Installing a package that is already in use",
|
|||
#
|
||||
cat("\nINFO: checking remote lib paths...\n")
|
||||
helper_checkSqlLibPaths(connectionStringAirlineUserdbowner, 1)
|
||||
|
||||
|
||||
|
||||
|
||||
packageName <- c("lattice") # usually already attached in an R session.
|
||||
|
||||
|
||||
installedPackages <- sql_installed.packages(connectionStringAirlineUserdbowner, fields = NULL, scope = scope)
|
||||
if (!packageName %in% installedPackages)
|
||||
{
|
||||
sql_install.packages(connectionStringAirlineUserdbowner, packageName, verbose = TRUE, scope = scope)
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# install the package again and check if it fails with the correct message.
|
||||
#
|
||||
output <- capture.output(sql_install.packages( connectionStringAirlineUserdbowner, packageName, verbose = TRUE, scope = scope))
|
||||
output <- capture.output(sql_install.packages(connectionStringAirlineUserdbowner, packageName, verbose = TRUE, scope = scope))
|
||||
expect_true(TRUE %in% (grepl("already installed", output)))
|
||||
}, finally={
|
||||
helper_cleanAllExternalLibraries(connectionStringAirlineUserdbowner)
|
||||
})
|
||||
})
|
||||
|
||||
#
|
||||
# 'iptools' is available as source and binary. This test validates that the LinkingTo package 'BH' is not installed.
|
||||
# If 'BH' is installed, that means that the 'iptools' source package was chosen,
|
||||
# because LinkingTo packages are required when building from source.
|
||||
#
|
||||
test_that( "Binary Package install with LinkingTo dependency",
|
||||
{
|
||||
connectionStringAirlineUserdbowner <- helper_getSetting("connectionStringAirlineUserdbowner")
|
||||
scope <- "private"
|
||||
|
||||
tryCatch({
|
||||
#
|
||||
# check package management is installed
|
||||
#
|
||||
cat("\nINFO: checking remote lib paths...\n")
|
||||
helper_checkSqlLibPaths(connectionStringAirlineUserdbowner, 1)
|
||||
|
||||
packageName <- c("iptools")
|
||||
linkingToPackageName <- "BH"
|
||||
|
||||
#
|
||||
# remove old packages if any and verify they aren't there
|
||||
#
|
||||
if (helper_remote.require(connectionStringAirlineUserdbowner, packageName) == TRUE)
|
||||
{
|
||||
cat("\nINFO: removing package:", packageName,"\n")
|
||||
sql_remove.packages(connectionStringAirlineUserdbowner, c(packageName), verbose = TRUE, scope = scope)
|
||||
}
|
||||
|
||||
if (helper_remote.require(connectionStringAirlineUserdbowner, linkingToPackageName) == TRUE)
|
||||
{
|
||||
cat("\nINFO: removing package:", linkingToPackageName,"\n")
|
||||
sql_remove.packages(connectionStringAirlineUserdbowner, c(linkingToPackageName), verbose = TRUE, scope = scope)
|
||||
}
|
||||
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, packageName, FALSE)
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, linkingToPackageName, FALSE)
|
||||
|
||||
#
|
||||
# install the package with its dependencies and validate that the LinkingTo package was not installed
|
||||
#
|
||||
output <- try(capture.output(sql_install.packages(connectionStringAirlineUserdbowner, packageName, verbose = TRUE, scope = scope)))
|
||||
print(output)
|
||||
expect_true(!inherits(output, "try-error"))
|
||||
expect_equal(1, sum(grepl("Successfully installed packages on SQL server", output)))
|
||||
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, packageName, TRUE)
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, linkingToPackageName, FALSE)
|
||||
helper_checkSqlLibPaths(connectionStringAirlineUserdbowner, 1)
|
||||
|
||||
#
|
||||
# remove the installed packages and check again they are gone
|
||||
#
|
||||
cat("\nINFO: removing packages...\n")
|
||||
output <- try(capture.output(sql_remove.packages(connectionStringAirlineUserdbowner, packageName, verbose = TRUE, scope = scope)))
|
||||
print(output)
|
||||
expect_true(!inherits(output, "try-error"))
|
||||
expect_equal(1, sum(grepl("Successfully removed packages from SQL server", output)))
|
||||
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, packageName, FALSE)
|
||||
}, finally={
|
||||
helper_cleanAllExternalLibraries(connectionStringAirlineUserdbowner)
|
||||
})
|
||||
})
|
||||
|
||||
#
|
||||
# Source packages need the LinkingTo dependencies to be resolved and used for package compilation. This tests checks
|
||||
# that a source package is installed (successfully built) and it exists on the target server.
|
||||
#
|
||||
test_that( "Source Package install with LinkingTo dependency",
|
||||
{
|
||||
connectionStringAirlineUserdbowner <- helper_getSetting("connectionStringAirlineUserdbowner")
|
||||
scope <- "private"
|
||||
|
||||
tryCatch({
|
||||
#
|
||||
# check package management is installed
|
||||
#
|
||||
cat("\nINFO: checking remote lib paths...\n")
|
||||
helper_checkSqlLibPaths(connectionStringAirlineUserdbowner, 1)
|
||||
|
||||
packageName <- c("spacefillr")
|
||||
linkingToPackageName <- "Rcpp"
|
||||
|
||||
#
|
||||
# remove old packages if any and verify they aren't there
|
||||
#
|
||||
if (helper_remote.require(connectionStringAirlineUserdbowner, packageName) == TRUE)
|
||||
{
|
||||
cat("\nINFO: removing package:", packageName,"\n")
|
||||
sql_remove.packages(connectionStringAirlineUserdbowner, c(packageName), verbose = TRUE, scope = scope)
|
||||
}
|
||||
|
||||
if (helper_remote.require(connectionStringAirlineUserdbowner, linkingToPackageName) == TRUE)
|
||||
{
|
||||
cat("\nINFO: removing package:", linkingToPackageName,"\n")
|
||||
sql_remove.packages(connectionStringAirlineUserdbowner, c(linkingToPackageName), verbose = TRUE, scope = scope)
|
||||
}
|
||||
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, packageName, FALSE)
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, linkingToPackageName, FALSE)
|
||||
|
||||
#
|
||||
# install the package with its dependencies and validate that the LinkingTo package was installed
|
||||
#
|
||||
output <- try(capture.output(sql_install.packages(connectionStringAirlineUserdbowner, packageName, verbose = TRUE, scope = scope)))
|
||||
print(output)
|
||||
expect_true(!inherits(output, "try-error"))
|
||||
expect_equal(1, sum(grepl("Successfully installed packages on SQL server", output)))
|
||||
|
||||
#
|
||||
# Source package built and then successfully installed on the server.
|
||||
#
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, packageName, TRUE)
|
||||
helper_checkSqlLibPaths(connectionStringAirlineUserdbowner, 1)
|
||||
|
||||
#
|
||||
# remove the installed packages and check again they are gone
|
||||
#
|
||||
cat("\nINFO: removing packages...\n")
|
||||
output <- try(capture.output(sql_remove.packages(connectionStringAirlineUserdbowner, packageName, verbose = TRUE, scope = scope)))
|
||||
print(output)
|
||||
expect_true(!inherits(output, "try-error"))
|
||||
expect_equal(1, sum(grepl("Successfully removed packages from SQL server", output)))
|
||||
|
||||
helper_checkPackageStatusRequire(connectionStringAirlineUserdbowner, packageName, FALSE)
|
||||
}, finally={
|
||||
helper_cleanAllExternalLibraries(connectionStringAirlineUserdbowner)
|
||||
})
|
||||
})
|
||||
|
|
|
|||
Загрузка…
Ссылка в новой задаче