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

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

Author: mariotomo
Date: 2011-09-30 08:59:39 +0200 (Fri, 30 Sep 2011)
New Revision: 406

Modified:
   pkg/svUnit/DESCRIPTION
   pkg/svUnit/R/runExamples.R
   pkg/svUnit/man/svTest.Rd
Log:
added an option that allows the user to skip instead of fail missing documentation examples.


Modified: pkg/svUnit/DESCRIPTION
===================================================================
--- pkg/svUnit/DESCRIPTION	2011-09-21 13:38:41 UTC (rev 405)
+++ pkg/svUnit/DESCRIPTION	2011-09-30 06:59:39 UTC (rev 406)
@@ -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-8
+Version: 0.7-9
 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-21 13:38:41 UTC (rev 405)
+++ pkg/svUnit/R/runExamples.R	2011-09-30 06:59:39 UTC (rev 406)
@@ -14,7 +14,7 @@
 ##    along with sciViews.  If not, see <http://www.gnu.org/licenses/>.
 ##
 
-makeTestListFromExamples <- function(packageName, manFilesDir) {
+makeTestListFromExamples <- function(packageName, manFilesDir, skipFailing=FALSE) {
   manPageFiles <- list.files(manFilesDir, pattern="\\.Rd$")
   manPages <- sapply(manPageFiles, function(filename) {
     lines <- readLines(paste(manFilesDir, filename, sep="/"))
@@ -26,10 +26,15 @@
 
   lapply(manPages, function(x) {
     testCall <- call("example", x, packageName)
+    if (skipFailing)
+      onFailure <- function(w) { DEACTIVATED(paste(w, collapse="\n")); checkTrue(FALSE); }
+    else
+      onFailure <- function(w) checkIdentical(NULL, w)
     result <- svTest(function() {
                      tryCatch(withCallingHandlers({ eval(testCall); checkTrue(TRUE); },
-                                                  warning=function(w) { checkIdentical(NULL, w) }),
-                              error=function(w) checkIdentical(NULL, w))})
+                                                  warning=function(w) onFailure(w)),
+                              error=function(w) onFailure(w))
+                   })
     attr(result, 'unit') <- 'rcheck.examples'
     result
   })

Modified: pkg/svUnit/man/svTest.Rd
===================================================================
--- pkg/svUnit/man/svTest.Rd	2011-09-21 13:38:41 UTC (rev 405)
+++ pkg/svUnit/man/svTest.Rd	2011-09-30 06:59:39 UTC (rev 406)
@@ -48,7 +48,7 @@
 	tag = "", msg = "", \dots)
 \method{runTest}{list}(x, \dots)
 
-makeTestListFromExamples(packageName, manFilesDir)
+makeTestListFromExamples(packageName, manFilesDir, skipFailing=FALSE)
 }
 
 \arguments{
@@ -82,6 +82,9 @@
     from which to extract examples. }
   \item{manFilesDir}{ a character string identifying the directory
     holding the manual pages and examples. }
+  \item{skipFailing}{ a logical indicating whether missing or failing
+    documentation examples should be marked as `skipped` instead of as
+    `failure`. }
   \item{\dots}{ further arguments to the method (not used yet). }
 }