tests/testthat/test-match-arg.R

In jeanmathieupotvin/dotprofile: Create and Manage Configuration Profiles

local_wrapper <- function(foo = c("a", "b", default = "c"))
{
    return(match_arg(foo))
}

test_that("it works", {
    local_wrapper_no_default <- function(foo = c("a", "b", "c"))
    {
        return(match_arg(foo))
    }

    expect_identical(local_wrapper(),            "c")
    expect_identical(local_wrapper("b"),         "b")
    expect_identical(local_wrapper_no_default(), "a")
})

test_that("it works with all atomic types", {
    local_wrapper_lgl <- function(foo = c(TRUE, default = FALSE))
    {
        return(match_arg(foo))
    }
    local_wrapper_int <- function(foo = c(1L, 2L, default = 3L))
    {
        return(match_arg(foo))
    }
    local_wrapper_dbl <- function(foo = c(1.0, 2.0, default = 3.0))
    {
        return(match_arg(foo))
    }
    local_wrapper_cpx <- function(foo = c(1i, 2i, default = 3i))
    {
        return(match_arg(foo))
    }
    local_wrapper_chr <- function(foo = c("1", "2", default = "3"))
    {
        return(match_arg(foo))
    }
    local_wrapper_raw <- function(foo = as.raw(c(1.0, 2.0, default = "3")))
    {
        return(match_arg(foo))
    }

    expect_identical(local_wrapper_lgl(FALSE), FALSE)
    expect_identical(local_wrapper_int(2L),    2L)
    expect_identical(local_wrapper_dbl(2.0),   2.0)
    expect_identical(local_wrapper_cpx(2i),    2i)
    expect_identical(local_wrapper_chr("2"),   "2")
    expect_identical(local_wrapper_raw(as.raw(2.0)), as.raw(2.0))
})

test_that("it returns an error if stack is empty", {
    expect_snapshot(match_arg("a", ..force_empty_stack = TRUE), error = TRUE)
})

test_that("it returns an error in case of no match", {
    expect_snapshot(local_wrapper("d"), error = TRUE)
})

test_that("it returns an error if there is nothing to match", {
    expect_snapshot(match_arg(), error = TRUE)
})

test_that("it returns an error if `arg` contains more than 1 element", {
    expect_snapshot(local_wrapper(c("a", "b")), error = TRUE)
})

test_that("it uses `error` when an error must be thrown if it is not null", {
    local_wrapper_custom_err <- function(foo = c("a", "b", "c"))
    {
        return(match_arg(foo, "custom message", ui_todo("This is a custom todo.")))
    }

    expect_snapshot(local_wrapper_custom_err("d"), error = TRUE)
})