gentc.R

# test runner generator from a file with R functions
# some grey magic, <[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
	}))
}

# read test cases
test_ns <- new.env()
tc_data <- paste(readLines("testin.R"), collapse="\n")
eval(parse(text=tc_data), envir=test_ns)
test_cases <- sort(ls(test_ns))
names(test_cases) <- test_cases

# run them!
out <- lapply(test_cases, test_runner)

# generate test driver file
tc_file <- file("runtc.R", "w")
cat("# inlined functions\n", tc_data, "\n\n# begin generated code\n", file=tc_file)
cat("results <- list()\n", file=tc_file)
invisible(lapply(test_cases, function(tc) {
	to <- out[tc][[1]]
	cat("# ",tc, "\n", sep="", file=tc_file)
	if (!is.null(to)) {
		cat("results$", tc, " <- identical(", 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)