[Sciviews-commits] r405 - in pkg/svUnit: . R

[noreply at r-forge.r-project.org]

Author: mariotomo
Date: 2011-09-21 15:38:41 +0200 (Wed, 21 Sep 2011)
New Revision: 405

Modified:
   pkg/svUnit/DESCRIPTION
   pkg/svUnit/R/runExamples.R
   pkg/svUnit/R/svTest.R
Log:
the test list was only repeatedly running the last test defined.
it seems to be working now.


Modified: pkg/svUnit/DESCRIPTION
===================================================================
--- pkg/svUnit/DESCRIPTION	2011-09-20 09:37:37 UTC (rev 404)
+++ pkg/svUnit/DESCRIPTION	2011-09-21 13:38:41 UTC (rev 405)
@@ -4,7 +4,7 @@
 Depends: R (>= 1.9.0)
 Suggests: svGUI, datasets, utils, XML
 Description: A complete unit test system and functions to implement its GUI part
-Version: 0.7-7
+Version: 0.7-8
 Date: 2010-09-30
 Author: Philippe Grosjean
 Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>

Modified: pkg/svUnit/R/runExamples.R
===================================================================
--- pkg/svUnit/R/runExamples.R	2011-09-20 09:37:37 UTC (rev 404)
+++ pkg/svUnit/R/runExamples.R	2011-09-21 13:38:41 UTC (rev 405)
@@ -22,12 +22,14 @@
     sub("^\\\\name[ ]*\\{(.*)\\}", lines, replacement="\\1")
   })
   manPages <- manPages[manPages != paste(packageName, "package", sep="-")]
+  names(manPages) <- manPages
 
   lapply(manPages, function(x) {
-    result <- svTest(function() 
-                     tryCatch(withCallingHandlers({ do.call(example, list(topic=x, package=packageName)); checkTrue(TRUE); },
+    testCall <- call("example", x, packageName)
+    result <- svTest(function() {
+                     tryCatch(withCallingHandlers({ eval(testCall); checkTrue(TRUE); },
                                                   warning=function(w) { checkIdentical(NULL, w) }),
-                              error=function(w) checkIdentical(NULL, w)))
+                              error=function(w) checkIdentical(NULL, w))})
     attr(result, 'unit') <- 'rcheck.examples'
     result
   })

Modified: pkg/svUnit/R/svTest.R
===================================================================
--- pkg/svUnit/R/svTest.R	2011-09-20 09:37:37 UTC (rev 404)
+++ pkg/svUnit/R/svTest.R	2011-09-21 13:38:41 UTC (rev 405)
@@ -109,10 +109,9 @@
 
 runTest.list <- function(x, ...) {
   ## Run each test in x, giving each test the name it has in x
-  lapply(names(x), function(name) {
-    item <- x[[name]]
+  lapply(names(x), function(name, item=x[[name]]) {
     unit <- ifelse(is.null(attr(item, "unit")), "**root**", attr(item, "unit"))
-    runTest(item, name=name, unit=unit)
+    runTest(item, name=name, unit=unit, ...)
   })
 }