tests/testthat/test-misc.R

In crunch: Crunch.io Data Tools

context("Various helper functions")

test_that("can warn and message once", {
    expect_warning(warn_once("danger!", option = "test_warn_once"), "danger!")
    expect_warning(warn_once("danger!", option = "test_warn_once"), NA)
    expect_message(message_once("hi!", option = "test_msg_once"), "hi!")
    expect_message(message_once("hi!", option = "test_msg_once"), NA)
})


test_that("is.error", {
    e <- try(halt("error in a box"), silent = TRUE)
    expect_true(is.error(e))
    expect_false(is.error("not an error"))
    expect_false(is.error(NULL))
    expect_false(is.error(NA))
    expect_error("not an error", NA)
})

test_that("rethrow a caught error", {
    e <- try(halt("error in a box"), silent = TRUE)
    expect_true(is.error(e))
    expect_error(rethrow(e), "error in a box")
})

test_that("%||%", {
    expect_identical("f" %||% "g", "f")
    expect_identical(NULL %||% "g", "g")
    expect_identical("f" %||% halt("Nooooooo!"), "f")
})

test_that("dirtyElements", {
    x <- list(
        list(a = 1, b = 1),
        list(a = "1", b = "1"),
        list(a = "d", b = "e")
    )
    y <- x
    expect_false(any(dirtyElements(x, y)))
    y[[2]]$b <- "f"
    y[[1]]$b <- 1
    expect_identical(dirtyElements(x, y), c(FALSE, TRUE, FALSE))
    y[[3]]$a <- "f"
    expect_identical(dirtyElements(x, y), c(FALSE, TRUE, TRUE))
})


test_that("joinPath", {
    expect_identical(
        joinPath("https://app.crunch.io/api/datasets/", "../variables/"),
        "https://app.crunch.io/api/variables/"
    )
    expect_identical(
        joinPath("https://app.crunch.io/api/variables/", "4412es/"),
        "https://app.crunch.io/api/variables/4412es/"
    )
    expect_identical(
        joinPath("a/b/c/d/../e/f/", "g/../../h/"),
        "a/b/c/e/h/"
    )
    expect_identical(
        joinPath("https://app.crunch.io/api/datasets/", "/variables/"), # nolint
        "/variables/" # nolint
    )
    expect_identical(
        joinPath("https://app.crunch.io/api/datasets/", "/"),
        "/"
    )
    expect_identical(
        joinPath("https://app.crunch.io/api/datasets/", "./id/"),
        "https://app.crunch.io/api/datasets/id/"
    )
})

test_that("absoluteURL", {
    base.url <- "https://fake.crunch.io/api/datasets/"
    expect_identical(
        absoluteURL("../variables/", base.url),
        "https://fake.crunch.io/api/variables/"
    )
    expect_identical(
        absoluteURL("4412es/", base.url),
        "https://fake.crunch.io/api/datasets/4412es/"
    )
    expect_identical(
        absoluteURL(
            "g/../../h/",
            "https://fake.crunch.io/a/b/c/d/../e/f/"
        ),
        "https://fake.crunch.io/a/b/c/e/h/"
    )
    expect_identical(
        absoluteURL("/variables/", base.url), # nolint
        "https://fake.crunch.io/variables/"
    )
    expect_identical(
        absoluteURL("/", base.url),
        "https://fake.crunch.io/"
    )
})

test_that("emptyObject JSONifies correctly", {
    expect_equal(unclass(toJSON(emptyObject())), "{}")
    expect_equal(unclass(toJSON(emptyObject(list(a = 1), 1:4))), "{}")
})

test_that("null function always returns null", {
    expect_null(null())
    expect_null(null(TRUE))
    expect_null(null(stop("yo!")))
})

test_that("JSON behavior for NULL (handle jsonlite API change in 0.9.22)", {
    expect_equal(unclass(toJSON(NULL)), "{}")
    expect_equal(unclass(toJSON(list(x = NULL))), '{"x":null}')
})

