context("rewrite")
## This is just a random set of what would want to be a significantly
## more beefed up set given how evil rewrite is.
test_that("command rewriting", {
res <- rewrite(quote(readRDS("myfile.rds")), filename = "newname")
expect_equal(res$filename, "myfile.rds")
expect_equal(res$expr, quote(readRDS(file = "newname")))
expect_equal(res$tmp, "newname")
## NOTE: This does change argument order...
res <- rewrite(quote(readRDS(NULL, file = "myfile.rds")),
filename = "newname")
expect_equal(res$filename, "myfile.rds")
expect_equal(res$expr, quote(readRDS(file = "newname", refhook = NULL)))
## with dots:
res <- rewrite(quote(read.csv("myfile.csv", stringsAsFactors = FALSE)),
filename = "newname")
expect_equal(res$filename, "myfile.csv")
expect_equal(res$expr,
quote(read.csv(file = "newname", stringsAsFactors = FALSE)))
res <- rewrite(quote(write.csv(x, "myfile.csv")), filename = "other.csv")
expect_equal(res$filename, "myfile.csv")
expect_equal(res$tmp, "other.csv")
expect_equal(res$expr, quote(write.csv(x = x, file = "other.csv")))
expect_error(rewrite(quote(readRDS("myfile")), file_arg = "foo"),
"Cannot infer file argument")
expect_error(rewrite(quote(unknown("myfile"))))
expect_error(rewrite(quote(plot("myfile"))),
"Rewrite rule for .*::plot not found")
})
test_that("filename default argument", {
## Filename from default:
f <- function(x, filename = "foo") {
}
res <- rewrite(quote(f(1)), "filename")
expect_equal(res$filename, "foo") # captured default arg
expect_equal(res$expr[["filename"]], res$tmp) # rewrote expression
res <- rewrite(quote(f(1, "bar")), "filename")
expect_equal(res$filename, "bar") # user-supplied arg
})
test_that("redefined base functions", {
f <- readRDS
res <- rewrite(quote(f("myfile.rds")))
expect_equal(res$filename, "myfile.rds")
expect_equal(res$expr$file, res$tmp)
})
test_that("corner case", {
expect_error(rewrite(quote(foo)),
"Expected call")
})
test_that("namespaced functions", {
res <- rewrite(quote(base::readRDS("myfile.rds")), filename = "newname")
expect_equal(res$filename, "myfile.rds")
expect_equal(res$expr, quote(base::readRDS(file = "newname")))
expect_equal(res$tmp, "newname")
})
## This is not ideal and there may be other cases where this fails
## badly.
test_that("invalid input", {
expect_error(rewrite(quote(1 (foo))), "Confused")
expect_error(rewrite(quote(factory()(foo))), "Invalid function call for name")
})
test_that("register", {
on.exit(rewrite_reset())
## Simple case:
rewrite_register("foo", "bar1", "baz")
expect_equal(db[["foo::bar1"]],
list(name = "bar1", package = "foo", arg = "baz", fn = NULL))
## Clash:
expect_silent(rewrite_register("foo", "bar1", "baz"))
expect_error(rewrite_register("foo", "bar1", "baz2"),
"An entry already exists for foo::bar1")
## Other function:
rewrite_register("foo", "bar2", "baz", c("a", "b"))
expect_equal(db[["foo::bar2"]],
list(name = "bar2", package = "foo", arg = "baz",
fn = c("a", "b")))
## Invalid package:
expect_error(rewrite_register(NA, "bar2", "baz"),
"package must be a non-NA scalar character")
expect_error(rewrite_register("foo", "bar2", "baz", "a"),
"fn must be a character vector of length 2")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.