[rkward-cvs] SF.net SVN: rkward:[2554] trunk/rkward/tests/test_framework.R

[tfry at users.sourceforge.net]

Revision: 2554
          http://rkward.svn.sourceforge.net/rkward/?rev=2554&view=rev
Author:   tfry
Date:     2009-06-26 14:58:57 +0000 (Fri, 26 Jun 2009)

Log Message:
-----------
Provide slightly more info in RKTestResult

Modified Paths:
--------------
    trunk/rkward/tests/test_framework.R

Modified: trunk/rkward/tests/test_framework.R
===================================================================
--- trunk/rkward/tests/test_framework.R	2009-06-26 14:38:06 UTC (rev 2553)
+++ trunk/rkward/tests/test_framework.R	2009-06-26 14:58:57 UTC (rev 2554)
@@ -18,8 +18,8 @@
 	)
 
 setClass ("RKTestResult",
-		representation (id = "character", code_match = "logical", output_match = "logical", message_match = "logical", error="logical", passed="logical"),
-		prototype(character(0), id = character (0), code_match = NA, output_match = NA, message_match = NA, error = NA, passed=FALSE),
+		representation (id = "character", code_match = "character", output_match = "character", message_match = "character", error="character", passed="logical"),
+		prototype(character(0), id = character (0), code_match = character (0), output_match = character (0), message_match = character (0), error = character (0), passed=FALSE),
 		validity=function (object) {
 			return (all.equal (length (object at id), length (object at code_match), length (object at output_match), length (object at message_match), length (object at error), length (object at passed)))
 		}
@@ -38,10 +38,10 @@
 
 	for (i in 1:length (object at id)) {
 		cat (format (object at id[i], width=20))
-		cat (format (if (object at code_match[i]) "true" else "FALSE", width=15))
-		cat (format (if (object at output_match[i]) "true" else "FALSE", width=15))
-		cat (format (if (object at message_match[i]) "true" else "FALSE", width=15))
-		cat (format (if (object at error[i]) "TRUE" else "false", width=15))
+		cat (format (object at code_match[i], width=15))
+		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 ("\n")
 	}
@@ -69,7 +69,7 @@
 }
 
 # returns true, if file corresponds to standard.
-rktest.compare.against.standard <- function (file) {
+rktest.compare.against.standard <- function (file, fuzzy=FALSE) {
 	standard_file <- gsub ("^(.*\\/)([^\\/]*)$", "\\1RKTestStandard\\.\\2", file)
 	if (file.exists (file)) {
 		# purge empty files
@@ -78,16 +78,26 @@
 	}
 	if (!file.exists (file)) {
 		# if neither exists, that means both files are empty
-		if (!file.exists (standard_file)) return (TRUE)
+		if (!file.exists (standard_file)) return ("match (empty)")
 	}
 
 	output.diff <- system(paste("diff", shQuote(file), shQuote(standard_file), "2>&1"), intern=TRUE)
-	if (!length (output.diff)) return (TRUE)
-	if ((length (output.diff) == 1) && (!nzchar (output.diff))) return (TRUE)
+	if (!length (output.diff)) return ("match")
+	if ((length (output.diff) == 1) && (!nzchar (output.diff))) return ("match")
 
+	# below: there are *some* differences
+	if (fuzzy) {
+		size <- if (file.exists (file)) file.info (file)$size[1] else 0
+		s_size <- if (file.exists (standard_file)) file.info (standard_file)$size[1] else 0
+
+		# crude test: files should at least have a similar size
+		if ((size < (s_size + 20)) && (size > (s_size - 20))) return ("fuzzy match")
+	}
+
 	print (paste ("Differences between", file, "and", standard_file, ":"))
 	print (output.diff)
-	return (FALSE)
+
+	return ("MISMATCH")
 }
 
 rktest.runRKTest.internal <- function (test, output_file, code_file, message_file) {
@@ -136,14 +146,25 @@
 	message_file <- rktest.file (test at id, ".messages.txt")
 
 	# the essence of the test:
-	result at error <- rktest.runRKTest.internal (test, output_file, code_file, message_file)
+	res.error <- rktest.runRKTest.internal (test, output_file, code_file, message_file)
+	passed <- (res.error == test at expect_error)
+	if (res.error) {
+		if (test at expect_error) result at error <- "expected error"
+		else result at error <- "ERROR"
+	} else {
+		if (test at expect_error) result at error <- "MISSING ERROR"
+		else result at error <- "no"
+	}
 
-	result at output_match = rktest.compare.against.standard (output_file)
+	result at output_match = rktest.compare.against.standard (output_file, test at fuzzy_output)
+	if (result at output_match == "MISMATCH") passed <- FALSE
 	result at message_match = rktest.compare.against.standard (message_file)
+	if (result at message_match == "MISMATCH") passed <- FALSE
 	result at code_match = rktest.compare.against.standard (code_file)
+	if (result at code_match == "MISMATCH") passed <- FALSE
 
-	if ((result at error == test at expect_error) && (result at output_match || test at fuzzy_output) && result at code_match && result at message_match) result at passed = TRUE
-	
+	result at passed <- passed
+
 	result
 }
 


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