test_that("toJSON sorts when we want", {
    unsorted <- '{"b":1,"a":2}'
    sorted <- '{"a":2,"b":1}'
    expect_equal(
        unclass(toJSON(list(b = 1, a = 2))),
        unsorted
    )
    expect_equal(
        unclass(toJSON(list(b = 1, a = 2), for_query_string = TRUE)),
        unsorted
    )
    expect_equal(
        unclass(with(
            temp.options(crunch = list(crunch.stabilize.query = TRUE)),
            toJSON(list(b = 1, a = 2))
        )),
        unsorted
    )
    expect_equal(
        unclass(with(
            temp.options(crunch = list(crunch.stabilize.query = TRUE)),
            toJSON(list(b = 1, a = 2), for_query_string = TRUE)
        )),
        sorted
    )

})

test_that("setIfNotAlready", {
    with(temp.options(
        crunch.test.opt1 = "previous",
        crunch.test.opt2 = NULL,
        crunch.test.opt3 = 4
    ), {
        old <- setIfNotAlready(crunch.test.opt1 = "value", crunch.test.opt2 = 5)
        expect_identical(getOption("crunch.test.opt1"), "previous")
        expect_identical(getOption("crunch.test.opt2"), 5)
        expect_identical(getOption("crunch.test.opt3"), 4)
    })
})

test_that("startsWith/endsWith for old R", {
    expect_true(alt.startsWith("http://", "http"))
    expect_false(alt.startsWith("http://", "https"))
    expect_true(alt.endsWith("http://", "//"))
    expect_false(alt.endsWith("http://", "http"))
})

test_that("uniquify", {
    expect_identical(
        uniquify(rep("a", 4)),
        c("a", "a  (1)", "a  (2)", "a  (3)")
    )
    expect_identical(
        uniquify(c("b", "a", "a", "abcd", "a")),
        c("b", "a", "a  (1)", "abcd", "a  (2)")
    )
})

test_that("vectorOrList", {
    expect_true(vectorOrList(c("a", "b", "c"), "character"))
    expect_true(vectorOrList(list("a", "b", "c"), "character"))
    expect_false(vectorOrList(c(1, 2, 3), "character"))
    expect_false(vectorOrList(list("a", 1, "c"), "character"))
    expect_true(vectorOrList(c(1, 2, 3), "numeric"))
    expect_false(vectorOrList(list("a", 1, "c"), "numeric"))
})

test_that("setCrunchAPI", {
    with(reset.option("crunch.api"), {
        setCrunchAPI("foobar")
        expect_equal(getOption("crunch.api"), "https://foobar.crunch.io/api/")
        setCrunchAPI("barfoo", 8888)
        expect_equal(getOption("crunch.api"), "http://barfoo.crunch.io:8888/api/")
    })
})

with(temp.option(
    crunch = list(foo.crunch = "x"),
    foo.bar = "no",
    foo.other = "other",
    foo.crunch = "y"
), {
    withr::with_envvar(
        list(R_FOO_BAR = "yes", R_FOO_CRUNCH = "z", R_FOO_NUM = "1", R_FOO_LGL = "TRUE"),
        {
            test_that("envOrOption gets the right thing", {
                expect_identical(envOrOption("foo.crunch"), "x") ## crunch opt trumps all
                expect_identical(envOrOption("foo.bar"), "yes") ## Env var trumps option
                expect_identical(envOrOption("foo.other"), "other") ## Option if there is no env var
                expect_null(envOrOption("somethingelse")) ## Null if neither
                expect_equal(envOrOption("foo.num", expect_num = TRUE), 1)
                expect_equal(envOrOption("foo.lgl", expect_lgl = TRUE), TRUE)
                ## default works
                expect_identical(
                    envOrOption("somethingelse", "I'm a default"),
                    "I'm a default"
                )
            })
        }
    )
})

