tests/testthat/test-find-source-in-exprs.R

withr::local_options(transltr.verbose = FALSE)

path_mock1 <- get_mock_path(file.path("find-source", "r-script1"))
path_mock2 <- get_mock_path(file.path("find-source", "r-script2"))

tokens_mock1 <- find_source_exprs(path_mock1)
tokens_mock2 <- find_source_exprs(path_mock2)

texts_mock1 <- find_source_in_exprs(tokens_mock1, path_mock1)
texts_mock2 <- find_source_in_exprs(tokens_mock2, path_mock2, interface = quote(translate))

# find_source_in_file() --------------------------------------------------------

test_that("find_source_in_file() works", {
    # This function is just a semantic wrapper for
    # find_source_in_exprs() and therefore, we only
    # check if it returns the output of the former.
    texts_mock1 <- find_source_in_file(path_mock1)
    texts_mock2 <- find_source_in_file(path_mock2, interface = quote(translate))

    expect_type(texts_mock1, "list")
    expect_type(texts_mock2, "list")
    expect_length(texts_mock1, 4L)
    expect_length(texts_mock2, 2L)
    expect_true(all(vapply_1l(texts_mock1, is_text)))
    expect_true(all(vapply_1l(texts_mock2, is_text)))
})

test_that("find_source_in_file() outputs basic information if verbose is true", {
    expect_output(find_source_in_file(path_mock1, verbose = TRUE), "Extracted 4 source text")
})

# find_source_in_exprs() -------------------------------------------------------

test_that("find_source_in_exprs() returns a list of Text objects", {
    expect_type(texts_mock1, "list")
    expect_type(texts_mock2, "list")
    expect_length(texts_mock1, 4L)
    expect_length(texts_mock2, 2L)
    expect_true(all(vapply_1l(texts_mock1, is_text)))
    expect_true(all(vapply_1l(texts_mock2, is_text)))
})

test_that("find_source_in_exprs() processes all calls to $translate() if interface is null", {
    texts_mock1   <- find_source_in_exprs(tokens_mock1, path_mock1)
    texts_mock2   <- find_source_in_exprs(tokens_mock2, path_mock2)
    source_texts1 <- vapply_1c(texts_mock1, `[[`, i = "source_text")
    source_texts2 <- vapply_1c(texts_mock2, `[[`, i = "source_text")

    expect_identical(source_texts1, c(
        "Hello Shiny!",
        "Number of bins:",
        "Waiting time to next eruption (in mins)",
        "Histogram of waiting times"))
    expect_identical(source_texts2, c("e", "f"))
})

test_that("find_source_in_exprs() processes all calls to interface if it not null", {
    texts_mock1   <- find_source_in_exprs(tokens_mock1, path_mock1, interface = quote(translate))
    texts_mock2   <- find_source_in_exprs(tokens_mock2, path_mock2, interface = quote(translate))
    texts_mock3   <- find_source_in_exprs(tokens_mock2, path_mock2, interface = quote(transltr::translate))
    source_texts1 <- vapply_1c(texts_mock1, `[[`, i = "source_text")
    source_texts2 <- vapply_1c(texts_mock2, `[[`, i = "source_text")
    source_texts3 <- vapply_1c(texts_mock3, `[[`, i = "source_text")

    expect_identical(source_texts1, character())
    expect_identical(source_texts2, c("a", "c"))
    expect_identical(source_texts3, c("b", "d"))
})

test_that("find_source_in_exprs() uses source locations returned by the parser", {
    # Locations were determined manually by
    # inspecting mock script rscript-1.
    texts_mock <- find_source_in_exprs(tokens_mock1, path_mock1)
    locations  <- unlist(lapply(texts_mock, `[[`, i = "locations"), FALSE, FALSE)

    expect_identical(locations, list(
        location(path_mock1,  4L, 23L,  4L, 50L),
        location(path_mock1, 12L, 27L, 12L, 59L),
        location(path_mock1, 40L, 22L, 40L, 78L),
        location(path_mock1, 41L, 22L, 41L, 65L)))
})

# find_source_exprs() ----------------------------------------------------------

test_that("find_source_exprs() returns a data.frame of expr tokens", {
    required_fields <- c("line1", "col1", "line2", "col2", "text")

    expect_s3_class(tokens_mock1, "data.frame")
    expect_s3_class(tokens_mock2, "data.frame")
    expect_contains(names(tokens_mock1), required_fields)
    expect_contains(names(tokens_mock2), required_fields)
    expect_true(all(tokens_mock1$token == "expr"))
    expect_true(all(tokens_mock2$token == "expr"))
})

# is_source() ------------------------------------------------------------------

test_that("is_source() returns a logical", {
    expect_true(is_source(str2lang('tr$translate("test")')))
    expect_false(is_source(str2lang('tr$method("test")')))
})

test_that("is_source() returns false if x is not a call", {
    expect_false(is_source(expression()))
    expect_false(is_source(as.name("symbol")))
})

test_that("is_source() looks for calls to $translate() if interface is null", {
    expect_true(is_source(str2lang('tr$translate("test")')))
    expect_false(is_source(str2lang('translate("test")')))

    # Check that quotes and backticks are handled appropriately.
    expect_true(is_source(str2lang('`tr`$`translate`("test")')))
    expect_true(is_source(str2lang('`$`(tr, translate)("test")')))
    expect_true(is_source(str2lang('`$`(tr, "translate")("test")')))
    expect_true(is_source(str2lang('`$`(`tr`, `translate`)("test")')))
})

test_that("is_source() returns false when calls to $translate() include ...", {
    expect_true(is_source(str2lang('tr$translate()')))
    expect_false(is_source(str2lang('tr$translate(..., lang = language_get())')))
})

test_that("is_source() looks for calls to interface if it is a name", {
    intf <- quote(translate)

    expect_true(is_source(str2lang('translate("test")'),     intf))
    expect_false(is_source(str2lang('tr$translate("test")'), intf))

    # Check that quotes and backticks are handled appropriately.
    expect_true(is_source(str2lang('"translate"("test")'), intf))
    expect_true(is_source(str2lang('`translate`("test")'), intf))
})

test_that("is_source() looks for calls to interface if it is a call", {
    intf <- quote(transltr::translate)

    expect_true(is_source(str2lang('transltr::translate("test")'), intf))
    expect_false(is_source(str2lang('tr$translate("test")'),       intf))

    # Check that quotes and backticks are handled appropriately.
    expect_true(is_source(str2lang('transltr::"translate"("test")'),   intf))
    expect_true(is_source(str2lang('"transltr"::translate("test")'),   intf))
    expect_true(is_source(str2lang('transltr::`translate`("test")'),   intf))
    expect_true(is_source(str2lang('`transltr`::translate("test")'),   intf))
    expect_true(is_source(str2lang('"transltr"::`translate`("test")'), intf))
    expect_true(is_source(str2lang('`transltr`::"translate"("test")'), intf))
})

Try the transltr package in your browser

Any scripts or data that you put into this service are public.

transltr documentation built on April 3, 2025, 9:33 p.m.