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

Author: seantleonard

R/R/sqlPackage.R

@@ -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,

R/tests/testthat/test.sqlPackage.dependencies.R

@@ -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)
+    })
+})