[rkward-cvs] SF.net SVN: rkward:[2610] trunk/rkward/tests

tfry at users.sourceforge.net tfry at users.sourceforge.net
Thu Aug 13 13:10:24 UTC 2009


Revision: 2610
          http://rkward.svn.sourceforge.net/rkward/?rev=2610&view=rev
Author:   tfry
Date:     2009-08-13 13:10:24 +0000 (Thu, 13 Aug 2009)

Log Message:
-----------
Use more explicit library-dependecies. This allows to skip tests if required libraries are not installed.
This way we can actually recommend everybody to run the tests (TODO).

Modified Paths:
--------------
    trunk/rkward/tests/import_export_plugins.R
    trunk/rkward/tests/item_response_theory.R
    trunk/rkward/tests/rkward_application_tests.R
    trunk/rkward/tests/test_framework.R

Modified: trunk/rkward/tests/import_export_plugins.R
===================================================================
--- trunk/rkward/tests/import_export_plugins.R	2009-08-11 16:33:00 UTC (rev 2609)
+++ trunk/rkward/tests/import_export_plugins.R	2009-08-13 13:10:24 UTC (rev 2610)
@@ -6,15 +6,13 @@
 
 ## definition of the test suite
 suite <- new ("RKTestSuite", id="import_export_plugins",
+	# place here libraries that are required for *all* tests in this suite, or highly likely to be installed
+	libraries = c ("R2HTML", "datasets"),
 	# initCalls are run *before* any tests. Use this to set up the environment
 	initCalls = list (
 		function () {
-			library ("R2HTML")
-			library ("datasets")
-			library ("foreign")
-		},
-		function () {
 			# prepare some different files for loading
+			library ("datasets")
 			women <- datasets::women
 
 			save (women, file="women.RData")
@@ -61,7 +59,7 @@
 
 			# WARNING: TODO: We don't use the value labels of the third
 			# variable, yet.
-		})
+		}, libraries=c("foreign"))
 	), postCalls = list ()	# like initCalls: run after all tests to clean up. Empty in this case.
 )
 

