print.stringvec <- function(x, ...) { cat(x, sep = "\n") } cmp <- function(a, b) { if(identical(all.equal(a,b, tolerance = 1e-6), TRUE)) return(TRUE) if (file.exists(Sys.which('git'))) { totmp <- function(x) { f <- tempfile(pattern = "str.") capture.output(str(x, vec.len = 1000, digits.d = 5, nchar.max = 1000), file = f) return(f) } return(suppressWarnings(system2( Sys.which('git'), c("diff", "--no-index", "--color-words", totmp(a), totmp(b)), input = "", stdout = TRUE, stderr = TRUE))) } return(c( capture.output(str(a)), "... does not equal...", capture.output(str(b)) )) } cmp_error <- function(exp, expected_regexp) { msg <- tryCatch({exp ; "No error returned"}, error = function(e) e$message) if(grepl(expected_regexp, msg)) TRUE else paste0("'", msg, "' should contain '", expected_regexp, "'") } expect_equal <- function(actual, expected) { ok(cmp(actual, expected), paste0( strtrim(gsub("\\s+", " ", deparse(substitute(actual)), perl = TRUE), 30), " == ", strtrim(gsub("\\s+", " ", deparse(substitute(expected)), perl = TRUE), 30), "", collapse="")) } expect_error <- function(exp, expected_regexp) { ok(cmp_error(exp, expected_regexp), paste0("Error contained '", expected_regexp, "'")) } cmp_file <- function (gd, filename, ...) { f <- file(file.path(gd$dir, filename)) lines <- readLines(f, n = -1) close(f) cmp(lines, c(...)) } # Replace function with new one, optionally returning to normal after expr mock_functions <- function(ns, new_funcs, expr) { assign_list <- function (ns, replacements) { for (k in names(replacements)) { assignInNamespace(k, replacements[[k]], ns) } } # Replace temporarily, put the old ones back again old_funcs <- structure( lapply(names(new_funcs), function(n) getFromNamespace(n, ns)), names = names(new_funcs)) tryCatch({ assign_list(ns, new_funcs) expr }, finally = { assign_list(ns, old_funcs) }) } ver_string <- paste("; Generated by mfdb", packageVersion("mfdb")) fake_mdb <- function(save_temp_tables = FALSE) { logger <- logging::getLogger('mfdb') return(structure(list( logger = logger, save_temp_tables = save_temp_tables, schema = 'fake_schema', state = new.env(), db = structure(list(), class="dbNull"), class = "mfdb"))) } # Allow us to use agg_summary outside the package agg_summary_args <- NULL agg_summary <- function(...) { agg_summary_args <<- list(...) local({ do.call(agg_summary, agg_summary_args) }, asNamespace('mfdb')) } # Parse a string into a data.frame table_string <- function (str, ...) { read.table( textConnection(str), blank.lines.skip = TRUE, header = TRUE, stringsAsFactors = FALSE, ...) } # Shuffle the rows of a data.frame shuffle_df <- function(df) df[sample(nrow(df)),] # Remove our attributes from a dataframe unattr <- function (obj) { attributes(obj) <- attributes(obj)[c('names', 'row.names', 'class')] obj }