[Sciviews-commits] r398 - pkg/svUnit/R

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

Author: mariotomo
Date: 2011-09-19 11:29:01 +0200 (Mon, 19 Sep 2011)
New Revision: 398

Modified:
   pkg/svUnit/R/runExamples.R
   pkg/svUnit/R/svTest.R
Log:
not using `names` of list but attributes `name` and `unit` of each list element.


Modified: pkg/svUnit/R/runExamples.R
===================================================================
--- pkg/svUnit/R/runExamples.R	2011-09-19 08:49:58 UTC (rev 397)
+++ pkg/svUnit/R/runExamples.R	2011-09-19 09:29:01 UTC (rev 398)
@@ -23,8 +23,13 @@
   })
   manPages <- manPages[manPages != paste(packageName, "package", sep="-")]
 
-  sapply(manPages, function(x) svTest(function() 
-                                      tryCatch(withCallingHandlers({ do.call(example, list(topic=x, package=packageName)); checkTrue(TRUE); },
-                                                                   warning=function(w) { checkIdentical(NULL, w) }),
-                                               error=function(w) checkIdentical(NULL, w))))
+  lapply(manPages, function(x) {
+    result <- svTest(function() 
+                     tryCatch(withCallingHandlers({ do.call(example, list(topic=x, package=packageName)); checkTrue(TRUE); },
+                                                  warning=function(w) { checkIdentical(NULL, w) }),
+                              error=function(w) checkIdentical(NULL, w)))
+    attr(result, 'unit') <- 'check.man'
+    attr(result, 'name') <- x
+    result
+  })
 }

Modified: pkg/svUnit/R/svTest.R
===================================================================
--- pkg/svUnit/R/svTest.R	2011-09-19 08:49:58 UTC (rev 397)
+++ pkg/svUnit/R/svTest.R	2011-09-19 09:29:01 UTC (rev 398)
@@ -109,8 +109,11 @@
 
 runTest.list <- function(x, ...) {
   ## Run each test in x, giving each test the name it has in x
-  for (i in names(x))
-    runTest(x[[i]], name=i, unit="man")
+  lapply(x, function(item) {
+    unit <- ifelse(is.null(attr(item, "unit")), "**root**", attr(item, "unit"))
+    name <- attr(item, "name")
+    runTest(item, name=name, unit=unit)
+  })
 }
 
 runTest.svTest <- function (x, name = deparse(substitute(x)), objfile = "",