Add parse preparation tests

.Rbuildignore

@@ -21,3 +21,5 @@
 ^\.covrignore$
 ^\.github$
 \.*gcov$
+^.*\.Rproj$
+^\.Rproj\.user$

DESCRIPTION

@@ -14,10 +14,10 @@ URL: https://github.com/mrc-ide/odin2
 BugReports: https://github.com/mrc-ide/odin2/issues
 Imports:
     cli,
-    dust2,
     rlang
 Suggests:
-    testthat (>= 3.0.0)
+    testthat (>= 3.0.0),
+    withr
 Remotes:
     mrc-ide/dust2@mrc-5356
 Config/testthat/edition: 3

R/parse_prepare.R

@@ -6,7 +6,7 @@ parse_prepare <- function(quo, input, call) {
     src <- NULL
     if (rlang::is_call(info$value, "quote")) {
       cli::cli_abort(
-        "You have an extra layer of quote() around 'expr'",
+        "You have an extra layer of 'quote()' around 'expr'",
         arg = "expr", call = call)
     }
     if (!rlang::is_call(info$value, "{")) {
@@ -20,7 +20,8 @@ parse_prepare <- function(quo, input, call) {
       filename <- info$value
       exprs <- parse(file = filename, keep.source = TRUE)
     } else {
-      exprs <- parse(text = info$value, keep.source = TRUE)
+      str <- paste(info$value, collapse = "\n")
+      exprs <- parse(text = str, keep.source = TRUE)
     }
     start <- utils::getSrcLocation(exprs, "line", first = TRUE)
     end <- utils::getSrcLocation(exprs, "line", first = FALSE)
@@ -46,7 +47,7 @@ parse_prepare_detect <- function(quo, input, call) {
   envir <- rlang::quo_get_env(quo)
 
   ## First, resolve and redirection via symbols:
-  if (rlang::is_symbol(quo)) {
+  if (rlang::is_symbol(expr)) {
     sym <- rlang::as_name(expr)
     if (!rlang::env_has(envir, sym, inherit = TRUE)) {
       cli::cli_abort("Could not find expression '{sym}'",
@@ -97,6 +98,18 @@ parse_prepare_detect <- function(quo, input, call) {
                        arg = "expr", call = call)
       }
     }
+  } else {
+    if (is.null(input)) {
+      expected <- "a string, character vector or expression"
+    } else if (input == "expression") {
+      expected <- "an expression"
+    } else if (input == "file") {
+      expected <- "a string"
+    } else if (input == "text") {
+      expected <- "a string or character vector"
+    }
+    cli::cli_abort("Invalid input for odin; expected {expected}",
+                   arg = "expr", call = call)
   }
   list(type = input, value = expr)
 }

odin2.Rproj

@@ -0,0 +1,17 @@
+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source

tests/testthat/test-parse-prepare.R

@@ -0,0 +1,182 @@
+test_that("can detect expression as an expression", {
+  expr <- quote({a <- 1})
+  quo <- rlang::new_quosure(expr)
+  expect_equal(
+    parse_prepare_detect(quo, NULL, NULL),
+    list(type = "expression",
+         value = expr))
+  expect_equal(
+    parse_prepare_detect(quo, "expression", NULL),
+    parse_prepare_detect(quo, NULL, NULL))
+})
+
+
+test_that("can detect a path as a filename", {
+  path <- withr::local_tempfile()
+  quo <- rlang::new_quosure(path)
+  writeLines("a <- 1", path)
+  expect_equal(parse_prepare_detect(quo, NULL, NULL),
+               list(type = "file", value = path))
+  expect_equal(parse_prepare_detect(quo, "file", NULL),
+               parse_prepare_detect(quo, NULL, NULL))
+})
+
+
+test_that("can detect code as a string", {
+  code <- "a <- 1\nb <- 2"
+  expect_equal(
+    parse_prepare_detect(rlang::new_quosure(code), NULL, NULL),
+    list(type = "text", value = code))
+})
+
+
+test_that("can detect code as a character vector", {
+  code <- c("a <- 1", "b <- 2")
+  expect_equal(
+    parse_prepare_detect(rlang::new_quosure(code), NULL, NULL),
+    list(type = "text", value = code))
+})
+
+
+test_that("throw error on unclassifiable input", {
+  expect_error(
+    parse_prepare_detect(rlang::new_quosure(NULL), NULL, NULL),
+    "Invalid input for odin; expected a string, character vector or")
+  expect_error(
+    parse_prepare_detect(rlang::new_quosure(TRUE), NULL, NULL),
+    "Invalid input for odin; expected a string, character vector or")
+})
+
+
+test_that("sensible error if requiring expression but given other type", {
+  expect_error(
+    parse_prepare_detect(rlang::new_quosure("a <- 1"), "expression", NULL),
+    "Invalid input for odin; given string but expected expression")
+  expect_error(
+    parse_prepare_detect(rlang::new_quosure(NULL), "expression", NULL),
+    "Invalid input for odin; expected an expression")
+})
+
+
+test_that("sensible error if requiring a file but given other type", {
+  expect_error(
+    parse_prepare_detect(rlang::new_quosure(quote({a <- 1})), "file", NULL),
+    "Invalid input for odin; given expression but expected file")
+  expect_error(
+    parse_prepare_detect(rlang::new_quosure(NULL), "file", NULL),
+    "Invalid input for odin; expected a string")
+})
+
+
+test_that("sensible error if requiring a file but the file does not exist", {
+  quo <- rlang::new_quosure("somepath.R")
+  expect_error(
+    parse_prepare_detect(quo, "file", NULL),
+    "File 'somepath.R' does not exist")
+})
+
+
+test_that("sensible error if file argument is invalid", {
+  expect_error(
+    parse_prepare_detect(rlang::new_quosure(character()), "file", NULL),
+    "Invalid input for odin; expected a scalar for 'expr'")
+  expect_error(
+    parse_prepare_detect(rlang::new_quosure(letters), "file", NULL),
+    "Invalid input for odin; expected a scalar for 'expr'")
+})
+
+
+test_that("sensible error if given a non-existant file-like string", {
+  expect_error(
+    parse_prepare_detect(rlang::new_quosure("foo.R"), NULL, NULL),
+    "'foo.R' looks like a filename but does not exist")
+})
+
+
+test_that("sensible error if requiring text but given other type", {
+  expect_error(
+    parse_prepare_detect(rlang::new_quosure(quote({a <- 1})), "text", NULL),
+    "Invalid input for odin; given expression but expected text")
+  expect_error(
+    parse_prepare_detect(rlang::new_quosure(NULL), "text", NULL),
+    "Invalid input for odin; expected a string or character vector")
+})
+
+
+test_that("redirect through symbols", {
+  a <- "a <- 1\nb <- 2"
+  expect_equal(
+    parse_prepare_detect(rlang::new_quosure(quote(a)), "text", NULL),
+    list(type = "text",
+         value = a))
+  expect_error(
+    parse_prepare_detect(rlang::new_quosure(quote(asdfa)), "text", NULL),
+    "Could not find expression 'asdfa'")
+})
+
+
+test_that("can load code from an expression", {
+  quo <- rlang::new_quosure(quote({
+    a <- 1
+    b <- 2
+  }))
+  expect_equal(
+    parse_prepare(quo, NULL, NULL),
+    list(type = "expression",
+         filename = NULL,
+         exprs = list(list(value = quote(a <- 1)),
+                      list(value = quote(b <- 2)))))
+})
+
+
+test_that("fail if an extra level of quoting is present", {
+  quo <- rlang::new_quosure(quote(quote({a <- 1})))
+  expect_error(
+    parse_prepare(quo, NULL, NULL),
+    "You have an extra layer of 'quote()' around 'expr'",
+    fixed = TRUE)
+})
+
+
+test_that("require that expr is multiline", {
+  quo <- rlang::new_quosure(quote(a <- 1))
+  expect_error(
+    parse_prepare(quo, NULL, NULL),
+    "Expected 'expr' to be a multiline expression within curly braces",
+    fixed = TRUE)
+})
+
+
+test_that("can read expressions from file", {
+  path <- withr::local_tempfile()
+  writeLines(c("a <- 1", "b <- 2"), path)
+  expect_equal(
+    parse_prepare(rlang::new_quosure(path), "file", NULL),
+    list(type = "file",
+         filename = path,
+         exprs = list(list(value = quote(a <- 1),
+                           start = 1,
+                           end = 1,
+                           str = "a <- 1"),
+                      list(value = quote(b <- 2),
+                           start = 2,
+                           end = 2,
+                           str = "b <- 2"))))
+})
+
+
+test_that("can read expressions from file", {
+  code <- c("a <- 1", "b <- 2")
+  expect_equal(
+    parse_prepare(rlang::new_quosure(code), "text", NULL),
+    list(type = "text",
+         filename = NULL,
+         exprs = list(list(value = quote(a <- 1),
+                           start = 1,
+                           end = 1,
+                           str = "a <- 1"),
+                      list(value = quote(b <- 2),
+                           start = 2,
+                           end = 2,
+                           str = "b <- 2"))))
+})