gentc2

# Test runner generator from a file with R functions
# Hannes Muehleisen, <[email protected]>, 2015-04-14

test_runner <- function(fname) {
	invisible(tryCatch ({
		conn <- textConnection("out", "w")
		dput(do.call(fname, envir=test_ns, args=list()), file=conn)
		close(conn)
		out
	}, error=function(e) {
		warning(fname, " produced exception ", e)
		NULL
	}))
}

# this never gets called, but inlined into the result
fuzzident <- function(obj_a, obj_b, numtol=.0001) {
	if (is.null(c(obj_a, obj_b)) || 
		identical(c(obj_a, obj_b), rep(list(names="names"), 2)))
		return(TRUE)
	
	if (length(obj_a) != length(obj_b) || 
		!fuzzident(attributes(obj_a), attributes(obj_b), numtol))
		return(FALSE)
	
	if (typeof(obj_a) == "double")
		return(all(abs(obj_a - obj_b) <= numtol * obj_a))

	if (typeof(obj_a) == "list") {
		for (ele in seq_along(obj_a)) {
			if (!fuzzident(obj_a[[ele]], obj_b[[ele]], numtol)) {
				return(FALSE)
			}
		}
		return(TRUE)
	}
	return(identical(obj_a, obj_b))
}

# accept both files and directory input on command line
tc_files <- sort(unique(unlist(lapply(commandArgs(TRUE) , function(d) {
	lst <- list.files(d, full.names=T, pattern="\\.[R|r]$")
	if (length(lst) > 0) d <- lst
	d[file.exists(d)]
}))))

if (length(tc_files) < 1) {
	stop("Pass me some R files with test functions as --args")
}

tc_file <- file("runtc.R", "w")
cat("# This is a generated file. \n\n",
	"# Fuzzy result comparision function\nfuzzident <- ", 
	paste(deparse(fuzzident), collapse="\n"), "\n\n# Results holder\nresults <- list()\n", file=tc_file, sep="")

# read test cases
test_ns <- new.env()
invisible(lapply(tc_files, function(t) {
	tc_data <- paste(readLines(t), collapse="\n")
	cat("\n# Test functions from ",t,"\n", tc_data, file=tc_file, sep="")
	eval(parse(text=tc_data), envir=test_ns)
}))

test_cases <- ls(test_ns)
names(test_cases) <- test_cases
# run test cases!
out <- lapply(test_cases, test_runner)

cat("\n\n# begin generated code\n", file=tc_file, sep="")
invisible(lapply(test_cases, function(tc) {
	to <- out[tc][[1]]
	cat("# ",tc, "\n", sep="", file=tc_file)
	if (!is.null(to)) {
		cat("results$", tc, " <- fuzzident(", tc, "(), ",
			to , ")\n", sep="", file=tc_file)
	} else {
		cat("results$", tc, " <- {fail <- F; tryCatch({", tc, "()}, error=function(e){fail <<- TRUE}); fail}\n", sep="", file=tc_file)
	}
	cat("\n", sep="", file=tc_file)
}))

cat("print(data.frame(name=names(results), result=as.logical(results)))\n",  file=tc_file)
close(tc_file)
message("OK, wrote runtc.R")