Modified: trunk/rkward/tests/item_response_theory.R
===================================================================
--- trunk/rkward/tests/item_response_theory.R	2009-08-11 16:33:00 UTC (rev 2609)
+++ trunk/rkward/tests/item_response_theory.R	2009-08-13 13:10:24 UTC (rev 2610)
@@ -3,21 +3,20 @@
 
 ## definition of the test suite
 suite <- new ("RKTestSuite", id="item_response_theory",
+	libraries = c ("R2HTML", "ltm", "eRm"),
         # initCalls are run *before* any tests. Use this to set up the environment
         initCalls = list (
                 function () {
-                        library ("R2HTML")
-                        library ("ltm") # load ltm library (Rasch, 2PL, 3PL)
-                        library ("eRm") # load eRm library (LLTM)
-                },
-                function () {
 			## these are example data sets from the ltm package
+			library ("ltm") # load ltm library (Rasch, 2PL, 3PL)
 			# dichotomous data:
-                        data("LSAT")		# Rasch & 3 parameter model, Cronbach's alpha
+			data("LSAT")		# Rasch & 3 parameter model, Cronbach's alpha
 			data("WIRS")		# 2 parameter model
 			# polytomous data:
 			data("Environment")	# graded response model
+
 			## these are example data sets from the eRm package
+			library ("eRm") # load eRm library (LLTM)
 			# dichotomous data:
 			data("lltmdat1")	# linear logistic test model
 			# polytomous data:

Modified: trunk/rkward/tests/rkward_application_tests.R
===================================================================
--- trunk/rkward/tests/rkward_application_tests.R	2009-08-11 16:33:00 UTC (rev 2609)
+++ trunk/rkward/tests/rkward_application_tests.R	2009-08-13 13:10:24 UTC (rev 2610)
@@ -6,10 +6,11 @@
 
 ## definition of the test suite
 suite <- new ("RKTestSuite", id="rkward_application_tests",
+	# place here libraries that are required for *all* tests in this suite, or highly likely to be installed
+	libraries = c("R2HTML"),
 	# initCalls are run *before* any tests. Use this to set up the environment
 	initCalls = list (
 		function () {
-			library ("R2HTML")
 		}
 	## the tests
 	), tests = list (

Modified: trunk/rkward/tests/test_framework.R
===================================================================
--- trunk/rkward/tests/test_framework.R	2009-08-11 16:33:00 UTC (rev 2609)
+++ trunk/rkward/tests/test_framework.R	2009-08-13 13:10:24 UTC (rev 2610)
@@ -1,6 +1,6 @@
 setClass ("RKTestSuite",
-		representation (id="character", initCalls="list", tests="list", postCalls="list"),
-		prototype(character(0), id=NULL, initCalls=list(), tests=list(), postCalls=list ()),
+		representation (id="character", libraries="character", initCalls="list", tests="list", postCalls="list"),
+		prototype(character(0), id=NULL, libraries=character(0), initCalls=list(), tests=list(), postCalls=list ()),
 		validity=function (object) {
 			if (length (object at id) != 1) return (FALSE)
 			if (length (object at tests) < 1) return (FALSE)
@@ -9,8 +9,8 @@
 	)
 
 setClass ("RKTest",
-		representation (id="character", call="function", fuzzy_output="logical", expect_error="logical"),
-		prototype(character(0), id=NULL, call=function () { stop () }, fuzzy_output=FALSE, expect_error=FALSE),
+		representation (id="character", call="function", fuzzy_output="logical", expect_error="logical", libraries="character"),
+		prototype(character(0), id=NULL, call=function () { stop () }, fuzzy_output=FALSE, expect_error=FALSE, libraries=character(0)),
 		validity=function (object) {
 			if (is.null (object at id)) return (FALSE)
 			return (TRUE)
@@ -42,12 +42,13 @@
 		cat (format (object at output_match[i], width=15))
 		cat (format (object at message_match[i], width=15))
 		cat (format (object at error[i], width=15))
-		cat (format (if (object at passed[i]) "pass" else "FAIL", width=15))
+		cat (format (if (is.na (object at passed[i])) "--skipped--" else if (object at passed[i]) "pass" else "FAIL", width=15))
 		cat ("\n")
 	}
 
 	cat (rep ("-", 96), "\n", sep="")
-	cat (as.character (sum (object at passed)), " / ", as.character (length (object at passed)), " tests passed\n");
+	cat (as.character (sum (object at passed, na.rm=TRUE)), " / ", as.character (sum (!is.na (object at passed))), " tests passed\n")
+	if (sum (is.na (object at passed)) > 0) cat ("(", as.character (sum (is.na (object at passed))), " / ", as.character (length (object at passed)), " tests skipped due to missing libraries)", sep="");
 })
 
 rktest.appendTestResults <- function (objecta, objectb) {
@@ -144,6 +145,20 @@
 	result at id <- test at id
 	if (!validObject (test)) return (result)
 
+	missing_libs <- character(0)
+	for (lib in test at libraries) {
+		if (!suppressWarnings (base::require (lib, character.only=TRUE, quietly=TRUE))) {
+			missing_libs <- c (missing_libs, lib)
+		}
+	}
+	if (length (missing_libs) > 0) {
+		result at output_match <- result at message_match <- result at code_match <- NA_character_
+		result at error <- "missing lib(s)"
+		result at passed <- NA
+		cat ("\nSkipping test \"", test at id, "\" due to missing libraries: \"", paste (missing_libs, collapse="\", \""), "\"\n", sep="")
+		return (result)
+	}
+
 	output_file <- rktest.file (test at id, ".rkout")
 	code_file <- rktest.file (test at id, ".rkcommands.R")
 	message_file <- rktest.file (test at id, ".messages.txt")
@@ -204,6 +219,7 @@
 	rk.sync.global ()	# objects might have been added/changed in the init calls
 
 	for (i in 1:length (suite at tests)) {
+		suite at tests[[i]]@libraries <- c(suite at libraries, suite at tests[[i]]@libraries)
 		try (res <- rktest.runRKTest(suite at tests[[i]]))
 		result <- rktest.appendTestResults (result, res)
 	}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.




More information about the rkward-tracker mailing list