tests/utils/helpers.R

In sCervino/mfdb: MareFrame DB querying library

expect_string <- function(actual, ...) {
    expect_equal(
        as.character(actual),
        paste0(c(...), "\n", collapse = ""))
}

print.stringvec <- function(x, ...) {
    cat(x, sep = "\n")
}

cmp <- function(a, b) {
    if(identical(all.equal(a,b), 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, "'"))
}

expect_true <- function(exp) {
    ok(exp, "Is true")
}

cmp_file <- function (gd, filename, ...) {
    cmp(
        strsplit(as.character(gadget_dir_read(gd, filename)), "\n")[[1]],
        c(...))
}

# Replace function with new one, optionally returning to normal after expr
mock_functions <- function(ns, new_funcs, expr = NULL) {
    assign_list <- function (ns, replacements) {
        for (k in names(replacements)) {
            assignInNamespace(k, replacements[[k]], ns)
        }
    }

    # Without an expression, just assign permanently
    if (is.null(expr)) {
        assign_list(ns, new_funcs)
        return(NULL);
    }

    # 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)
    })
}

ok_group <- function (message, tests = NULL) {
    cat(paste0("# ", unlist(strsplit(message, "[\r\n]+")), "\n", collapse=""), sep = "")
    tests
    invisible(NULL)
}

ver_string <- paste("; Generated by mfdb", packageVersion("mfdb"))