diff --git a/DESCRIPTION b/DESCRIPTION index 92b74f4..c653393 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,9 +1,9 @@ Package: testr Type: Package -Title: What the Package Does (Title Case) -Version: 0.1.0 -Author: Who wrote it -Maintainer: Who to complain to +Title: R test case generator +Version: 0.1.3 +Author: Github com allr +Maintainer: Parham Solaimani Description: Package aimed at generating testthat compatible tests. License: GPL (>= 2) Imports: @@ -22,5 +22,5 @@ Suggests: rmarkdown, roxygen2 LazyData: TRUE -RoxygenNote: 5.0.1 +RoxygenNote: 6.0.1 VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index b9cd03e..a26a0c9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,12 +1,14 @@ # Generated by roxygen2: do not edit by hand export(clear_decoration) -export(decorate) export(gen_from_code) export(gen_from_function) export(gen_from_package) export(gen_from_source) export(generate) +export(generate_test_cases) +export(generate_test_cases_using) +export(get_tests) export(prune) export(setup_capture) export(start_capture) @@ -16,5 +18,8 @@ export(stop_capture_all) export(testr_options) export(undecorate) export(write_capture) +export(write_captured_tests) +import(devtools) +import(methods) importFrom(Rcpp,evalCpp) useDynLib(testr) diff --git a/R/RcppExports.R b/R/RcppExports.R index 3dce2cc..4a7bc7c 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -1,4 +1,4 @@ -# This file was generated by Rcpp::compileAttributes +# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 WriteCapInfo_cpp <- function(fname, args_env) { diff --git a/R/capture.R b/R/capture.R index 8be9ddb..459be17 100644 --- a/R/capture.R +++ b/R/capture.R @@ -1,17 +1,17 @@ -#' @title Decorates function to capture calls and return values +#' Decorates function to capture calls and return values #' #' @description This function is respinsible for writing down capture information for decorated function calls. #' Replaces the function by decorated function in the global environment #' @param func function name as a character string #' @param package name of package to look for function #' @param verbose if to print additional output -#' @export #' @seealso write_capture #' -decorate <- function(func, package, verbose) { +decorate <- function(func, package, verbose) +{ if (identical(class(library), "function") && getRversion() < '3.3.0') { suppressMessages(trace(library, - exit=quote(if (!missing(package)) testr:::refresh_decoration(package)), + exit = quote(if (!missing(package)) testr:::refresh_decoration(package)), print = FALSE)) } if (!cache$trace_replaced && getRversion() < '3.3.0') { @@ -32,27 +32,31 @@ decorate <- function(func, package, verbose) { return(invisible()) } } - if (package != ".GlobalEnv") + if (package != ".GlobalEnv") { package <- substr(package, 9, nchar(package)) - else + } else { package <- NA + } } - if (is.na(package)) + if (is.na(package)) { isS3 <- is_s3_generic(func) - else + } else { isS3 <- is_s3_generic(func, getNamespace(package)) + } if (isS3) { warning("Not decorating S3 generic") return(invisible()) } - write.call <- call("write_capture", if (is.na(package)) func else paste(package, func, sep=":::"), quote(sys.frame(-4))) #nolint + write.call <- call("write_capture", if (is.na(package)) func else paste(package, func, sep = ":::"), quote(sys.frame(-4))) #nolint + write.call[[1]] <- testr::write_capture tc <- call("trace", func, quote(write.call), print = testr_options("verbose")) hidden <- FALSE - if (!func %in% ls(as.environment(if (is.na(package)) .GlobalEnv else paste("package", package, sep=":")))) { - tc[["where"]] <- call("getNamespace", package) + if (!func %in% ls(as.environment(if (is.na(package)) .GlobalEnv else paste("package", package, sep = ":")))) { + if (!is.na(package)) + tc[["where"]] <- call("getNamespace", package) hidden <- TRUE } if (verbose) { @@ -60,10 +64,10 @@ decorate <- function(func, package, verbose) { } else { suppressMessages(eval(tc)) } - .decorated[[func]] <- list(func=func, package=package, hidden=hidden) + .decorated[[func]] <- list(func = func, package = package, hidden = hidden) } -#' @title undecorate function +#' undecorate function #' #' @description Reset previously decorate function #' @param func function name as a character string @@ -71,7 +75,8 @@ decorate <- function(func, package, verbose) { #' @export #' @seealso write_capture Decorate #' -undecorate <- function(func, verbose) { +undecorate <- function(func, verbose) +{ if (class(func) == "character"){ fname <- func } else { @@ -91,10 +96,10 @@ undecorate <- function(func, verbose) { } else { suppressMessages(do.call(untrace, params)) } - rm(list=c(func), envir=.decorated) + rm(list = c(func), envir = .decorated) } -#' @title Write down capture information +#' Write down capture information #' #' @description This function is respinsible for writing down capture information for decorated function calls. #' @param fname function name @@ -104,13 +109,14 @@ undecorate <- function(func, verbose) { #' @importFrom Rcpp evalCpp #' @export #' -write_capture <- function(fname, args.env){ +write_capture <- function(fname, args.env) +{ if (!testr_options("capture.arguments")) return(NULL) .Call("testr_WriteCapInfo_cpp", PACKAGE = "testr", fname, args.env) } -#' @title Setup information capturing for list of function +#' Setup information capturing for list of function #' #' @description This function is respinsible for setting up capturing for functions #' @@ -119,7 +125,8 @@ write_capture <- function(fname, args.env){ #' @param verbose if to print additional status information #' @seealso Decorate #' @export -setup_capture <- function(flist, package, verbose = testr_options("verbose")) { +setup_capture <- function(flist, package, verbose = testr_options("verbose")) +{ old <- testr_options("capture.arguments") if (old) testr_options("capture.arguments", FALSE) @@ -131,14 +138,15 @@ setup_capture <- function(flist, package, verbose = testr_options("verbose")) { testr_options("capture.arguments", TRUE) } -#' @title Check if function is eligible for wrapping to capture arguments and return values +#' Check if function is eligible for wrapping to capture arguments and return values #' #' @description This function checks that supplied function for capture is not a keyword, operator or in the blacklist (functions like rm, .GlobalEnv, etc.) #' This is an internal function and is supposed to be used in setup_capture #' @param func function name to check #' @return TRUE/FALSE if can be captured or not #' @seealso setup_capture -eligible_capture <- function(func){ +eligible_capture <- function(func) +{ return (!length(utils::getAnywhere(func)$objs) == 0 && class(utils::getAnywhere(func)[1]) == "function" && !func %in% blacklist @@ -150,13 +158,14 @@ eligible_capture <- function(func){ } -#' @title Clear decoration +#' Clear decoration #' #' @description Clear anything previously decorate #' @param verbose if to print additional debugging information. Default \code{TRUE}. #' @seealso undecorate #' @export -clear_decoration <- function(verbose) { +clear_decoration <- function(verbose) +{ for (fname in ls(.decorated, all.names = TRUE)) undecorate(fname, verbose = verbose) } diff --git a/R/generate.R b/R/generate.R index 0067927..3424bf4 100644 --- a/R/generate.R +++ b/R/generate.R @@ -1,14 +1,13 @@ -#' @title Test Case generator based on capture files +#' Test Case generator based on capture files #' #' @description This function works with the trace information generated by instrumented GNU-R. -#' #' It is strictly oriented to that, please see readme for more information. -#' #' @param root a directory containg capture information or capture file #' @param output_dir directory where generated test cases will be saved -#' @param verbose wheater display debug output #' @param timed whether result is dependent on time of generation -test_gen <- function(root, output_dir, timed = F, verbose=testr_options("verbose")) { +#' @param verbose wheater display debug output +test_gen <- function(root, output_dir, timed = FALSE, verbose = testr_options("verbose")) +{ if (verbose) { cat("Output:", output_dir, "\n") cat("Root:", root, "\n") @@ -18,21 +17,21 @@ test_gen <- function(root, output_dir, timed = F, verbose=testr_options("verbose warning("Input dir/file doesn't exist!") return(invisible()) } - if (file.info(root)$isdir){ - all.capture <- lapply(list.files(root, recursive=TRUE, all.files = TRUE), function(x) file.path(root,x)) + if (file.info(root)$isdir) { + all.capture <- lapply(list.files(root, recursive=TRUE, all.files = TRUE), + function(x) file.path(root,x)) } else { all.capture <- root } # output dir checks if (missing(output_dir)) stop("A output directory must be provided!"); if (!file.exists(output_dir) || !file.info(output_dir)$isdir) dir.create(output_dir) - if (timed) - output_dir <- file.path(output_dir, format(Sys.time(), "%Y-%m-%d %H:%M:%S")) + if (timed) output_dir <- file.path(output_dir, format(Sys.time(), + "%Y-%m-%d %H:%M:%S")) cache$output_dir <- output_dir # bad.arguments file to store incorrect arguments cache$bad_argv <- file.path(cache$output_dir, "bad_arguments"); - if (!file.exists(cache$bad_argv) - && !file.create(cache$bad_argv)) + if (!file.exists(cache$bad_argv) && !file.create(cache$bad_argv)) stop("Unable to create file: ", cache$bad_argv) cache$tid <- list() Map(function(x) { process_capture(x) }, all.capture) @@ -41,40 +40,50 @@ test_gen <- function(root, output_dir, timed = F, verbose=testr_options("verbose cache$bad_argv <- NULL } -#' @title Manage Test Case file +#' Manage Test Case file #' #' @description This function creates a test case file if one does not exist already #' @param name directory where generated test cases will be saved +#' @param funHash hash of function name and function arguments #' @seealso test_gen -ensure_file <- function(name) { +ensure_file <- function(name, funHash) +{ fname <- gsub(.Platform$file.sep, "sep", name) # replace ::: with ___ so that we work on Windows too fname <- gsub(":::", "___", fname) + # check if the folder for the function exists and create it if not tc.folder = file.path(cache$output_dir, fname, fsep = .Platform$file.sep) dir.create(tc.folder, showWarnings = FALSE) + # get the index of the file, based on number of files in the folder (but use the cache information for it) - cache$tid[[name]] <- ifelse(is.null(cache$tid[[name]]), 0, cache$tid[[name]] + 1) - tc.file = file.path(tc.folder, paste("test-", cache$tid[[name]], ".R", sep=""), fsep = .Platform$file.sep) - # the file should not exist - if (!file.create(tc.file)) - stop("Unable to create file: ", tc.file) + cache$tid[[name]] <- ifelse(is.null(cache$tid[[name]]), 0, + cache$tid[[name]] + 1) + tc.file = file.path(tc.folder, paste("test.", gsub("___", ".", fname), ".", + funHash, ".R", sep = ""), + fsep = .Platform$file.sep) + # TODO perhaps this is not needed for testthat - write("library(testthat)\n", file = tc.file, append = TRUE) - # write context information (the function name) - write(paste("context(\"",name,"\")\n", sep=""), file = tc.file, append = TRUE) + if (!file.exists(tc.file)) { + file.create(tc.file) + write("library(hamcrest)\n", file = tc.file, append = TRUE) + } else { + tc.file <- "REPLICATED_TEST_CASE" + } + return(tc.file) } -#' @title Process File with Closure capture information +#' Process File with Closure capture information #' #' @description This function parses file with closure capture information and generates test cases #' @param cap_file path to closure capture file -process_capture <- function(cap_file){ +process_capture <- function(cap_file) +{ lines <- readLines(cap_file) cache$i <- 1 - while (cache$i < length(lines)){ + while (cache$i < length(lines)) { # read test case information symbol.values <- read_symbol_values(lines) symb <- symbol.values[[1]] @@ -82,16 +91,20 @@ process_capture <- function(cap_file){ func <- read_value(lines, kFuncPrefix) args <- read_value(lines, kArgsPrefix) - tc.file <- ensure_file(func) + d_func_arg <- digest::digest( paste0(digest::digest(func), digest::digest(args)) ) + + tc.file <- ensure_file(func, d_func_arg) feedback <- generate_tc(symb, vsym, func, args) #### see what we get if (feedback$type == "err") { #### the captured information is not usable - write(feedback$msg, file=cache$bad_argv, append=TRUE); + write(feedback$msg, file = cache$bad_argv, append = TRUE); + } else if (tc.file == "REPLICATED_TEST_CASE") { + print(tc.file) } else if (feedback$type == "src") { #### good, we get the source code - write(feedback$msg, file=tc.file, append=TRUE); + write(feedback$msg, file = tc.file, append = TRUE); } else { stop("Not reached!"); } @@ -99,15 +112,15 @@ process_capture <- function(cap_file){ } } - -read_symbol_values <- function(lines){ +read_symbol_values <- function(lines) +{ k_sym <- 1 k_value <- 1 symb <- vector() vsym <- vector() symb[k_sym] <- "" vsym[k_value] <- "" - while (starts_with(kSymbPrefix, lines[cache$i])){ + while (starts_with(kSymbPrefix, lines[cache$i])) { symb[k_sym] <- paste(symb[k_sym], substr_line(lines[cache$i]), sep = "") cache$i <- cache$i + 1 k_sym <- k_sym + 1 @@ -121,7 +134,8 @@ read_symbol_values <- function(lines){ return(list(symb, vsym)) } -read_value <- function(lines, prefix){ +read_value <- function(lines, prefix) +{ value <- vector() j <- cache$i while (starts_with(prefix, lines[j])){ @@ -129,10 +143,10 @@ read_value <- function(lines, prefix){ j <- j + 1 } cache$i <- j - return(paste(value, collapse="\n", sep="")) + return(paste(value, collapse = "\n", sep = "")) } -#' @title Generates a testcase for closure function +#' Generates a testcase for closure function #' #' @description This function generates a test case for builtin function using supplied arguments. All elements should be given as text. #' @param symb symbols to be initialized before the call @@ -140,7 +154,15 @@ read_value <- function(lines, prefix){ #' @param func function name #' @param argv input arguments for a closure function call #' @seealso test_gen ProcessClosure -generate_tc <- function(symb, vsym, func, argv) { +generate_tc <- function(symb, vsym, func, argv) +{ + # Fixup specials + if(func == "base::[") { + func <- "`[`" + } else if(func == "base::[[") { + func <- "`[[`" + } + # check validity of symbol values and construct part of the test invalid.symbols <- vector() variables <- "" @@ -162,57 +184,84 @@ generate_tc <- function(symb, vsym, func, argv) { valid.argv <- parse_eval(argv) # proper argument should always be packed in a list - if (!valid.argv) - return(list(type="err", msg=paste("func:", func, "\nargv:", argv, "\n"))) + if (!valid.argv) { + return(list(type = "err", msg = paste("func:", func, "\nargv:", argv, "\n"))) + } # TODO: potentially good arguments, alter it # argv.obj.lst <- alter.arguments(argv.obj); + deparsec <- c("hexNumeric", "showAttributes", "keepInteger") call <- "" args <- eval(parse(text=argv)); if (length(args) > 0) { - args <- lapply(args, function(x) paste(deparse(x), collapse = "\n")) + args <- lapply(args, function(x) paste(deparse(x, control = deparsec), collapse = "\n")) if (!is.null(names(args)) && length(names(args)) == length(args)) { call.args <- "" arg_names <- names(args) for (i in 1:length(args)) { - if (arg_names[i] != "") - call.args <- paste(call.args, arg_names[i], "=", sep = "") - call.args <- paste(call.args, args[[i]], ",", sep="") + if (arg_names[i] != "") { + call.args <- paste(call.args, arg_names[i], "=", sep = "") + } + call.args <- paste(call.args, args[[i]], ",", sep = "") } call.args <- substr(call.args, 1, nchar(call.args) - 1) - call <- paste(call, sprintf("%s(%s)", func, call.args), "\n", sep="") - } else - call <- paste(call, sprintf("%s(%s)", func, paste(args, collapse=",")), "\n", sep="") + call <- paste(call, sprintf("%s(%s)", func, call.args), "\n", sep = "") + } else { + call <- paste(call, sprintf("%s(%s)", func, paste(args, collapse=",")), "\n", sep = "") + } } else { - call <- paste(call, func, "()", "\n", sep="") + call <- paste(call, func, "()", "\n", sep = "") } - if (length(symb) > 0 && symb[1] != "") - call <- paste(variables, call, sep="") + if (length(symb) > 0 && symb[1] != "") { + call <- paste(variables, call, sep = "") + } cache$warns <- NULL cache$errs <- NULL - retv <- withCallingHandlers(tryCatch(eval(parse(text=call), envir = new.env()), - error=function(e) cache$errs <- e$message, silent = TRUE), - warning=function(w) { - cache$warns <- ifelse(is.null(cache$warns), w$message, paste(cache$warns, w$message, sep="; ")) + retv <- withCallingHandlers(tryCatch( eval(parse(text = call), envir = new.env()), + error = function(e) cache$errs <- e$message, silent = TRUE), + warning = function(w) { + cache$warns <- ifelse(is.null(cache$warns), w$message, paste(cache$warns, w$message, sep = "; ")) invokeRestart("muffleWarning") }) retv <- quoter(retv) # testhat formatter - src <- paste("test_that(", shQuote(cache$tid[[func]]), ", {\n") - if (! is.null(cache$errs)) { - call <- paste("expect_error({\n", call, "}\n,", shQuote(cache$errs), ")") - } else { - src <- paste(src, "\nexpected <-", paste(deparse(retv), collapse = "\n"), "\n") - call <- paste("expect_equal({", call, "}, expected)") + src <- "" + if (is.null(cache$errs) && is.null(cache$warns)) { + src <- paste(src, "expected <-", paste(deparse(retv, control = deparsec), collapse = "\n"), "\n") + call <- paste("\n\nassertThat(", call, ", identicalTo( expected, tol = 1e-6 ) )", sep = "") } - if (! is.null(cache$warns)) { - call <- paste("expect_warning(", call, ", ", shQuote(cache$warns), ")") + + src <- paste(src, call) + list(type = "src", msg = src); +} + +#' writeCapturedTests +#' @description creates an archive of generated test cases +#' @param path path to store the archive +#' @export +write_captured_tests <- function(path) +{ + stop_capture_all() + generate("capture") + if (is.null(testEnv$root)) + set_root(getwd()) + set_capt_dir(file.path(testEnv$root,"capture")) + + #tc <- remove_failing_tcs() + dirs <- list.dirs(testEnv$capt_dir, recursive = FALSE) + + if (length(grep("___", dirs))) { + if (!dir.exists(file.path(testEnv$root, path))) + dir.create(file.path(testEnv$root, path)) + for (dir in dirs[grep("___", dirs)]) { + zip_call <- paste0("tar -czvf ", file.path(testEnv$root, path), "/test.", + sub("___", ".", basename(dir)), + ".tar.gz -C ", dir, " .") + system(zip_call) + } } - src <- paste(src, call, "\n})") - src = deparse(parse(text = src)[[1]]) - list(type="src", msg=src); } diff --git a/R/helpers.R b/R/helpers.R index 3188544..a1fc783 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -1,30 +1,33 @@ -#' @title Check if function is S3 generic +#' Check if function is S3 generic #' #' @description Determine if function has a call to UseMethod. In that case there is no need to capture it. #' @param fname function name #' @param env environment to check aganist. Default \code{.GlobalEnv} #' @seealso Decorate -is_s3_generic <- function(fname, env=.GlobalEnv) { +is_s3_generic <- function(fname, env=.GlobalEnv) +{ f <- get(fname, mode = "function", envir = env) if (is.null(body(f))) return(FALSE) uses <- codetools::findGlobals(f, merge = FALSE)$functions any(uses == "UseMethod") } -#' @title Clean temporary directory +#' Clean temporary directory #' #' @description Make sure temp dir is empty by deleting unnecessary files -clean_temp <- function() { +clean_temp <- function() +{ for (file in list.files(cache$temp_dir, full.names = TRUE, pattern = "\\.RData|\\.[rR]$")) { file.remove(file) } } -#' @title Parse and evaluate +#' Parse and evaluate #' #' @description Function that wraps parse(eval(...)) call with tryCatch #' @param what text to be parse and evaluate -parse_eval <- function(what) { +parse_eval <- function(what) +{ tryCatch({ eval(parse(text=what)) TRUE @@ -34,11 +37,12 @@ parse_eval <- function(what) { }) } -#' @title Quote language from evaluation +#' Quote language from evaluation #' #' @description In certain cases, language arguments (like calls), need to be quoated #' @param arg list of arguments -quoter <- function(arg) { +quoter <- function(arg) +{ if (is.list(arg)) { org.attrs <- attributes(arg) res <- lapply(arg, function(x) if(is.language(x)) enquote(x) else quoter(x)) @@ -48,12 +52,13 @@ quoter <- function(arg) { else arg } -#' @title Removes prefixes and quote from line +#' Removes prefixes and quote from line #' #' @description Used for processing capture file information. Deletes prefixes to get essential information #' @param l input line #' @seealso ProcessClosure -substr_line <- function(l){ +substr_line <- function(l) +{ if (grepl("^quote\\(", l)){ ret.line <- strsplit(l, "\\(")[[1]][2]; if (substr(ret.line, nchar(ret.line), nchar(ret.line)) == ")") @@ -64,22 +69,24 @@ substr_line <- function(l){ ret.line } -#' @title Check line's starting prefix +#' Check line's starting prefix #' @description Check if line starts with prefix #' #' @param prefix prefix #' @param x text to be checked #' @seealso GenerateTC -starts_with <- function(prefix, x) { +starts_with <- function(prefix, x) +{ grepl(paste("^", prefix, sep=""), x) } -#' @title Find test directory for package +#' Find test directory for package #' #' @description Find a known test location for the package #' @param path package path #' @seealso CapturePackage -find_tests <- function(path) { +find_tests <- function(path) +{ testthat <- file.path(path, "tests", "testthat") if (file.exists(testthat) && file.info(testthat)$isdir) { return(testthat) @@ -92,14 +99,15 @@ find_tests <- function(path) { return(NULL) } -#' @title Reassing object in the namespace +#' Reassing object in the namespace #' #' @description Record that particual line was executed. #' Used in statement coverage, needed for namespace replacement #' @param name name of an object to be replaced #' @param obj object that will be put in the environment #' @param env environment to be replaced in -reassing_in_env <- function(name, obj, env) { +reassing_in_env <- function(name, obj, env) +{ if (exists(name, env)) { if (bindingIsLocked(name, env)) { unlockBinding(name, env) @@ -111,13 +119,14 @@ reassing_in_env <- function(name, obj, env) { } } -#' @title Get function name without special characters +#' Get function name without special characters #' #' @description This function is respinsible for extractng function name from test file name and removing special characters #' @param filename filename to be processed #' @param modify.characters if special characters should be removed #' -extract_func_name <- function(filename, modify.characters = TRUE){ +extract_func_name <- function(filename, modify.characters = TRUE) +{ fname <- filename if (grepl(".[rR]$", filename)) { fname <- gsub("(.*)tc_(.*)_(.*).R", "\\2", filename) @@ -138,52 +147,46 @@ extract_func_name <- function(filename, modify.characters = TRUE){ fname } - -#' @title Parse function names from objects +#' Parse function names from objects #' @description Parses given function names to a list of name, package characters. #' If package is not specified, NA is returned instead of its name. #' #' @param ... Functions either as character vectors, or package:::function expressions. #' @return List of parsed package and function names as characters. -parseFunctionNames <- function(...) { - args <- as.list(substitute(list(...)))[-1] - i <- 1 - result <- list() - result[length(args)] <- NULL - while (i <= length(args)) { - tryCatch({ - x <- eval(as.name(paste("..",i,sep=""))) - if (is.character(x)) { - # it is a character vector, use its value - x <- strsplit(x, ":::")[[1]] - if (length(x) == 1) { - x <- strsplit(x, "::")[[1]] - if (length(x) == 1) - x <- list(NA, x) - } - if (x[[2]] == "") - x[[2]] <- ":::" - result[[i]] <- c(name = x[[2]], package = x[[1]]) - } else { - stop("Use substitured value") - } - }, error = function(e) { - a <- args[[i]] - if (is.name(a)) { - result[[i]] <<- c(name = as.character(a), package = NA) - } else if (is.language(a) && length(a) == 3 && a[[1]] %in% c(as.name(":::"), as.name("::"))) { - result[[i]] <<- c(name = as.character(a[[3]]), package = as.character(a[[2]])) +parseFunctionNames <- function(...) +{ + args <- unlist(list(...)) + res <- list() + getInfo <- function(vector, arg, special) { + info <- c() + if (length(vector) > 2) { + warning( sprintf("Invalid function name: %s\n", arg ) ) + info <- c(NA, NA) + } else if (length(vector) == 2) { + info <- unlist( ifelse(nchar(vector[1]) == 0, list(c(NA, vector[2])), list(vector)) ) + } else { + info <- unlist( ifelse(nchar(vector) == 0, list(c(NA, special)), list(c(NA, vector[1]))) ) + } + names(info) <- c("package","name") + list(info) + } + for (arg in args) { + if (is.character(arg)) { + x <- strsplit(arg, ":::")[[1]] + y <- strsplit(arg, "::")[[1]] + if (length(x) == 1 & nchar(x[1]) > 0) { + res <- c(res, getInfo(y, arg, "::")) } else { - print("error") - stop(paste("Invalid argument index", i)); + res <- c(res, getInfo(x, arg, ":::")) } - }) - i <- i + 1 + } else { + stop("Function names should be provided as character string!") + } } - result + res } -#' @title Returns names of functions defined in given file(s) +#' Returns names of functions defined in given file(s) #' #' @description Analyses given file, or files if directory #' is supplied for all functions defined in global scope and returns their names as character vector. @@ -191,7 +194,8 @@ parseFunctionNames <- function(...) { #' @param src.root A source file to be analyzed, or a directory containing source files (*.R or *.r) to be analyzed. #' @param recursive TRUE if subdirectories should be scanned too. #' @return Character vector of function names defined in the file. -list_functions <- function(src.root, recursive = TRUE) { +list_functions <- function(src.root, recursive = TRUE) +{ functions = character() if (file.info(src.root)$isdir) src.root <- list.files(src.root, pattern = "[rR]$", recursive = recursive, full.names = T) @@ -210,15 +214,18 @@ list_functions <- function(src.root, recursive = TRUE) { functions } -split_path <- function(path) { +split_path <- function(path) +{ setdiff(strsplit(path,"/|\\\\")[[1]], "") } -extract_example <- function(ex) { +extract_example <- function(ex) +{ sapply(ex, function(x) x[[1]]) } -example_code <- function(fromFile) { +example_code <- function(fromFile) +{ code <- tools::parse_Rd(fromFile) code <- code[sapply(code, function(x) attr(x, "Rd_tag") == "\\examples")] result = "" @@ -226,3 +233,4 @@ example_code <- function(fromFile) { result = c(result, extract_example(cc)) result } + diff --git a/R/methods_replacements.R b/R/methods_replacements.R index e545e36..b8898dd 100644 --- a/R/methods_replacements.R +++ b/R/methods_replacements.R @@ -268,7 +268,8 @@ TraceWithMethods <- function (what, tracer = NULL, exit = NULL, at = numeric(), what } -getImportsEnv <- function(pkg) { +getImportsEnv <- function(pkg) +{ iname = paste("imports:", pkg, sep="") empty = emptyenv() env = asNamespace(pkg) @@ -280,14 +281,16 @@ getImportsEnv <- function(pkg) { NULL } -updateInImportsEnv <- function(what, newFun, importingPkg) { +updateInImportsEnv <- function(what, newFun, importingPkg) +{ where = getImportsEnv(importingPkg) if (!is.null(where) && (what %in% names(where))) { methods:::.assignOverBinding(what, newFun, where, FALSE) } } -replace_trace <- function() { +replace_trace <- function() +{ assign(".TraceWithMethods", as.environment("package:methods")) unlockBinding(".TraceWithMethods", getNamespace("methods")) environment(TraceWithMethods) <- getNamespace("methods") @@ -296,17 +299,17 @@ replace_trace <- function() { cache$trace_replaced <- TRUE } -#' @title Refresh decoration +#' Refresh decoration #' #' @description In cases when a function that is being traced is used through imports namespace #' by a package that is being loaded, the package won't get the correct copy, which results in #' the information loss. This function is hooked up to the library, to be run upon exist and #' check what functions might need redecoration, to propagate correct version to imports namespace. #' @param pkg package -refresh_decoration <- function(pkg) { +refresh_decoration <- function(pkg) +{ ienv <- getImportsEnv(pkg) need_redecoration <- intersect(ls(ienv), names(.decorated)) sapply(need_redecoration, undecorate) sapply(need_redecoration, decorate) } - diff --git a/R/runTests.R b/R/runTests.R new file mode 100644 index 0000000..db333e5 --- /dev/null +++ b/R/runTests.R @@ -0,0 +1,271 @@ + + +#' Runs all available source code from a package in order to generate +#' usable tests. +#' +#' @param pkg the name of the package (must be installed) +#' @param flist list of functions to instrument for capture +#' @param output.dir directory to write all harnes scripts, tests, and generated content. +run_package <- function(pkg, flist, output.dir = getwd(), validation.cache = new.env(), skip.existing = TRUE) { + + cat(sprintf("Package %s:\n", pkg)) + + # Create a folder for test output, deleting it + # if it already exists + pkg.output.dir <- file.path(output.dir, "packages", pkg) + if(dir.exists(pkg.output.dir)) { + if(skip.existing) { + cat(sprintf(" Already done, skipping.\n")) + return(NULL) + } else { + unlink(pkg.output.dir, recursive = TRUE) + } + } + dir.create(pkg.output.dir, recursive = TRUE) + + # Run package examples + run_package_examples(pkg, flist, pkg.output.dir) + + # Run test scripts + package.dir <- find.package(pkg) + testScripts <- list.files(file.path(package.dir, "tests"), pattern = ".+\\.[RSrs]$", full.names = TRUE) + + for(script in testScripts) { + run_package_source(pkg, flist, script, pkg.output.dir) + } + + validate_tests(capture.dir = file.path(pkg.output.dir, "captured"), + validated.test.dir = file.path(output.dir, "validated"), + cache = validation.cache) +} + +#' Executes a script in an independent R session and stores the output in the +#' package working directory. +#' +#' @param pkg the name of the package (must be installed) +#' @param source.file the full path of the source file to execute +#' @param flist list of functions to intrument +#' @param output.dir the output dir to write capture tests and output +run_package_examples <- function(pkg, flist, output.dir, validation.cache) { + + cat(sprintf(" Running Examples... ")) + + script <- c( + "library(testr)", + sprintf("library(%s)", pkg), + sprintf("setwd('%s')", output.dir), + sprintf("start_capture(%s)", paste(deparse(flist), collapse="")), + sprintf("example(%s)", pkg), + sprintf("generate('%s')", file.path(output.dir, "captured")) + ) + + harnessScript <- file.path(output.dir, "examples.R") + writeLines(script, harnessScript) + + scriptOutput = paste(harnessScript, "out", sep=".") + errorCode <- run_script_with_timeout(harnessScript, scriptOutput) + + if(errorCode == 0) { + cat("\n") + } else { + cat(sprintf("ERROR(%d)\n", errorCode)) + } +} + + +#' Executes a script in an independent R session and stores the output in the +#' package working directory. +#' +#' @param pkg the name of the package (must be installed) +#' @param source.file the full path of the source file to execute +#' @param flist list of functions to intrument +#' @param output.dir the output dir to write capture tests and output +run_package_source <- function(pkg, flist, source, output.dir) { + cat(sprintf(" Running %s... ", basename(source))) + + script <- c( + "library(testr)", + sprintf("library(%s)", pkg), + sprintf("setwd('%s')", dirname(source)), + sprintf("start_capture(%s)", paste(deparse(flist), collapse="")), + sprintf("source('%s', echo = TRUE)", basename(source)), + sprintf("generate('%s')", file.path(output.dir, "captured")) + ) + + harnessScript <- file.path(output.dir, basename(source)) + writeLines(script, harnessScript) + + scriptOutput = paste(harnessScript, "out", sep=".") + errorCode <- run_script_with_timeout(harnessScript, scriptOutput) + + if(errorCode == 0) { + cat("\n") + } else { + cat(sprintf("ERROR(%d)\n", errorCode)) + } +} + +#' Spawns a new VM to run the given script and write the output to the given file. +#' +#' If the script does not complete within 90 seconds, it is sent the the TERM signal. +#' If the process does not exit within 5 seconds, it is sent the KILL signal. +run_script_with_timeout <- function(script.file, output.file) { + system2(command = "timeout", + args = c("--kill-after=5s", "90s", "Rscript", script.file), + stdout = output.file, + stderr = output.file) +} + +#' Attempts to run all generated tests to verify that they're actually correct. +#' +#' +validate_tests <- function(capture.dir, validated.test.dir, cache = new.env()) { + + cat(sprintf(" Validating tests...\n")) + + test.files <- list.files(capture.dir, pattern=".+\\.R", full.names = TRUE, recursive = TRUE) + + # Create the validated test dir if doesn't exist + if(!dir.exists(validated.test.dir)) { + dir.create(validated.test.dir) + } + + ok <- 0 + total <- 0 + cacheHits <- 0 + for(test.file in test.files) { + cacheKey <- basename(test.file) + cached <- cache[[cacheKey]] + if(!is.null(cached)) { + cacheHits <- cacheHits + 1 + } else { + + if(file.size(test.file) > (1024 * 20)) { + valid <- FALSE + } else { + test.output <- paste0(test.file, ".out") + exitCode <- system2("timeout", args = c("2s", "Rscript", test.file), + stdout = test.output, + stderr = test.output) + + valid <- (exitCode == 0) + } + cache[[cacheKey]] <- valid + + if(valid) { + file.copy(test.file, file.path(validated.test.dir, basename(test.file))) + ok <- ok + 1 + } + total <- total + 1 + if(total %% 500 == 0) { + cat(sprintf(" Validated %d tests so far...\n", total)) + } + } + } + + cat(sprintf(" Validated %d/%d new tests, %d cached.\n", ok, (length(test.files)-cacheHits), cacheHits)) +} + + + +#' get_tests +#' @description get the names of all generated test cases +#' @param capt_dir location of test cases +#' @export +get_tests <- function(capt_dir) +{ + d <- list.files(capt_dir, pattern = ".R$", recursive = TRUE, + full.names = TRUE) + rm <- grep("^capture", list.files(capt_dir, recursive = TRUE)) + if (length(rm)) + d <- d[-rm] + d +} + +#' generate_test_cases +#' +#' Systematically generates test cases for a given base function by running as many package +#' examples and tests as possible to capture inputs and outputs of functions. Or limited +#' number of packages are used, if a 'limit' argument or 'MAX_PACKAGES_TO_RUN' environment +#' variable is provided, +#' +#' If the functions argument is missing, then the list of functions is read from the +#' environment variable FUNCTIONS +#' +#' @description generates test cases of base functions using package sources +#' @import devtools methods +#' @param functions Comma delimited names of functions to be decorated for test generation. +#' Provided as string vector or through environment variable FUNCTIONS. +#' @param limit max number of packages to be runned for test case generation. Provided as +#' integer or through environment variable MAX_PACKAGES_TO_RUN. +#' @export +generate_test_cases <- function(functions, limit) +{ + # Read from environment if not explicitly provided + if(missing(functions)) { + functions <- strsplit(Sys.getenv("FUNCTIONS"), split="[\\s,]+", perl = TRUE)[[1]] + functions <- functions[ nzchar(functions) > 0 ] + if(length(functions) == 0) { + stop("No functions provided. Set the FUNCTIONS environment variable with a comma-delimited list of functions") + } + } + if(missing(limit)) { + limit <- strsplit(Sys.getenv("MAX_PACKAGES_TO_RUN"), split="[\\s,]+", perl = TRUE)[[1]] + limit <- limit[ nzchar(limit) > 0 ] + if(length(limit) == 0) { + limit = 0 + } else { + limit = as.integer(limit[1]) + } + } + + cat(sprintf("function: %s\n", functions)) + if(limit) cat(sprintf("Number of packages to use: %s\n", limit)) + + packages <- installed.packages()[, 1] + if(limit) packages <- packages[1:limit] + + # Set up validation cache and output dir + validation.cache <- new.env(hash = TRUE) + + for(pkg in packages) { + run_package(pkg, functions, validation.cache = validation.cache) + } +} + +#' generate_test_cases_using +#' +#' @description Generates test cases using the provided packages +#' @import devtools methods +#' @param functions list of functions to annotate for test case generation +#' @param packages list of packages to be used for test case generation +#' @export +generate_test_cases_using <- function(functions, packages) +{ + # Read from environment if not explicitly provided + if(missing(functions)) { + functions <- strsplit(Sys.getenv("FUNCTIONS"), split="[\\s,]+", perl = TRUE)[[1]] + functions <- functions[ nzchar(functions) > 0 ] + if(length(functions) == 0) { + stop("No functions provided. Set the FUNCTIONS environment variable with a comma-delimited list of functions") + } + } + if(missing(packages)) { + packages <- strsplit(Sys.getenv("USE_PACKAGES"), split="[\\s,]+", perl = TRUE)[[1]] + packages <- packages[ nzchar(packages) > 0 ] + if(length(packages) == 0) { + stop("No packages provided. Set the USE_PACKAGES environment variable with a comma-delimited list of package names") + } + } + + cat(sprintf("function(s): %s\n", functions)) + cat(sprintf("packages(s): %s\n", packages)) + + # Set up validation cache and output dir + validation.cache <- new.env(hash = TRUE) + + for(pkg in packages) { + run_package(pkg, functions, validation.cache = validation.cache) + } +} + diff --git a/R/testr.R b/R/testr.R index 532bceb..08820e9 100644 --- a/R/testr.R +++ b/R/testr.R @@ -1,4 +1,4 @@ -#' @title Adds regression tests to specified package. +#' Adds regression tests to specified package. #' #' @description Given a package, the code to be executed and a list of functions to capture, the function captures the selected functions from the package, then runs the specified code. It then generates tests from the captured information and using code coverage filters them against existing tests for the package. Those that increase the code coverage will be added to already existing testthat tests for the package. #' @@ -13,8 +13,12 @@ #' @param verbose Prints additional information. #' @export -gen_from_function <- function(package.dir = ".", code, functions, filter = TRUE, exclude_existing_tests = FALSE, build = TRUE, timed = FALSE, output, verbose = testr_options("verbose")) { - cleanup = F +gen_from_function <- function(package.dir = ".", code, functions, filter = TRUE, + exclude_existing_tests = FALSE, build = TRUE, + timed = FALSE, output, + verbose = testr_options("verbose")) +{ + cleanup = FALSE # stop all ongoing captures stop_capture_all() if (build) { @@ -27,26 +31,21 @@ gen_from_function <- function(package.dir = ".", code, functions, filter = TRUE, package.path = package.dir } # install the package - if (verbose) - cat(paste("Installing package", package.path, "\n")) - #devtools:::install(package.name, quiet = T) - install.packages(package.path, repos = NULL, quiet = T, type = "source") + if (verbose) cat(paste("Installing package", package.path, "\n")) + install.packages(package.path, repos = NULL, quiet = TRUE, type = "source") # get list of all functions package = devtools::as.package(package.dir) # TODO I don't thing this line is needed anymore l <- library - l(package = package$package, character.only = T) - if (verbose) - cat(paste("Package", package$package, "installed\n")) + l(package = package$package, character.only = TRUE) + if (verbose) cat(paste("Package", package$package, "installed\n")) # if function names were not specified, if (missing(functions)) { # get list of all functions defined in the package' R code functions <- list_functions(file.path(package$path, "R")) - if (verbose) - cat("All functions from package will be decorated\n") + if (verbose) cat("All functions from package will be decorated\n") } - if (verbose) - cat(paste("Decorating",length(functions), "functions\n")) + if (verbose) cat(paste("Decorating",length(functions), "functions\n")) # capture all functions in the package for (f in functions) { decorate(f, package$package, verbose = verbose) @@ -62,7 +61,7 @@ gen_from_function <- function(package.dir = ".", code, functions, filter = TRUE, if (missing(output)) { if (filter) { output = "temp" - cleanup = T + cleanup = TRUE } else { output = file.path(package$path, "tests") } @@ -74,17 +73,16 @@ gen_from_function <- function(package.dir = ".", code, functions, filter = TRUE, if (filter) { if (verbose) cat("Pruning tests - this may take some time...\n") - filter_tests(output, file.path(package$path, "tests/testthat"), functions, package.dir, compact = T, verbose = verbose) + filter_tests(output, file.path(package$path, "tests/testthat"), + functions, package.dir, compact = TRUE, verbose = verbose) } # clear the temp folder, if we used a temp folder implicitly - if (cleanup) - unlink(output, recursive = T) - detach(paste("package", package$package, sep=":"), unload = T, character.only = T) + if (cleanup) unlink(output, recursive = T) + detach(paste("package", package$package, sep=":"), unload = TRUE, + character.only = TRUE) } - - -#' @title Generates tests for a package by running the code associated with it. +#' Generates tests for a package by running the code associated with it. #' #' @description Runs the examples, vignettes and possibly tests associated with the package and captures the usage of package's functions. Creates tests from the captured information, filters it according to the already existing tests and if any new tests are found, adds them to package's tests. #' @@ -97,45 +95,52 @@ gen_from_function <- function(package.dir = ".", code, functions, filter = TRUE, #' @param verbose Prints additional information. #' @export #' -gen_from_package <- function(package.dir = ".", include.tests = FALSE, timed = FALSE, filter = TRUE, build = TRUE, output, verbose = testr_options("verbose")) { +gen_from_package <- function(package.dir = ".", include.tests = FALSE, + timed = FALSE, filter = TRUE, build = TRUE, + output, verbose = testr_options("verbose")) +{ package = devtools::as.package(package.dir) devtools::document(package.dir) - detach(paste("package", package$package, sep=":"), unload = T, character.only = T) + detach(paste("package", package$package, sep=":"), unload = TRUE, + character.only = TRUE) f <- function() { # run package vignettes info <- tools::getVignetteInfo(package = package$package) - vdir <- info[,2] - vfiles <- info[,6] + vdir <- info[ ,2] + vfiles <- info[ ,6] p <- file.path(vdir, "doc", vfiles) - if (verbose) - cat(paste("Running vignettes (", length(vfiles), "files)\n")) + if (verbose) cat(paste("Running vignettes (", length(vfiles), "files)\n")) # vignettes are not expected to be runnable, silence errors - invisible(tryCatch(sapply(p, source), error=function(x) invisible())) + invisible( tryCatch( sapply(p, source), error = function(x) invisible() ) ) # run package examples manPath <- file.path(package.dir, "man") - examples <- list.files(manPath, pattern = "\\.[Rr]d$", no.. = T) + examples <- list.files(manPath, pattern = "\\.[Rr]d$", no.. = TRUE) if (length(examples) != 0) { if (verbose) cat(paste("Running examples (", length(examples), "man files)\n")) for (f in examples) { code <- example_code(file.path(manPath, f)) - tryCatch(eval(parse(text = code)), error=function(x) print(x)) + tryCatch(eval(parse(text = code)), error = function(x) print(x)) } } # run tests if (include.tests) { - if (verbose) - cat("Running package tests\n") - testthat::test_dir(file.path(package.dir, "tests", "testthat"), filter = NULL) + if (verbose) cat("Running package tests\n") + testthat::test_dir(file.path(package.dir, "tests", "testthat"), + filter = NULL) } } if (missing(output)) - gen_from_function(package.dir, code = f , filter = filter, exclude_existing_tests = include.tests, build = build, timed = timed, verbose = verbose) + gen_from_function(package.dir, code = f , filter = filter, + exclude_existing_tests = include.tests, build = build, + timed = timed, verbose = verbose) else - gen_from_function(package.dir, code = f , filter = filter, exclude_existing_tests = include.tests, build = build, timed = timed, output, verbose = verbose) + gen_from_function(package.dir, code = f , filter = filter, + exclude_existing_tests = include.tests, build = build, + timed = timed, output, verbose = verbose) } -#' @title Enables capturing of the specified functions. +#' Enables capturing of the specified functions. #' #' @description The functions can be expressed as character literals in the form of either only a function name, #' or package name ::: function name, or directly as a symbol (i.e. only function name, or package name ::: function name). @@ -143,50 +148,55 @@ gen_from_package <- function(package.dir = ".", include.tests = FALSE, timed = F #' @param ... List of functions to capture, either character literals, or symbols #' @param verbose TRUE to display additional information #' @export -start_capture <- function(..., verbose = testr_options("verbose")) { +start_capture <- function(..., verbose = testr_options("verbose")) +{ old <- testr_options("capture.arguments") - if (old) - testr_options("capture.arguments", FALSE) - for (f in parseFunctionNames(...)) + if (old) testr_options("capture.arguments", FALSE) + for (f in parseFunctionNames(...)) { decorate(f[["name"]], f[["package"]], verbose = verbose) - if (old) - testr_options("capture.arguments", TRUE) + } + if (old) testr_options("capture.arguments", TRUE) invisible(NULL) } -#' @title Enables capturing of all builtin functions. +#' Enables capturing of all builtin functions. #' #' @description Wrapper around capture to capture builtin functions #' @param internal.only TRUE if only internal functions should be captured #' @param verbose TRUE to display additional information #' @export -start_capture_builtins <- function(internal.only = FALSE, verbose = testr_options("verbose")) { +start_capture_builtins <- function(internal.only = FALSE, + verbose = testr_options("verbose")) +{ functions <- builtins(internal.only) setup_capture(functions, verbose = verbose) } -#' @title Stops capturing the selected functions. +#' Stops capturing the selected functions. #' #' @description This function removes the tracing functionality for specified function #' @param ... Functions whose capture is to be dropped (uses the same format as capture) #' @param verbose TRUE to display additional information #' @export -stop_capture <- function(..., verbose = testr_options("verbose")) { - for (f in parseFunctionNames(...)) +stop_capture <- function(..., verbose = testr_options("verbose")) +{ + for (f in parseFunctionNames(...)) { undecorate(f$name, f$package, verbose = verbose) + } invisible(NULL) } -#' @title Stops capturing all currently captured functions. +#' Stops capturing all currently captured functions. #' #' @description Remove tracing functionality for all the functions #' @param verbose TRUE to display additional information #' @export -stop_capture_all <- function(verbose = testr_options("verbose")) { +stop_capture_all <- function(verbose = testr_options("verbose")) +{ clear_decoration(verbose = verbose) } -#' @title Generates tests from captured information. +#' Generates tests from captured information. #' #' @description This function takes the tracing information collected by capture and generates #' testthat compatible testcases. @@ -198,16 +208,18 @@ stop_capture_all <- function(verbose = testr_options("verbose")) { #' @param clear_capture if FALSE captured traces will not be deleted after the generation so that subsequent calls to generate() can use them too #' @export generate <- function(output_dir, root = testr_options("capture.folder"), - timed = F, clear_capture = T, verbose = testr_options("verbose")) { + timed = FALSE, clear_capture = TRUE, + verbose = testr_options("verbose")) +{ cache$output.dir <- output_dir test_gen(root, output_dir, timed, verbose = verbose); if (clear_capture) { - unlink(file.path(root, list.files(path = root, no.. = T))) + unlink(file.path(root, list.files(path = root, no.. = TRUE))) } } -#' @title Filter the generated tests so that only tests increasing code coverage will be kept. +#' Filter the generated tests so that only tests increasing code coverage will be kept. #' #' @description This function attempts to filter test cases based on code coverage collected by covr package. #' Filtering is done in iterational way by measuring code coverage of every test separately and skipping the ones @@ -227,7 +239,8 @@ generate <- function(output_dir, root = testr_options("capture.folder"), #' @export prune <- function(test_root, output_dir, ..., package_path = "", remove_tests = FALSE, compact = FALSE, - verbose = testr_options("verbose")) { + verbose = testr_options("verbose")) +{ functions <- parseFunctionNames(...) if (length(functions) && package_path != "") { stop("Both list of functions and package to be filtered aganist is supplied, please use one of the arguments") @@ -240,23 +253,25 @@ prune <- function(test_root, output_dir, ..., fn <- sapply(functions, `[`, 1) functions <- sapply(functions, `[`, 2) names(functions) <- fn - filter_tests(test_root, output_dir, functions, package_path, remove_tests = remove_tests, compact = compact, verbose = verbose) + filter_tests(test_root, output_dir, functions, package_path, + remove_tests = remove_tests, compact = compact, + verbose = verbose) invisible(NULL) } - # helpers ------------------------------------------------------------------------------------------------------------- # TODO these are also in evaluation.R, perhaps evaluation.R should die and its non-api should move to helpers, or someplace else? -#' @title Generate tests for give code +#' Generate tests for give code #' @description Generates tests from given code and specific captured functions #' #' @param code Code from which the tests will be generated. #' @param output_dir Directory to which the tests will be generated. #' @param ... functions to be captured during the code execution (same syntax as capture function) #' @export -gen_from_code <- function(code, output_dir, ...) { +gen_from_code <- function(code, output_dir, ...) +{ code <- substitute(code) start_capture(...) eval(code) @@ -265,24 +280,27 @@ gen_from_code <- function(code, output_dir, ...) { invisible() } -#' @title Generate tests for give source +#' Generate tests for give source #' @description Generates tests by running given source file. #' #' @param src.root Source file to be executed and captured, or directory containing multiple files. #' @param output_dir Directory to which the tests will be generated. #' @param ... Functions to be tested. #' @export -gen_from_source <- function(src.root, output_dir, ...) { - if (!file.exists(src.root)) +gen_from_source <- function(src.root, output_dir, ...) +{ + if (!file.exists(src.root)) { stop("Supplied source does not exist") - if (file.info(src.root)$isdir) - src.root <- list.files(src.root, pattern = "\\[rR]", recursive = T, full.names = T) + } + if (file.info(src.root)$isdir) { + src.root <- list.files(src.root, pattern = "\\[rR]", + recursive = TRUE, full.names = TRUE) + } start_capture(...) - for (src.file in src.root) - source(src.file, local = T) + for (src.file in src.root) { + source(src.file, local = TRUE) + } stop_capture_all() generate(output_dir) invisible() } - - diff --git a/R/zzz.R b/R/zzz.R index a707efd..f8c2801 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -13,18 +13,19 @@ kFuncPrefix <- "func: " kArgsPrefix <- "argv: " blacklist <- c(".GlobalEnv", ".Internal", ".Primitive", "substitute", - ".Machine", "on.exit", - "withCallingHandlers", "quote", - "c", "NextMethod", "UseMethod", "standardGeneric", "identity","missing", - "sys.call", "withVisible", "findRestarts", "local", "withRestarts", "formals", - ".C", ".Call", ".External", ".External.graphics", ".External2", ".Fortran", ".Call.graphics", - "length", "as.environment", - "length<-", "call", "switch", "nargs", "as.numeric", "library.dynam.unload", - "suppressMessages", + ".Machine", "on.exit", "withCallingHandlers", "quote", + "c", "NextMethod", "UseMethod", "standardGeneric", "identity", + "sys.call", "withVisible", "findRestarts", "local", ".Fortran", + ".C", ".Call", ".External", ".External.graphics", ".External2", + "length", "as.environment", "missing", "library.dynam.unload", + "length<-", "call", "switch", "nargs", "as.numeric", + "suppressMessages", "withRestarts", "formals", ".Call.graphics", # errors with trace "match.call", ".doTrace", "tracingState", "traceback", "trace", "get0", "forceAndCall", # added in R.3.2.1 - "library" + "library", + # cause error (Parham) + "?", "unlist" ) sys <- c("system.time", "system.file", "sys.status", @@ -42,7 +43,8 @@ operators <- c("(", ":", "%sep%", "[", "[[", "$", "@", "=", "[<-", primitive_generics_fails <- c(.S3PrimitiveGenerics, "round", "min", "max", "expression", "attr") -.onLoad <- function(libname, pkgname) { +.onLoad <- function(libname, pkgname) +{ # make sure temp_dir is empty cache$temp_dir <- tempdir() clean_temp() @@ -61,7 +63,8 @@ primitive_generics_fails <- c(.S3PrimitiveGenerics, "round", "min", "max", "expr "parallel_tests"=TRUE, "rtests"=FALSE, "rprofile"=' -.First <- function() { +.First <- function() +{ library(testr) library(utils) builtin_capture() @@ -82,7 +85,8 @@ primitive_generics_fails <- c(.S3PrimitiveGenerics, "round", "min", "max", "expr #' @param value value to assign (optional) #' @export #' -testr_options <- function(o, value) { +testr_options <- function(o, value) +{ res <- getOption("testr") if (missing(value)) { ## just querying diff --git a/README.md b/README.md index 5630c18..2d342de 100644 --- a/README.md +++ b/README.md @@ -1,10 +1,7 @@ testR - test case generation for R ===== -[![Build Status](https://travis-ci.org/allr/testr.svg?branch=master)](https://travis-ci.org/allr/testr) -[![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/allr/testr?branch=master&svg=true)](https://ci.appveyor.com/project/allr/testr) -[![Coverage Status](http://codecov.io/github/allr/testr/coverage.svg?branch=master)](http://codecov.io/github/allr/testr?branch=master) -[![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/testr)](http://cran.r-project.org/package=testr) +[![Build Status](http://build.renjin.org/job/Test-Generation/job/testr/badge/icon)](http://build.renjin.org/job/Test-Generation/job/testr/) TestR is a framework for unit tests generation from source code and for test execution, and filtering of test cases based on C code coverage using `gcov` and R code coverage using `rcov` (https://github.com/allr/rcov). diff --git a/man/bioconductor_gen.Rd b/man/bioconductor_gen.Rd deleted file mode 100644 index 088421d..0000000 --- a/man/bioconductor_gen.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/testr.R -\name{bioconductor_gen} -\alias{bioconductor_gen} -\title{Capture run information from Bioconductor packages} -\usage{ -bioconductor_gen(name, dir, funcs = NULL, indexes = 1:1000) -} -\arguments{ -\item{name}{name of the package to be downloaded} - -\item{dir}{resulting directory with tests} - -\item{funcs}{functions to Decorate} - -\item{indexes}{indexes of specific packages} -} -\description{ -This function is responsible for getting all possible capture information from Bioconductor -It tries to insstall package and run tests, examples and vignettes -} - diff --git a/man/capture.Rd b/man/capture.Rd deleted file mode 100644 index ae13753..0000000 --- a/man/capture.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/testr.R -\name{capture} -\alias{capture} -\title{Enables capturing of the specified functions.} -\usage{ -capture(..., verbose = testr_options("verbose")) -} -\arguments{ -\item{...}{List of functions to capture, either character literals, or symbols} - -\item{verbose}{TRUE to display additional information} -} -\description{ -The functions can be expressed as character literals in the form of either only a function name, -or package name ::: function name, or directly as a symbol (i.e. only function name, or package name ::: function name). -} - diff --git a/man/capture_builtins.Rd b/man/capture_builtins.Rd deleted file mode 100644 index 8128736..0000000 --- a/man/capture_builtins.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/testr.R -\name{capture_builtins} -\alias{capture_builtins} -\title{Enables capturing of all builtin functions.} -\usage{ -capture_builtins(internal.only = FALSE, verbose = testr_options("verbose")) -} -\arguments{ -\item{internal.only}{TRUE if only internal functions should be captured} - -\item{verbose}{TRUE to display additional information} -} -\description{ -Wrapper around capture to capture builtin functions -} - diff --git a/man/clean_temp.Rd b/man/clean_temp.Rd index e19c825..8a34570 100644 --- a/man/clean_temp.Rd +++ b/man/clean_temp.Rd @@ -9,4 +9,3 @@ clean_temp() \description{ Make sure temp dir is empty by deleting unnecessary files } - diff --git a/man/clear_decoration.Rd b/man/clear_decoration.Rd index d7b9496..5a92308 100644 --- a/man/clear_decoration.Rd +++ b/man/clear_decoration.Rd @@ -15,4 +15,3 @@ Clear anything previously decorate \seealso{ undecorate } - diff --git a/man/cran_gen.Rd b/man/cran_gen.Rd deleted file mode 100644 index f911df0..0000000 --- a/man/cran_gen.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/testr.R -\name{cran_gen} -\alias{cran_gen} -\title{Capture run information from CRAN packages} -\usage{ -cran_gen(name, dir, funcs = NULL, indexes = 1:10000) -} -\arguments{ -\item{name}{name of the package to be downloaded} - -\item{dir}{resulting directory with tests} - -\item{funcs}{functions to Decorate} - -\item{indexes}{indexes of specific packages} -} -\description{ -This function is responsible for getting all possible capture information from CRAN -It tries to insstall package and run tests, examples and vignettes -} - diff --git a/man/decorate.Rd b/man/decorate.Rd index 4532f49..5862ad3 100644 --- a/man/decorate.Rd +++ b/man/decorate.Rd @@ -20,4 +20,3 @@ Replaces the function by decorated function in the global environment \seealso{ write_capture } - diff --git a/man/eligible_capture.Rd b/man/eligible_capture.Rd index f6d279e..3d02801 100644 --- a/man/eligible_capture.Rd +++ b/man/eligible_capture.Rd @@ -19,4 +19,3 @@ This is an internal function and is supposed to be used in setup_capture \seealso{ setup_capture } - diff --git a/man/ensure_file.Rd b/man/ensure_file.Rd index 6a60326..912d345 100644 --- a/man/ensure_file.Rd +++ b/man/ensure_file.Rd @@ -4,10 +4,12 @@ \alias{ensure_file} \title{Manage Test Case file} \usage{ -ensure_file(name) +ensure_file(name, funHash) } \arguments{ \item{name}{directory where generated test cases will be saved} + +\item{funHash}{hash of function name and function arguments} } \description{ This function creates a test case file if one does not exist already @@ -15,4 +17,3 @@ This function creates a test case file if one does not exist already \seealso{ test_gen } - diff --git a/man/extract_func_name.Rd b/man/extract_func_name.Rd index c9ca888..540a3bf 100644 --- a/man/extract_func_name.Rd +++ b/man/extract_func_name.Rd @@ -14,4 +14,3 @@ extract_func_name(filename, modify.characters = TRUE) \description{ This function is respinsible for extractng function name from test file name and removing special characters } - diff --git a/man/filter.Rd b/man/filter.Rd deleted file mode 100644 index 0dd7e5a..0000000 --- a/man/filter.Rd +++ /dev/null @@ -1,32 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/testr.R -\name{filter} -\alias{filter} -\title{Filter the generated tests so that only tests increasing code coverage will be kept.} -\usage{ -filter(test_root, output_dir, ..., package_path = "", remove_tests = FALSE, - compact = FALSE, verbose = testr_options("verbose")) -} -\arguments{ -\item{test_root}{root directory of tests to be filtered} - -\item{output_dir}{resulting directory where tests will be store. If nothing is supplied, tests that don't -increase coverage will be removed from test_root} - -\item{...}{functions that tests should be filtered aganist} - -\item{package_path}{package root of the package that coverage should be measured} - -\item{remove_tests}{if the tests that don't increase coverage should be removed. Default: \code{FALSE}. -This option will be set to \code{TRUE} if \code{output_dir} is not supplied} - -\item{compact}{If TRUE, the filtered tests will be compacted into files one per function, rather than the default one per test.} - -\item{verbose}{whether the additional information should be displayed. Default: \code{TRUE}} -} -\description{ -This function attempts to filter test cases based on code coverage collected by covr package. -Filtering is done in iterational way by measuring code coverage of every test separately and skipping the ones -that don't increase the coverage. -} - diff --git a/man/filter_tests.Rd b/man/filter_tests.Rd index 30ef745..88856ff 100644 --- a/man/filter_tests.Rd +++ b/man/filter_tests.Rd @@ -29,4 +29,3 @@ filter_tests(tc_root, tc_result_root, functions, package_path, This function attemps to filter the test cases for given functions based on code coverage information collected by covr. } - diff --git a/man/find_tests.Rd b/man/find_tests.Rd index 5fdb3d3..891e0f1 100644 --- a/man/find_tests.Rd +++ b/man/find_tests.Rd @@ -15,4 +15,3 @@ Find a known test location for the package \seealso{ CapturePackage } - diff --git a/man/gen_from_code.Rd b/man/gen_from_code.Rd index 45d9b3b..5d7a69c 100644 --- a/man/gen_from_code.Rd +++ b/man/gen_from_code.Rd @@ -16,4 +16,3 @@ gen_from_code(code, output_dir, ...) \description{ Generates tests from given code and specific captured functions } - diff --git a/man/gen_from_function.Rd b/man/gen_from_function.Rd index 797be62..51561cd 100644 --- a/man/gen_from_function.Rd +++ b/man/gen_from_function.Rd @@ -30,4 +30,3 @@ gen_from_function(package.dir = ".", code, functions, filter = TRUE, \description{ Given a package, the code to be executed and a list of functions to capture, the function captures the selected functions from the package, then runs the specified code. It then generates tests from the captured information and using code coverage filters them against existing tests for the package. Those that increase the code coverage will be added to already existing testthat tests for the package. } - diff --git a/man/gen_from_package.Rd b/man/gen_from_package.Rd index 9ded14b..f9b9add 100644 --- a/man/gen_from_package.Rd +++ b/man/gen_from_package.Rd @@ -25,4 +25,3 @@ gen_from_package(package.dir = ".", include.tests = FALSE, timed = FALSE, \description{ Runs the examples, vignettes and possibly tests associated with the package and captures the usage of package's functions. Creates tests from the captured information, filters it according to the already existing tests and if any new tests are found, adds them to package's tests. } - diff --git a/man/gen_from_patch.Rd b/man/gen_from_patch.Rd deleted file mode 100644 index 1ec9564..0000000 --- a/man/gen_from_patch.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/testr.R -\name{gen_from_patch} -\alias{gen_from_patch} -\title{Adds regression tests to specified package.} -\usage{ -gen_from_patch(package.dir = ".", code, functions, filter = TRUE, - exclude_existing_tests = FALSE, build = TRUE, timed = FALSE, output, - verbose = testr_options("verbose")) -} -\arguments{ -\item{package.dir}{Name/path to the package, uses devtools notation} - -\item{code}{Function (with no arguments) whose code will be executed and its calls in the package captured.} - -\item{functions}{Functions from the package to be captured, if missing, all package functions will be captured (character vector)} - -\item{filter}{T if the generated tests should be filtered} - -\item{exclude_existing_tests}{If TRUE, existing tests will be ignored from the code coverage} - -\item{build}{T if the package will be built beforehand} - -\item{timed}{TRUE if the tests result depends on time, in which case the current date & time will be appended to the output_dir.} - -\item{output}{If used, specifies where should the tests be unfiltered tests be generated (if not specified, they will use a temp directory and clean it afterwards)} - -\item{verbose}{Prints additional information.} -} -\description{ -Given a package, the code to be executed and a list of functions to capture, the function captures the selected functions from the package, then runs the specified code. It then generates tests from the captured information and using code coverage filters them against existing tests for the package. Those that increase the code coverage will be added to already existing testthat tests for the package. -} - diff --git a/man/gen_from_source.Rd b/man/gen_from_source.Rd index 75806af..71aa9c8 100644 --- a/man/gen_from_source.Rd +++ b/man/gen_from_source.Rd @@ -16,4 +16,3 @@ gen_from_source(src.root, output_dir, ...) \description{ Generates tests by running given source file. } - diff --git a/man/generate.Rd b/man/generate.Rd index 69e186a..68ae6c7 100644 --- a/man/generate.Rd +++ b/man/generate.Rd @@ -4,8 +4,8 @@ \alias{generate} \title{Generates tests from captured information.} \usage{ -generate(output_dir, root = testr_options("capture.folder"), timed = F, - clear_capture = T, verbose = testr_options("verbose")) +generate(output_dir, root = testr_options("capture.folder"), timed = FALSE, + clear_capture = TRUE, verbose = testr_options("verbose")) } \arguments{ \item{output_dir}{Directory to which the tests should be generated.} @@ -22,4 +22,3 @@ generate(output_dir, root = testr_options("capture.folder"), timed = F, This function takes the tracing information collected by capture and generates testthat compatible testcases. } - diff --git a/man/generate_tc.Rd b/man/generate_tc.Rd index 99f9c7f..d15bb38 100644 --- a/man/generate_tc.Rd +++ b/man/generate_tc.Rd @@ -21,4 +21,3 @@ This function generates a test case for builtin function using supplied argument \seealso{ test_gen ProcessClosure } - diff --git a/man/generate_test_cases.Rd b/man/generate_test_cases.Rd new file mode 100644 index 0000000..6098da9 --- /dev/null +++ b/man/generate_test_cases.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/runTests.R +\name{generate_test_cases} +\alias{generate_test_cases} +\title{generate_test_cases} +\usage{ +generate_test_cases(functions, limit) +} +\arguments{ +\item{functions}{Comma delimited names of functions to be decorated for test generation. +Provided as string vector or through environment variable FUNCTIONS.} + +\item{limit}{max number of packages to be runned for test case generation. Provided as +integer or through environment variable MAX_PACKAGES_TO_RUN.} +} +\description{ +generates test cases of base functions using package sources +} +\details{ +Systematically generates test cases for a given base function by running as many package +examples and tests as possible to capture inputs and outputs of functions. Or limited +number of packages are used, if a 'limit' argument or 'MAX_PACKAGES_TO_RUN' environment +variable is provided, + +If the functions argument is missing, then the list of functions is read from the +environment variable FUNCTIONS +} diff --git a/man/generate_test_cases_using.Rd b/man/generate_test_cases_using.Rd new file mode 100644 index 0000000..6ddd592 --- /dev/null +++ b/man/generate_test_cases_using.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/runTests.R +\name{generate_test_cases_using} +\alias{generate_test_cases_using} +\title{generate_test_cases_using} +\usage{ +generate_test_cases_using(functions, packages) +} +\arguments{ +\item{functions}{list of functions to annotate for test case generation} + +\item{packages}{list of packages to be used for test case generation} +} +\description{ +Generates test cases using the provided packages +} diff --git a/man/get_tests.Rd b/man/get_tests.Rd new file mode 100644 index 0000000..f82b6d2 --- /dev/null +++ b/man/get_tests.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/runTests.R +\name{get_tests} +\alias{get_tests} +\title{get_tests} +\usage{ +get_tests(capt_dir) +} +\arguments{ +\item{capt_dir}{location of test cases} +} +\description{ +get the names of all generated test cases +} diff --git a/man/is_s3_generic.Rd b/man/is_s3_generic.Rd index 28eddae..a7f2f5e 100644 --- a/man/is_s3_generic.Rd +++ b/man/is_s3_generic.Rd @@ -17,4 +17,3 @@ Determine if function has a call to UseMethod. In that case there is no need to \seealso{ Decorate } - diff --git a/man/list_functions.Rd b/man/list_functions.Rd index 1d0db86..56b389e 100644 --- a/man/list_functions.Rd +++ b/man/list_functions.Rd @@ -18,4 +18,3 @@ Character vector of function names defined in the file. Analyses given file, or files if directory is supplied for all functions defined in global scope and returns their names as character vector. } - diff --git a/man/package_gen.Rd b/man/package_gen.Rd deleted file mode 100644 index 97db57c..0000000 --- a/man/package_gen.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/testr.R -\name{package_gen} -\alias{package_gen} -\title{Capture run information from package and generate test cases} -\usage{ -package_gen(name, gen.dir, funcs, from.bioc = FALSE, contriburl) -} -\arguments{ -\item{name}{name of the package} - -\item{gen.dir}{resulting directory with tests} - -\item{funcs}{functions to Decorate} - -\item{from.bioc}{if package is from Bioconductior} - -\item{contriburl}{contributor url as in download.packages} - -\item{gen}{if generate test cases} -} -\description{ -This function is responsible for getting all possible capture information from specific package. -It tries to insstall package and run tests, examples and vignettes -} - diff --git a/man/parseFunctionNames.Rd b/man/parseFunctionNames.Rd index 7374aaa..94d7e62 100644 --- a/man/parseFunctionNames.Rd +++ b/man/parseFunctionNames.Rd @@ -16,4 +16,3 @@ List of parsed package and function names as characters. Parses given function names to a list of name, package characters. If package is not specified, NA is returned instead of its name. } - diff --git a/man/parse_eval.Rd b/man/parse_eval.Rd index 54bcab7..9e8c05b 100644 --- a/man/parse_eval.Rd +++ b/man/parse_eval.Rd @@ -12,4 +12,3 @@ parse_eval(what) \description{ Function that wraps parse(eval(...)) call with tryCatch } - diff --git a/man/process_capture.Rd b/man/process_capture.Rd index 1e30246..75accad 100644 --- a/man/process_capture.Rd +++ b/man/process_capture.Rd @@ -12,4 +12,3 @@ process_capture(cap_file) \description{ This function parses file with closure capture information and generates test cases } - diff --git a/man/prune.Rd b/man/prune.Rd index b70e430..caae788 100644 --- a/man/prune.Rd +++ b/man/prune.Rd @@ -29,4 +29,3 @@ This function attempts to filter test cases based on code coverage collected by Filtering is done in iterational way by measuring code coverage of every test separately and skipping the ones that don't increase the coverage. } - diff --git a/man/quoter.Rd b/man/quoter.Rd index 7b1403f..d5e1774 100644 --- a/man/quoter.Rd +++ b/man/quoter.Rd @@ -12,4 +12,3 @@ quoter(arg) \description{ In certain cases, language arguments (like calls), need to be quoated } - diff --git a/man/reassing_in_env.Rd b/man/reassing_in_env.Rd index ed62b0c..423ad0f 100644 --- a/man/reassing_in_env.Rd +++ b/man/reassing_in_env.Rd @@ -17,4 +17,3 @@ reassing_in_env(name, obj, env) Record that particual line was executed. Used in statement coverage, needed for namespace replacement } - diff --git a/man/refresh_decoration.Rd b/man/refresh_decoration.Rd index 9f2f590..5c4c17c 100644 --- a/man/refresh_decoration.Rd +++ b/man/refresh_decoration.Rd @@ -15,4 +15,3 @@ by a package that is being loaded, the package won't get the correct copy, which the information loss. This function is hooked up to the library, to be run upon exist and check what functions might need redecoration, to propagate correct version to imports namespace. } - diff --git a/man/run.Rd b/man/run.Rd deleted file mode 100644 index e64d1f3..0000000 --- a/man/run.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/testr.R -\name{run} -\alias{run} -\title{Runs the generated tests.} -\usage{ -run(test_dir, verbose = testr_options("verbose")) -} -\arguments{ -\item{test_dir}{Directory in which the tests are located. If empty, the last output directory for generate or filter functions is assumed.} - -\item{verbose}{TRUE to display additional information.} -} -\value{ -TRUE if all tests passed, FALSE otherwise. -} -\description{ -This function is a shorthand for calling testthat on the previously generated tests. -} - diff --git a/man/run_package.Rd b/man/run_package.Rd new file mode 100644 index 0000000..e536479 --- /dev/null +++ b/man/run_package.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/runTests.R +\name{run_package} +\alias{run_package} +\title{Runs all available source code from a package in order to generate +usable tests.} +\usage{ +run_package(pkg, flist, output.dir = getwd(), validation.cache = new.env(), + skip.existing = TRUE) +} +\arguments{ +\item{pkg}{the name of the package (must be installed)} + +\item{flist}{list of functions to instrument for capture} + +\item{output.dir}{directory to write all harnes scripts, tests, and generated content.} +} +\description{ +Runs all available source code from a package in order to generate +usable tests. +} diff --git a/man/run_package_examples.Rd b/man/run_package_examples.Rd new file mode 100644 index 0000000..599efc5 --- /dev/null +++ b/man/run_package_examples.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/runTests.R +\name{run_package_examples} +\alias{run_package_examples} +\title{Executes a script in an independent R session and stores the output in the +package working directory.} +\usage{ +run_package_examples(pkg, flist, output.dir, validation.cache) +} +\arguments{ +\item{pkg}{the name of the package (must be installed)} + +\item{flist}{list of functions to intrument} + +\item{output.dir}{the output dir to write capture tests and output} + +\item{source.file}{the full path of the source file to execute} +} +\description{ +Executes a script in an independent R session and stores the output in the +package working directory. +} diff --git a/man/run_package_source.Rd b/man/run_package_source.Rd new file mode 100644 index 0000000..1414ad4 --- /dev/null +++ b/man/run_package_source.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/runTests.R +\name{run_package_source} +\alias{run_package_source} +\title{Executes a script in an independent R session and stores the output in the +package working directory.} +\usage{ +run_package_source(pkg, flist, source, output.dir) +} +\arguments{ +\item{pkg}{the name of the package (must be installed)} + +\item{flist}{list of functions to intrument} + +\item{output.dir}{the output dir to write capture tests and output} + +\item{source.file}{the full path of the source file to execute} +} +\description{ +Executes a script in an independent R session and stores the output in the +package working directory. +} diff --git a/man/run_script_with_timeout.Rd b/man/run_script_with_timeout.Rd new file mode 100644 index 0000000..ede782f --- /dev/null +++ b/man/run_script_with_timeout.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/runTests.R +\name{run_script_with_timeout} +\alias{run_script_with_timeout} +\title{Spawns a new VM to run the given script and write the output to the given file.} +\usage{ +run_script_with_timeout(script.file, output.file) +} +\description{ +If the script does not complete within 90 seconds, it is sent the the TERM signal. +If the process does not exit within 5 seconds, it is sent the KILL signal. +} diff --git a/man/setup_capture.Rd b/man/setup_capture.Rd index c169e58..6e3ac96 100644 --- a/man/setup_capture.Rd +++ b/man/setup_capture.Rd @@ -19,4 +19,3 @@ This function is respinsible for setting up capturing for functions \seealso{ Decorate } - diff --git a/man/start_capture.Rd b/man/start_capture.Rd index 4644f53..e804720 100644 --- a/man/start_capture.Rd +++ b/man/start_capture.Rd @@ -15,4 +15,3 @@ start_capture(..., verbose = testr_options("verbose")) The functions can be expressed as character literals in the form of either only a function name, or package name ::: function name, or directly as a symbol (i.e. only function name, or package name ::: function name). } - diff --git a/man/start_capture_builtins.Rd b/man/start_capture_builtins.Rd index 3250d26..b18e84c 100644 --- a/man/start_capture_builtins.Rd +++ b/man/start_capture_builtins.Rd @@ -15,4 +15,3 @@ start_capture_builtins(internal.only = FALSE, \description{ Wrapper around capture to capture builtin functions } - diff --git a/man/starts_with.Rd b/man/starts_with.Rd index ccaf236..f63967a 100644 --- a/man/starts_with.Rd +++ b/man/starts_with.Rd @@ -17,4 +17,3 @@ Check if line starts with prefix \seealso{ GenerateTC } - diff --git a/man/stop_capture.Rd b/man/stop_capture.Rd index 27fa8ec..a52a0e0 100644 --- a/man/stop_capture.Rd +++ b/man/stop_capture.Rd @@ -14,4 +14,3 @@ stop_capture(..., verbose = testr_options("verbose")) \description{ This function removes the tracing functionality for specified function } - diff --git a/man/stop_capture_all.Rd b/man/stop_capture_all.Rd index 7f8b6e1..fe499d2 100644 --- a/man/stop_capture_all.Rd +++ b/man/stop_capture_all.Rd @@ -12,4 +12,3 @@ stop_capture_all(verbose = testr_options("verbose")) \description{ Remove tracing functionality for all the functions } - diff --git a/man/substr_line.Rd b/man/substr_line.Rd index 2377b76..85c1d2a 100644 --- a/man/substr_line.Rd +++ b/man/substr_line.Rd @@ -15,4 +15,3 @@ Used for processing capture file information. Deletes prefixes to get essential \seealso{ ProcessClosure } - diff --git a/man/test_gen.Rd b/man/test_gen.Rd index cb87605..f7df07c 100644 --- a/man/test_gen.Rd +++ b/man/test_gen.Rd @@ -4,7 +4,8 @@ \alias{test_gen} \title{Test Case generator based on capture files} \usage{ -test_gen(root, output_dir, timed = F, verbose = testr_options("verbose")) +test_gen(root, output_dir, timed = FALSE, + verbose = testr_options("verbose")) } \arguments{ \item{root}{a directory containg capture information or capture file} @@ -17,7 +18,5 @@ test_gen(root, output_dir, timed = F, verbose = testr_options("verbose")) } \description{ This function works with the trace information generated by instrumented GNU-R. - It is strictly oriented to that, please see readme for more information. } - diff --git a/man/testr_addRegression.Rd b/man/testr_addRegression.Rd deleted file mode 100644 index 6b618ab..0000000 --- a/man/testr_addRegression.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/testr.R -\name{testr_addRegression} -\alias{testr_addRegression} -\title{Adds regression tests to specified package.} -\usage{ -testr_addRegression(package.dir = ".", code, functions, filter = TRUE, - exclude_existing_tests = FALSE, build = TRUE, timed = FALSE, output, - verbose = testr_options("verbose")) -} -\arguments{ -\item{package.dir}{Name/path to the package, uses devtools notation} - -\item{code}{Function (with no arguments) whose code will be executed and its calls in the package captured.} - -\item{functions}{Functions from the package to be captured, if missing, all package functions will be captured (character vector)} - -\item{filter}{T if the generated tests should be filtered} - -\item{exclude_existing_tests}{If TRUE, existing tests will be ignored from the code coverage} - -\item{build}{T if the package will be built beforehand} - -\item{timed}{TRUE if the tests result depends on time, in which case the current date & time will be appended to the output_dir.} - -\item{output}{If used, specifies where should the tests be unfiltered tests be generated (if not specified, they will use a temp directory and clean it afterwards)} - -\item{verbose}{Prints additional information.} -} -\description{ -Given a package, the code to be executed and a list of functions to capture, the function captures the selected functions from the package, then runs the specified code. It then generates tests from the captured information and using code coverage filters them against existing tests for the package. Those that increase the code coverage will be added to already existing testthat tests for the package. -} - diff --git a/man/testr_code.Rd b/man/testr_code.Rd deleted file mode 100644 index aaaf697..0000000 --- a/man/testr_code.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/testr.R -\name{testr_code} -\alias{testr_code} -\title{Generate tests for give code} -\usage{ -testr_code(code, output_dir, ...) -} -\arguments{ -\item{code}{Code from which the tests will be generated.} - -\item{output_dir}{Directory to which the tests will be generated.} - -\item{...}{functions to be captured during the code execution (same syntax as capture function)} -} -\description{ -Generates tests from given code and specific captured functions -} - diff --git a/man/testr_options.Rd b/man/testr_options.Rd index 969f3f2..136c13a 100644 --- a/man/testr_options.Rd +++ b/man/testr_options.Rd @@ -21,4 +21,3 @@ The following \code{testr} options are available: \item \code{digits}: numeric (default: \code{2}) passed to \code{format} } } - diff --git a/man/testr_package.Rd b/man/testr_package.Rd deleted file mode 100644 index 5a1d832..0000000 --- a/man/testr_package.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/testr.R -\name{testr_package} -\alias{testr_package} -\title{Generates tests for a package by running the code associated with it.} -\usage{ -testr_package(package.dir = ".", include.tests = FALSE, timed = FALSE, - filter = TRUE, build = TRUE, output, verbose = testr_options("verbose")) -} -\arguments{ -\item{package.dir}{Name/path to the package, uses devtools notation.} - -\item{include.tests}{If TRUE, captures also execution of package's tests.} - -\item{timed}{TRUE if the tests result depends on time, in which case the current date & time will be appended to the output_dir.} - -\item{filter}{TRUE if generated tests should be filteres so that only those adding to a coverage will be used} - -\item{build}{if to build package before. Default \code{TRUE}} - -\item{output}{If used, specifies where should the tests be unfiltered tests be generated (if not specified, they will use a temp directory and clean it afterwards)} - -\item{verbose}{Prints additional information.} -} -\description{ -Runs the examples, vignettes and possibly tests associated with the package and captures the usage of package's functions. Creates tests from the captured information, filters it according to the already existing tests and if any new tests are found, adds them to package's tests. -} - diff --git a/man/testr_source.Rd b/man/testr_source.Rd deleted file mode 100644 index 3284fcc..0000000 --- a/man/testr_source.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/testr.R -\name{testr_source} -\alias{testr_source} -\title{Generate tests for give source} -\usage{ -testr_source(src.root, output_dir, ...) -} -\arguments{ -\item{src.root}{Source file to be executed and captured, or directory containing multiple files.} - -\item{output_dir}{Directory to which the tests will be generated.} - -\item{...}{Functions to be tested.} -} -\description{ -Generates tests by running given source file. -} - diff --git a/man/undecorate.Rd b/man/undecorate.Rd index 9e6ee0e..9bb082d 100644 --- a/man/undecorate.Rd +++ b/man/undecorate.Rd @@ -17,4 +17,3 @@ Reset previously decorate function \seealso{ write_capture Decorate } - diff --git a/man/validate_tests.Rd b/man/validate_tests.Rd new file mode 100644 index 0000000..43a268a --- /dev/null +++ b/man/validate_tests.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/runTests.R +\name{validate_tests} +\alias{validate_tests} +\title{Attempts to run all generated tests to verify that they're actually correct.} +\usage{ +validate_tests(capture.dir, validated.test.dir, cache = new.env()) +} +\description{ +Attempts to run all generated tests to verify that they're actually correct. +} diff --git a/man/write_capture.Rd b/man/write_capture.Rd index 5858d15..5487f45 100644 --- a/man/write_capture.Rd +++ b/man/write_capture.Rd @@ -17,4 +17,3 @@ This function is respinsible for writing down capture information for decorated \seealso{ Decorate } - diff --git a/man/write_captured_tests.Rd b/man/write_captured_tests.Rd new file mode 100644 index 0000000..4a79895 --- /dev/null +++ b/man/write_captured_tests.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/generate.R +\name{write_captured_tests} +\alias{write_captured_tests} +\title{writeCapturedTests} +\usage{ +write_captured_tests(path) +} +\arguments{ +\item{path}{path to store the archive} +} +\description{ +creates an archive of generated test cases +} diff --git a/src/GetArgs.cpp b/src/GetArgs.cpp index d848a17..71b747c 100644 --- a/src/GetArgs.cpp +++ b/src/GetArgs.cpp @@ -13,29 +13,33 @@ SEXP GetArgs(SEXP dotsE){ for( int i=0; i(envNames[i]); -// Rcout << "name - " << name << endl; SEXP nameSym = Rf_install(name.c_str()); unevaluatedArg = Rf_findVar(nameSym, dotsE); if (missing(nameSym, dotsE)) { continue; } - -// args[name] = R_forcePromise(unevaluatedArg); - if (unevaluatedArg != R_UnboundValue && TYPEOF(unevaluatedArg) == PROMSXP) { - SEXP prcode = PRCODE(unevaluatedArg); - if (!Rf_isNull(PRENV(unevaluatedArg))){ - evalEnv = PRENV(unevaluatedArg); - } else { - evalEnv = dotsE; - } - int err = 0; - SEXP res = R_tryEvalSilent(unevaluatedArg, evalEnv, &err); - if(err){ - evaluatedArg = prcode; - } else { - evaluatedArg = res; - } - args[name] = evaluatedArg; + + if (unevaluatedArg != R_UnboundValue) { + if(TYPEOF(unevaluatedArg) == PROMSXP) { + SEXP prcode = PRCODE(unevaluatedArg); + if (!Rf_isNull(PRENV(unevaluatedArg))){ + evalEnv = PRENV(unevaluatedArg); + } else { + evalEnv = dotsE; + } + int err = 0; + SEXP res = R_tryEvalSilent(unevaluatedArg, evalEnv, &err); + if(err){ + evaluatedArg = prcode; + } else { + evaluatedArg = res; + } + args[name] = evaluatedArg; + } else { + // Non promises such as vectors or other constants + // are already evaluated. + args[name] = unevaluatedArg; + } } } nArgs--; @@ -43,7 +47,7 @@ SEXP GetArgs(SEXP dotsE){ SEXP dots = dotsEnv.get("..."); vector promises; int dArgs = 0; - if( dots != R_MissingArg ){ + if( dots != R_MissingArg ){ while(dots != R_NilValue){ promises.push_back(CAR(dots)) ; dots = CDR(dots); diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 0d9708c..cd653ee 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -1,4 +1,4 @@ -// This file was generated by Rcpp::compileAttributes +// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include "../inst/include/testr.h" @@ -10,10 +10,20 @@ using namespace Rcpp; void WriteCapInfo_cpp(CharacterVector fname, SEXP args_env); RcppExport SEXP testr_WriteCapInfo_cpp(SEXP fnameSEXP, SEXP args_envSEXP) { BEGIN_RCPP - Rcpp::RNGScope __rngScope; + Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< CharacterVector >::type fname(fnameSEXP); Rcpp::traits::input_parameter< SEXP >::type args_env(args_envSEXP); WriteCapInfo_cpp(fname, args_env); return R_NilValue; END_RCPP } + +static const R_CallMethodDef CallEntries[] = { + {"testr_WriteCapInfo_cpp", (DL_FUNC) &testr_WriteCapInfo_cpp, 2}, + {NULL, NULL, 0} +}; + +RcppExport void R_init_testr(DllInfo *dll) { + R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); + R_useDynamicSymbols(dll, FALSE); +} diff --git a/src/WriteCapInfo.cpp b/src/WriteCapInfo.cpp index bbbc44f..321ee72 100644 --- a/src/WriteCapInfo.cpp +++ b/src/WriteCapInfo.cpp @@ -16,7 +16,7 @@ std::ofstream tracefile; void printCapture(CharacterVector x, std::string prefix) { if (x[0] != "NULL"){ - if (x.length() < 1000) { + if (x.length() < 10000) { for (int i = 0; i < x.length(); i++) { tracefile << prefix << x[i] << std::endl; } diff --git a/tests/testthat/test-testgen.R b/tests/testthat/test-testgen.R index b2d18e9..b2ca415 100644 --- a/tests/testthat/test-testgen.R +++ b/tests/testthat/test-testgen.R @@ -3,6 +3,34 @@ library(testthat) context("Generation") +test_that('Test start_capture()', { + unlink(file.path(getwd(),"capture")) + unlink(file.path(getwd(),"tmp")) + testr::start_capture("stats::dpois") + dpois(0:7, lambda = 1) + testr::write_captured_tests("/tmp") + expect_true(file.exists(file.path(getwd(),"tmp"))) + expect_true(file.info(file.path(getwd(),"tmp"))$isdir) + expect_true(file.exists(file.path(getwd(),"capture/stats___dpois"))) + expect_true(file.info(file.path(getwd(),"capture/stats___dpois"))$isdir) + expect_true(file.exists(file.path(getwd(),"capture"))) + expect_true(file.info(file.path(getwd(),"capture"))$isdir) + expect_true(file.exists(file.path(getwd(),"tmp/test.stats.dpois.tar.gz"))) + expect_false(file.info(file.path(getwd(),"tmp/test.stats.dpois.tar.gz"))$isdir) + expect_equal(length(list.files(file.path(getwd(),"capture/stats___dpois"), pattern = "*.R$", recursive = FALSE, all.files = FALSE)), 1) + unlink(file.path(getwd(),"tmp")) + unlink(file.path(getwd(),"capture")) +}) + +test_that('Test find_packages_using_function()', { + x <- testr::find_packages_using_function("cor") + y <- testr::find_packages_using_function("aksagdK*@&e9dgiakegdkgjqge93yqe") + expect_true(length(x) > 0) + expect_true(class(x[1]) == "character") + expect_true(length(y) == 0) + expect_true(class(y) == "character") +}) + test_that('Generate Abbreviate', { expect_warning(generate("abbreviate", "CaptureInfo/capture")) generate("abbreviate", "CaptureInfo/capture_abbreviate", verbose = FALSE) @@ -32,3 +60,4 @@ test_that('Generate Warnings/Errors', { sink() unlink("we", recursive = T) }) +