Check the test coverage for R scripts

checkTestCoverage.R

#' Extract calls to functions 
#' 
#' Extracts function and file names for functions from a set of files 
#' 
#' @param path a directory path to files to be examined
#' @param regexp a regular expression to find function calls
#' @param fileRegexp a regular expression for files to be examined (e.g. '.R$')
#' @param verbose a boolean whether to print debugging information
#'  
#' @return a data.frame with two columns: 'function', the name of the function and
#'   'file', the file that contains the function
extractFunctionCalls <- function(path, regexp, fileRegexp, verbose=FALSE) {
	results <- NULL 
	
	files <- list.files(path, pattern=fileRegexp, recursive=TRUE)
	
	if(verbose) {
		str(files)
	}
	
	for(file in files) {
		con <- file(file.path(path, file)) 
		
		lineTmp <- readLines(con, warn=FALSE)
		
		for (i in 1:length(lineTmp)) {
			line <- lineTmp[i]
			
			if(grepl(regexp, line)) {
				
				if(verbose) {
					cat("Line: ", line, "\n")
				}
				
				tmp <- strsplit(line, " ")[[1]][1]	
				results <- rbind(results, c(tmp, file))
			}	
		}
		
		close(con)
	}
	
	results <- as.data.frame(results, stringsAsFactors=FALSE)
	colnames(results) <- c("function", "file")
	
	return(results)
}

#' Check Whether Function Is Called 
#' 
#' Checks whether a function is called in any of a set of files 
#' 
#' @param path a directory path to files to be examined
#' @param regexp a regular expression to find function calls
#' @param fileRegexp a regular expression for files to be examined (e.g. '.R$')
#' @param verbose a boolean whether to print debugging information
#'  
#' @return a vector of booleans as to whether the input functions were called
isFunctionCalled <- function(path, regexp, fileRegexp, verbose=FALSE) {
	results <- FALSE 
	
	files <- list.files(path, pattern=fileRegexp, recursive=TRUE)
	
	if(verbose) {
		str(files)
	}
	
	for(file in files) {
		con <- file(file.path(path, file)) 
		
		lineTmp <- readLines(con, warn=FALSE)
		
		for (i in 1:length(lineTmp)) {
			line <- lineTmp[i]
			
			if(grepl(paste0(regexp, "\\("), line)) {
				
				if(verbose) {
					cat("Line: ", line, "\n")
				}
				
				results <- TRUE
			}	
		}
		
		close(con)
	}
	
	return(results)
}

rPath <- "R"
testPath <- "inst/tests"

functionRegexp <- "^[a-z].*<-.*function\\(.*"
functionDelimiter <- " "
functionFileRegexp <- ".R$"
functions <- extractFunctionCalls(path=rPath, regexp=functionRegexp, fileRegexp=functionFileRegexp)

testFileRegexp <- "^test"

results <- NULL

for(name in functions[,1]) {
	results <- c(results, isFunctionCalled(testPath, name, testFileRegexp))
}

output <- cbind(functions, results)
output <- as.data.frame(output)
colnames(output) <- c("function", "file", "tested")

cat("Code Coverage Percent: ", length(which(as.logical(output$tested))) / nrow(output), "\n")
write.table(output, file="~/results.txt", sep="\t", quote=FALSE, row.names=FALSE)