tests/testthat/test-parse_all.R

In evaluate: Parsing and Evaluation Tools that Provide More Details than the Default

test_that("can parse empty input", {
  expect_equal(parse_all(character())$src, character())
})

test_that("can parse even if no expressions", {
  expect_equal(parse_all("")$src, "\n")
  expect_equal(parse_all("#")$src, "#\n")
  expect_equal(parse_all("#\n\n")$src, c("#\n", "\n"))
})

test_that("every line gets nl", {
  expect_equal(parse_all("x")$src, "x\n")
  expect_equal(parse_all("")$src, "\n")
  expect_equal(parse_all("\n")$src, "\n")

  # even empty lines
  expect_equal(parse_all("a\n\nb")$src, c("a\n", "\n", "b\n"))
  expect_equal(parse_all("a\n\nb\n")$src, c("a\n", "\n", "b\n"))

  expect_equal(parse_all("\n\n")$src, c("\n", "\n"))
})

test_that("empty lines are never silently dropped", {
  # It's not possible to simulate problem directly from code, but it can occur
  # in knitr
  # ```{r, tidy = TRUE}`
  # for (i in 1) {}
  # # two blank lines below
  #
  #
  # 1
  # ```
  expect_equal(parse_all(c("\n", "", "1"))$src, c("\n", "\n", "1\n"))
})

test_that("a character vector is equivalent to a multi-line string", {
  expect_equal(parse_all(c("a", "b")), parse_all(c("a\nb")))
})

test_that("recombines multi-expression TLEs", {
  expect_equal(parse_all("1;2;3")$expr[[1]], expression(1, 2, 3))
  expect_equal(parse_all("1+\n2;3")$expr[[1]], expression(1 + 2, 3))
  expect_equal(
    parse_all("1+\n2;3+\n4; 5")$expr[[1]],
    expression(1 + 2, 3 + 4, 5)
  )
})

test_that("re-integrates lines without expressions", {
  expect_equal(parse_all("1\n\n2")$src, c("1\n", "\n", "2\n"))
  expect_equal(parse_all("1\n#\n2")$src, c("1\n", "#\n", "2\n"))
})

test_that("expr is always an expression", {
  expect_equal(parse_all("#")$expr[[1]], expression())
  expect_equal(parse_all("1")$expr[[1]], expression(1))
  expect_equal(parse_all("1;2")$expr[[1]], expression(1, 2))

  parsed <- parse_all("#\n1\n1;2")
  expect_equal(lengths(parsed$expr), c(0, 1, 2))
})

test_that("parse(allow_error = TRUE/FALSE)", {
  expect_error(parse_all("x <-", allow_error = FALSE))
  res <- parse_all("x <-", allow_error = TRUE)
  expect_true(inherits(attr(res, "PARSE_ERROR"), "error"))

  # And correctly flows through to evaluate
  expect_no_error(evaluate("x <-", stop_on_error = 0))
})

test_that("double quotes in Chinese characters not destroyed", {
  skip_if_not(l10n_info()[["UTF-8"]])

  out <- parse_all(c("1+1", '"你好"'))
  expect_equal(out$src[[2]], '"你好"\n')
  expect_equal(out$expr[[2]], expression("你好"))
})

test_that("multibyte characters are parsed correctly", {
  skip_if_not(l10n_info()[["UTF-8"]])

  code <- c("ϱ <- 1# g / ml", "äöüßÄÖÜπ <- 7 + 3# nonsense")
  out <- parse_all(code)
  expect_equal(out$src, paste0(code, "\n"))
})

# input types ------------------------------------------------------------------

test_that("can parse a call", {
  out <- parse_all(quote(f(a, b, c)))
  expect_equal(out$src, "f(a, b, c)\n")
  expect_equal(out$expr, list(expression(f(a, b, c))))
})

test_that("can parse a connection", {
  path <- withr::local_tempfile(lines = c("# 1", "1 + 1"))
  cur_cons <- getAllConnections()

  con <- file(path)
  out <- parse_all(con)

  expect_equal(out$src, c("# 1\n", "1 + 1\n"))
  expect_equal(out$expr, list(expression(), expression(1 + 1)))

  # Doesn't leave any connections around
  expect_equal(getAllConnections(), cur_cons)
})

test_that("can parse a function", {
  out <- parse_all(function() {
    # Hi
    1 + 1
  })
  expect_equal(out$src, c("# Hi\n", "1 + 1\n"))
  expect_equal(out$expr, list(expression(), expression(1 + 1)))
})

# find_function_body -----------------------------------------------------------

test_that("parsing a function parses its body", {
  out <- parse_all(function() {
    # Hi
    1 + 1
  })
  expect_equal(out$src, c("# Hi\n", "1 + 1\n"))
})

test_that("dedents function body", {
  f <- function() {
    1 + 1
  }
  expect_equal(find_function_body(f), "1 + 1")
})

test_that("preserves src if possible", {
  f <- function() {
    1 +  1 # hi
  }
  expect_equal(find_function_body(f), "1 +  1 # hi")

  f <- removeSource(f)
  expect_equal(find_function_body(f), "1 + 1")
})

test_that("isn't flumoxed by nested parens", {
  f <- function() {
    {
      1 + 1
    }
  }
  expect_equal(find_function_body(f), c("{", "  1 + 1", "}"))
})

test_that("works if no parens", {
  f <- function() 1 + 1
  expect_equal(find_function_body(f), "1 + 1")

  f <- function() (
    1 + 1
  )
  expect_equal(find_function_body(f), "(1 + 1)")
})

test_that("can handle empty body", {
  f <- function() {}
  expect_equal(find_function_body(f), character())
})