test_that("envOrOptionSource works correctly", {
    with(temp.option(
        crunch = list(
            crunch.opt = "a",
            crunch.opt.source = structure("b", source = "custom")
        ),
        opt = "c"
    ), {
        withr::with_envvar(list(R_ENV_VAR = "d"), {
            expect_equal(
                envOrOptionSource("crunch.opt"),
                "set using `set_crunch_opts(crunch.opt = ...)`"
            )
            expect_equal(
                envOrOptionSource("crunch.opt.source"),
                "set using `custom`"
            )
            expect_equal(
                envOrOptionSource("env.var"),
                "found in environment variable `R_ENV_VAR`"
            )
            expect_equal(
                envOrOptionSource("opt"),
                "found in `options(opt = ...)`"
            )
            expect_equal(
                envOrOptionSource("not.found"),
                "unknown source"
            )
        })
    })
})

test_that("loadCube can handle a number of locations", {
    # loadCube can load old fixtures that lack element/self/value metadata
    cube <- loadCube("cubes/array-cube-sans-metadata.json")
    expect_is(cube, "CrunchCube")
})

test_that("Cubify works with many dimensions", {
    # 1d
    cube_json <- fromJSON(cubePath("cubes/univariate-categorical.json"))
    cube <- loadCube("cubes/univariate-categorical.json")

    dn <- dimnames(cube@arrays$count)
    raw_values <- cube_json$value$result$measures$count$data
    expect_equivalent(cube@arrays$count, cubify(raw_values, dims = dn))
    expect_length(dim(cube@arrays$count), 1)

    # 2d
    cube_json <- fromJSON(cubePath("cubes/cat-array.json"))
    cube <- loadCube("cubes/cat-array.json")

    dn <- dimnames(cube@arrays$count)
    raw_values <- cube_json$value$result$measures$count$data
    expect_equivalent(cube@arrays$count, cubify(raw_values, dims = dn))
    expect_length(dim(cube@arrays$count), 2)

    # 3d
    cube_json <- fromJSON(cubePath("cubes/selected-crosstab-4.json"))
    cube <- loadCube("cubes/selected-crosstab-4.json")

    dn <- dimnames(cube@arrays$count)
    raw_values <- cube_json$value$result$measures$count$data
    expect_equivalent(cube@arrays$count, cubify(raw_values, dims = dn))
    expect_length(dim(cube@arrays$count), 3)

    # 3+d
    cube_json <- fromJSON(cubePath("cubes/cat-x-mr-x-mr.json"))
    cube <- loadCube("cubes/cat-x-mr-x-mr.json")

    dn <- dimnames(cube@arrays$count)
    raw_values <- cube_json$value$result$measures$count$data
    expect_equivalent(cube@arrays$count, cubify(raw_values, dims = dn))
    expect_length(dim(cube@arrays$count), 5)
})

test_that("is.TRUEorFALSE errors correctly", {
    expect_true(is.TRUEorFALSE(TRUE))
    expect_true(is.TRUEorFALSE(FALSE))
    expect_false(is.TRUEorFALSE("char"))
    expect_false(is.TRUEorFALSE(NA))
    expect_false(is.TRUEorFALSE(c(TRUE, TRUE)))
})

test_that("is.singleCharacter", {
    expect_true(is.singleCharacter("char"))
    expect_false(is.singleCharacter(c("char", "char2")))
    expect_false(is.singleCharacter(NULL))
    expect_false(is.singleCharacter(NA))
    expect_false(is.singleCharacter(1))
})

test_that("checkInstalledPackages", {
    expect_error(
        checkInstalledPackages(c("NoTaPaCkAgE", "NoRtHiSoNe")),
        paste0("Missing required packages: ", dQuote("NoTaPaCkAgE"), " and ", dQuote("NoRtHiSoNe"))
    )
    expect_silent(checkInstalledPackages("stats"))
})

test_that("hasFunction", {
    expect_true(hasFunction("makeArray", "crunch"))
    expect_false(hasFunction("Totally_not_a_function", "crunch"))
})

with_mock_crunch({
    ds <- cachedLoadDataset("test ds")

    test_that("haltIfArray", {
        expect_true(haltIfArray(ds$birthyr))
        expect_error(
            haltIfArray(ds$mymrset),
            "Array-like variables can't be used."
        )

        expect_error(haltIfArray(ds$mymrset, "embed_func()"),
            "Array-like variables can't be used with function `embed_func()`.",
            fixed = TRUE
        )
    })
})