[Swift-commit] r4082 - in SwiftApps/SwiftR: . Swift Swift/R Swift/tests
noreply at svn.ci.uchicago.edu
noreply at svn.ci.uchicago.edu
Thu Feb 10 13:15:45 CST 2011
Author: tga
Date: 2011-02-10 13:15:41 -0600 (Thu, 10 Feb 2011)
New Revision: 4082
Added:
SwiftApps/SwiftR/Swift/R/Bench.R
Modified:
SwiftApps/SwiftR/IMMEDIATE-TODO
SwiftApps/SwiftR/Makefile
SwiftApps/SwiftR/Swift/NAMESPACE
SwiftApps/SwiftR/Swift/R/TestFramework.R
SwiftApps/SwiftR/Swift/R/Tests.R
SwiftApps/SwiftR/Swift/tests/runtests.R
Log:
Added initial benchmark which simply does a configurable sleep.
Added infrastructure to allow easy construction of parameterized performance
tests.
Modified: SwiftApps/SwiftR/IMMEDIATE-TODO
===================================================================
--- SwiftApps/SwiftR/IMMEDIATE-TODO 2011-02-10 17:40:02 UTC (rev 4081)
+++ SwiftApps/SwiftR/IMMEDIATE-TODO 2011-02-10 19:15:41 UTC (rev 4082)
@@ -77,6 +77,10 @@
- user testing in general (ssh, pbs, sge)
* SGE testing: ranger, siraf (low priority)
+MID:
+* Cleanup ssh worker processes: add a watchdog that detects when worker.pl has
+ gone away
+
LOW: (unless needed by immediate OpenMx app or test)
- complete sf compat functions (sapply, lapply -> for openMx, based on usage)
Modified: SwiftApps/SwiftR/Makefile
===================================================================
--- SwiftApps/SwiftR/Makefile 2011-02-10 17:40:02 UTC (rev 4081)
+++ SwiftApps/SwiftR/Makefile 2011-02-10 19:15:41 UTC (rev 4082)
@@ -38,7 +38,7 @@
R CMD check $(TBALL)
test: install
- ./Swift/tests/runtests.R
+ Rscript Swift/tests/runtests.R
clean:
rm -rf Swift/inst/swift/*
Modified: SwiftApps/SwiftR/Swift/NAMESPACE
===================================================================
--- SwiftApps/SwiftR/Swift/NAMESPACE 2011-02-10 17:40:02 UTC (rev 4081)
+++ SwiftApps/SwiftR/Swift/NAMESPACE 2011-02-10 19:15:41 UTC (rev 4082)
@@ -11,12 +11,17 @@
export(swiftRemoveAll)
export(runAllSwiftTests)
-export(basicSwiftTest)
-exportPattern("^swiftTest")
export(makeTestGroup)
+export(makeParamTestGroup)
export(runTestGroup)
export(runTestSuite)
+export(printTestGroup)
+export(mkTest)
+
+export(basicSwiftTest)
+exportPattern("^swiftTest")
exportPattern("^testGroup")
export(swiftTestSuite)
-export(printTestGroup)
-export(mkTest)
+
+export(mkPerfTest)
+export(doPerfTest)
Added: SwiftApps/SwiftR/Swift/R/Bench.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Bench.R (rev 0)
+++ SwiftApps/SwiftR/Swift/R/Bench.R 2011-02-10 19:15:41 UTC (rev 4082)
@@ -0,0 +1,75 @@
+
+
+swiftTest_6.1.1 <- function () {
+ swiftTest_6.1(2, 20)
+}
+
+sleeper <- function(delay,ncalls) {
+ options(swift.initialexpr="initVar3 <- 123; initVar4 <- 100");
+
+ timed <- function(delay) { Sys.sleep(delay); delay }
+
+ args=list(delay)
+ arglist = rep(list(args),ncalls)
+
+ cat("\nTest of swiftapply(delay,arglist)\n")
+
+ startTime = proc.time()[["elapsed"]]
+ swiftres = swiftapply(timed,arglist)
+ endTime = proc.time()[["elapsed"]]
+ runTime <- endTime - startTime
+
+ cat("\n\n ===> Ran for ",runTime," seconds.\n\n")
+
+ cat("Swift result:\n")
+ print(swiftres[[1]])
+
+ if(identical(delay,swiftres[[1]])) {
+ cat("\n==> sleeper passed\n")
+ return (TRUE)
+ } else {
+ cat("\n==> sleeper FAILED !!!!!\n")
+ return (FALSE)
+ }
+
+}
+
+id <- function () { return (1) }
+
+mkPerfTest <- function() {
+ # Have an initial test that will block until
+ # resources are ready
+ warmUpGroup <- makeTestGroup(
+ name="Wait for server to start",
+ tests=list(mkTest(id)))
+
+ perfTestGroup1 <- makeParamTestGroup(
+ name="1 - basic performance test",
+ f=sleeper,
+ allargs=list(
+ list(1, 10),
+ list(1, 20),
+ list(1, 50),
+ list(1, 100),
+ list(2, 10),
+ list(2, 20),
+ list(2, 50),
+ list(2, 100),
+ list(3, 10),
+ list(3, 20),
+ list(3, 50),
+ list(3, 100),
+ list(4, 10),
+ list(4, 20),
+ list(4, 50),
+ list(4, 100)))
+ swiftTestSuite <- list(
+ setup=function () { initSwiftTestOptions();
+ swiftInit() }, # swiftInit controlled via options
+ tests=list(warmUpGroup, perfTestGroup1),
+ teardown=function () { swiftShutdown() })
+ return (swiftTestSuite)
+}
+doPerfTest <- function () {
+ runTestSuite(mkPerfTest())
+}
Modified: SwiftApps/SwiftR/Swift/R/TestFramework.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/TestFramework.R 2011-02-10 17:40:02 UTC (rev 4081)
+++ SwiftApps/SwiftR/Swift/R/TestFramework.R 2011-02-10 19:15:41 UTC (rev 4082)
@@ -3,23 +3,53 @@
mkTest <- function (f) {
test = list()
- test$name = substitute(f)
+ test$name = deparse(substitute(f))
test$fun = f
test$passed = NULL
+ test$time <- NULL
return (test)
}
-makeTestGroup <- function (name, tlist, init=NULL) {
+makeTestGroup <- function (name, tests, setup=NULL, teardown=NULL) {
group = list()
- group$init = init
- group$tests = tlist
+ group$name <- name
+ group$setup = setup
+ group$tests = tests
+ group$teardown = teardown
return (group)
}
+makeParamTestGroup <- function (name, f, allargs,
+ setup=NULL, teardown=NULL) {
+
+
+ buildClosure <- function (f, args) {
+ force(f)
+ force(args)
+ return (function () { do.call(f, args) })
+ }
+ fname = deparse(substitute(f))
+
+ tests = list()
+ for (args in allargs) {
+ test = list()
+ args <- as.list(args)
+ test$name = paste(fname, substring(deparse(args), 5) , sep="")
+ test$fun <- buildClosure(f, args)
+ test$args <- args # Store for later analysis
+ test$passed <- NULL
+ test$time <- NULL
+ tests[[length(tests) + 1]] <- test
+ }
+
+ return (makeTestGroup(name, tests, setup, teardown))
+}
+
+
runTestGroup <- function (group) {
cat("\n*** Starting test group ", group$name, "***\n")
- if (!is.null(group$init))
- group$init()
+ if (!is.null(group$setup))
+ group$setup()
for (i in 1:length(group$tests)) {
test <- group$tests[[i]]
cat("\n== Starting test ", test$name, " ==\n")
@@ -30,6 +60,8 @@
group$tests[[i]]$time <- runTime
}
+ if (!is.null(group$teardown))
+ group$teardown()
return (group)
}
@@ -49,7 +81,7 @@
if (is.null(time))
"???"
else
- sprintf("%.2f", time)
+ sprintf("%.2fs", time)
}
for (test in group$tests) {
cat(paste(test$name, ": ", resFmt(test$passed),
@@ -60,7 +92,8 @@
runTestSuite <- function (suite) {
suite$setup()
resSuite <- lapply(suite$tests, runTestGroup)
+ suite$teardown()
+
lapply(resSuite, printTestGroup)
- suite$teardown()
- return (NULL)
+ return (resSuite)
}
Modified: SwiftApps/SwiftR/Swift/R/Tests.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Tests.R 2011-02-10 17:40:02 UTC (rev 4081)
+++ SwiftApps/SwiftR/Swift/R/Tests.R 2011-02-10 19:15:41 UTC (rev 4082)
@@ -590,40 +590,7 @@
}
}
-swiftTest_6.1.1 <- function () {
- swiftTest_6.1(2, 20)
-}
-swiftTest_6.1 <- function(delay,ncalls) {
- options(swift.initialexpr="initVar3 <- 123; initVar4 <- 100");
-
- timed <- function(delay) { Sys.sleep(delay); delay }
-
- args=list(delay)
- arglist = rep(list(args),ncalls)
-
- cat("\nTest of swiftapply(delay,arglist)\n")
-
- startTime = proc.time()[["elapsed"]]
- swiftres = swiftapply(timed,arglist)
- endTime = proc.time()[["elapsed"]]
- runTime <- endTime - startTime
-
- cat("\n\n ===> Total elapsed unit test time = ",runTime," seconds.\n\n")
-
- cat("Swift result:\n")
- print(swiftres[[1]])
-
- if(identical(delay,swiftres[[1]])) {
- cat("\n==> test 6.1 passed\n")
- return (TRUE)
- } else {
- cat("\n==> test 6.1 FAILED !!!!!\n")
- return (FALSE)
- }
-
-}
-
runAllSwiftTests <- function() {
startTime = proc.time()[["elapsed"]]
@@ -649,50 +616,47 @@
}
-testGroup1.1 <- list( init=NULL,
+testGroup1.1 <- makeTestGroup(
name="1.1 Sanity Check",
tests = list(mkTest(swiftTest_1.1)))
-testGroup1.2 <- list( init=NULL,
+testGroup1.2 <- makeTestGroup(
name="1.2 Basic Test - Adding data sets",
tests = list(mkTest(swiftTest_1.2.1),
mkTest(swiftTest_1.2.2), mkTest(swiftTest_1.2.3),
mkTest(swiftTest_1.2.4)))
-testGroup1.3 <- list( init=NULL,
+testGroup1.3 <- makeTestGroup(
name="1.3 - Export functionality",
tests = list(mkTest(swiftTest_1.3.1),
mkTest(swiftTest_1.3.2), mkTest(swiftTest_1.3.3),
mkTest(swiftTest_1.3.4), mkTest(swiftTest_1.3.5)) )
-testGroup2 <- list( init=NULL,
+testGroup2 <- makeTestGroup(
name="2 - test matrix passing",
tests = list(mkTest(swiftTest_2.1),
mkTest(swiftTest_2.2)) )
-testGroup3 <- list( init=NULL,
+testGroup3 <- makeTestGroup(
name="3 - test list element and name passing",
tests = list(mkTest(swiftTest_3.1),
mkTest(swiftTest_3.2)))
-testGroup4 <- list( init=NULL,
+testGroup4 <- makeTestGroup(
name="4 - test remote R service initialization string",
tests = list(mkTest(swiftTest_4.1),
mkTest(swiftTest_4.2)))
-testGroup5 <- list( init=NULL,
+testGroup5 <- makeTestGroup(
name="5 - remote R service error ",
tests = list(mkTest(swiftTest_5.1)))
-testGroup6 <- list( init=NULL,
- name="6 - performance tests",
- tests = list(mkTest(swiftTest_6.1.1)))
swiftTestSuite <- list(
setup=function () { initSwiftTestOptions();
swiftInit() }, # swiftInit controlled via options
tests=list(testGroup1.1, testGroup2, testGroup1.2, testGroup1.3, testGroup3, testGroup4,
- testGroup5, testGroup6),
+ testGroup5),
teardown=function () { swiftShutdown() })
Modified: SwiftApps/SwiftR/Swift/tests/runtests.R
===================================================================
--- SwiftApps/SwiftR/Swift/tests/runtests.R 2011-02-10 17:40:02 UTC (rev 4081)
+++ SwiftApps/SwiftR/Swift/tests/runtests.R 2011-02-10 19:15:41 UTC (rev 4082)
@@ -1,4 +1,4 @@
-#!/bin/env Rscript
+#!/usr/bin/env Rscript
library(Swift)
#TODO: take command line options to setup options
More information about the Swift-commit
mailing list