tests/utils/helpers.R

In mfdb: MareFrame DB Querying Library

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
}