[Swift-commit] r4315 - SwiftApps/SwiftR/Swift/R

[tga at ci.uchicago.edu]

Author: tga
Date: 2011-04-08 13:51:56 -0500 (Fri, 08 Apr 2011)
New Revision: 4315

Modified:
   SwiftApps/SwiftR/Swift/R/Library.R
   SwiftApps/SwiftR/Swift/R/Tests.R
Log:
Added in tests to check swiftLibrary/swiftDetach.
Fixed the logic of swiftLibrary/swiftDetach to correctly handle
complex expressions that evaluate to strings.


Modified: SwiftApps/SwiftR/Swift/R/Library.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Library.R	2011-04-08 18:51:13 UTC (rev 4314)
+++ SwiftApps/SwiftR/Swift/R/Library.R	2011-04-08 18:51:56 UTC (rev 4315)
@@ -6,13 +6,16 @@
     # If reset is true, then previously added libraries won't be
     # reimported on new workers.
 
+    subpackname <- substitute(packname)
     # Check to see if it is a string, if it is not a string
     # then we will deparse it to get the expression text
-    if (!is.character(substitute(packname))) {
+    if (!is.character(subpackname) && is.name(subpackname)) {
         # Maybe library was provided unquoted
-        packname <- deparse(substitute(packname))
+    
+        packname <- deparse(subpackname)
     }
-    if (! packname %in% installed.packages()) {
+
+    if (!packname %in% installed.packages()) {
         # Warn users in case they made a typo
         warning(paste("Package", packname, 
                 "was not a installed package in this instance of R,", 
@@ -68,9 +71,13 @@
     # package B will also be imported on the worker.  By detaching package A
     # we don't also detach B.  This contrasts to a fresh worker, where
     # package B will not be imported.
-    if (!is.character(substitute(name))) {
-        # Maybe package was provided unquoted
-        name <- deparse(substitute(name))
+    subname <- substitute(name)
+    # Check to see if it is a string, if it is not a string
+    # then we will deparse it to get the expression text
+    if (!is.character(subname) && is.name(subname)) {
+        # Maybe library was provided unquoted
+    
+        name <- deparse(subname)
     }
     
     #TODO: remove from options(".swift.packages")

Modified: SwiftApps/SwiftR/Swift/R/Tests.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Tests.R	2011-04-08 18:51:13 UTC (rev 4314)
+++ SwiftApps/SwiftR/Swift/R/Tests.R	2011-04-08 18:51:56 UTC (rev 4315)
@@ -649,6 +649,113 @@
     return (TRUE)
 }
 
+pkgexists <- function(pkgname) {
+    paste("package:", pkgname, sep='') %in% search()
+}
+
+swiftTest_7.1 <- function () {
+    # test swiftLIbrary passing symbolic arg
+
+    try(detach(package:cluster),silent=T)
+    # Test swiftLibrary default
+
+    # cluster is pkg in R std lib
+    swiftLibrary(cluster)
+
+    # test
+    loadedok <- swiftLapply(list("cluster"), pkgexists)[[1]]
+
+    if (!loadedok) {
+        cat("cluster should be loaded on remote host\n")
+        cat("\n!!!==> test 7.1 failed")
+        return (FALSE)
+    }
+    if (pkgexists("cluster")) {
+        cat("cluster should not be loaded in this session\n")
+        cat("\n!!!==> test 7.1 failed")
+        return (FALSE)
+    }
+
+    swiftDetach(package:cluster)
+    loadedok <- swiftLapply(list("cluster"), pkgexists)[[1]]
+    if (loadedok) {
+        cat("cluster should be detached on remote host\n")
+        cat("\n!!!==> test 7.1 failed")
+        return (FALSE)
+    }
+
+    cat("\n!!!==> test 7.1 passed.\n")
+    return (TRUE)
+}
+
+swiftTest_7.2 <- function () {
+    # Test swiftLibrary string 
+    try(detach(package:cluster), silent=T)
+    # Test swiftLibrary default
+
+    # cluster is pkg in R std lib
+    swiftLibrary("cluster")
+
+    # test
+    loadedok <- swiftLapply(list("cluster"), pkgexists)[[1]]
+
+    if (!loadedok) {
+        cat("cluster should be loaded on remote host\n")
+        cat("\n!!!==> test 7.2 failed")
+        return (FALSE)
+    }
+    if (pkgexists("cluster")) {
+        cat("cluster should not be loaded in this session\n")
+        cat("\n!!!==> test 7.2 failed")
+        return (FALSE)
+    }
+
+    swiftDetach("package:cluster")
+    loadedok <- swiftLapply(list("cluster"), pkgexists)[[1]]
+    if (loadedok) {
+        cat("cluster should be detached on remote host\n")
+        cat("\n!!!==> test 7.2 failed")
+        return (FALSE)
+    }
+
+    cat("\n!!!==> test 7.2 passed.\n")
+    return (TRUE)
+}
+
+swiftTest_7.3 <- function () {
+    # Test swiftLibrary constructed string to make
+    try(detach(package:cluster), silent=T)
+    # Test swiftLibrary default
+
+    # cluster is pkg in R std lib
+    swiftLibrary(paste("clus", "ter", sep=""))
+
+    # test
+    loadedok <- swiftLapply(list("cluster"), pkgexists)[[1]]
+
+    if (!loadedok) {
+        cat("cluster should be loaded on remote host\n")
+        cat("\n!!!==> test 7.3 failed")
+        return (FALSE)
+    }
+    if (pkgexists("cluster")) {
+        cat("cluster should not be loaded in this session\n")
+        cat("\n!!!==> test 7.3 failed")
+        return (FALSE)
+    }
+
+    swiftDetach(paste("package:","clus", "ter", sep=""))
+    loadedok <- swiftLapply(list("cluster"), pkgexists)[[1]]
+    if (loadedok) {
+        cat("cluster should be detached on remote host\n")
+        cat("\n!!!==> test 7.3 failed")
+        return (FALSE)
+    }
+
+    cat("\n!!!==> test 7.3 passed.\n")
+    return (TRUE)
+}
+
 runAllSwiftTests <- function(...) {
 
     startTime = proc.time()[["elapsed"]]
@@ -715,6 +822,13 @@
             mkTest(swiftTest_6.2),
             mkTest(swiftTest_6.3)))
 
+testGroup7 <- makeTestGroup(
+    name="7 - library imports",
+    tests = list(mkTest(swiftTest_7.1),
+            mkTest(swiftTest_7.2),
+            mkTest(swiftTest_7.3)))
+
+
 makeFullTestSuite <- function (...) {
     initArgs <- list(...)
     initArgs[['keepwork']] <- TRUE
@@ -723,6 +837,6 @@
                             options(swift.initialexpr="initVar1 <- 19; initVar2 <- sqrt(400)+3")
                             do.call(swiftInit, initArgs) }, # swiftInit controlled via options
         groups=list(testGroup1.1, testGroup2, testGroup1.2, testGroup1.3, testGroup3, testGroup4,
-            testGroup5, testGroup6), 
+            testGroup5, testGroup6, testGroup7), 
         teardown=function () { swiftShutdown() })
 }