updated tests for latest changes, re #17, #18, #19

tests/testthat/test-destructure.R

@@ -1,13 +1,16 @@
-context(' * testing destructure')
+context(" * testing destructure")
 
-test_that('destructure atomics', {
-  expect_equal(destructure('hello'), list('h', 'e', 'l', 'l', 'o'))
+test_that("destructure atomics", {
+  expect_equal(destructure("hello"), list("h", "e", "l", "l", "o"))
   expect_equal(destructure(complex(1, 33, -7)), list(33, -7))
 
-  expect_error(destructure(1), 'cannot de-structure')
+  expect_error(
+    destructure(1),
+    "invalid `%<-%` right-hand side, incorrect number of values"
+  )
 })
 
-test_that('destructure data.frame converts data.frame to list', {
+test_that("destructure data.frame converts data.frame to list", {
   sample_df <- head(iris)
   expect_equal(destructure(sample_df), as.list(sample_df))
   expect_equal(length(sample_df), NCOL(sample_df))
@@ -17,25 +20,34 @@ test_that('destructure data.frame converts data.frame to list', {
   }
 })
 
-test_that('destructure converts Date to list of year, month, day', {
+test_that("destructure converts Date to list of year, month, day", {
   today <- Sys.Date()
-  year <- as.numeric(format(today, '%Y'))
-  month <- as.numeric(format(today, '%m'))
-  day <- as.numeric(format(today, '%d'))
+  year <- as.numeric(format(today, "%Y"))
+  month <- as.numeric(format(today, "%m"))
+  day <- as.numeric(format(today, "%d"))
   expect_equal(destructure(today), list(year, month, day))
 })
 
-test_that('destructure summary.lm converts to list', {
+test_that("destructure summary.lm converts to list", {
   f <- lm(disp ~ mpg, data = mtcars)
   expect_equal(destructure(summary(f)), lapply(summary(f), identity))
 })
 
-test_that('destructure throws error for multi-length vectors of atomics', {
-  expect_error(assert_destruction(character(2)), 'cannot de-structure character vector')
-  expect_error(destructure(c(Sys.Date(), Sys.Date())), 'cannot de-structure Date vector')
+test_that("destructure throws error for multi-length vectors of atomics", {
+  expect_error(
+    assert_destruction(character(2)),
+    "invalid `destructure` argument, cannot de-structure character vector of length greater than 1"
+  )
+  expect_error(
+    destructure(c(Sys.Date(), Sys.Date())),
+    "invalid `destructure` argument, cannot de-structure Date vector of length greater than 1"
+  )
 })
 
-test_that('destructure throws error as default', {
-  random <- structure(list(), class = 'random')
-  expect_error(destructure(random), 'cannot de-structure random')
+test_that("destructure throws error as default", {
+  random <- structure(list(), class = "random")
+  expect_error(
+    destructure(random),
+    "invalid `%<-%` right-hand side, incorrect number of values"
+  )
 })

tests/testthat/test-massign.R

@@ -1,66 +1,67 @@
-context(' * testing massign')
+context(" * testing massign")
 
-test_that('massign handles flat lists', {
-  massign(list('a'), list(1))
+test_that("massign handles flat lists", {
+  massign(list("a"), list(1))
   expect_equal(a, 1)
 
-  massign(list('b', 'c'), list(3, 'foo'))
+  massign(list("b", "c"), list(3, "foo"))
   expect_equal(b, 3)
-  expect_equal(c, 'foo')
+  expect_equal(c, "foo")
 })
 
-test_that('massign handles nested lists', {
-  massign(list('a', list('b')), list(1, list(2)))
+test_that("massign handles nested lists", {
+  massign(list("a", list("b")), list(1, list(2)))
   expect_equal(a, 1)
   expect_equal(b, 2)
 
-  massign(list('c', list('d', 'e'), 'f'), list(5, list(6, 7), 8))
+  massign(list("c", list("d", "e"), "f"), list(5, list(6, 7), 8))
   expect_equal(c, 5)
   expect_equal(d, 6)
   expect_equal(e, 7)
   expect_equal(f, 8)
 
-  massign(list(list('g', 'h'), list('i', 'j')), list(list('gee', 'ech'), list('ay', 'jey')))
-  expect_equal(g, 'gee')
-  expect_equal(h, 'ech')
-  expect_equal(i, 'ay')
-  expect_equal(j, 'jey')
+  massign(list(list("g", "h"), list("i", "j")), list(list("gee", "ech"), list("ay", "jey")))
+  expect_equal(g, "gee")
+  expect_equal(h, "ech")
+  expect_equal(i, "ay")
+  expect_equal(j, "jey")
 })
 
-test_that('massign will not destructure flat list', {
-  massign(list('a', 'b'), list(1, list(2, 3)))
+test_that("massign will not destructure flat list", {
+  massign(list("a", "b"), list(1, list(2, 3)))
   expect_equal(a, 1)
   expect_equal(b, list(2, 3))
-  massign(list(list('c', 'd'), 'e'), list(list('foo', list('bar', 'baz')), 'buzz'))
-  expect_equal(c, 'foo')
-  expect_equal(d, list('bar', 'baz'))
-  expect_equal(e, 'buzz')
+  massign(list(list("c", "d"), "e"), list(list("foo", list("bar", "baz")), "buzz"))
+  expect_equal(c, "foo")
+  expect_equal(d, list("bar", "baz"))
+  expect_equal(e, "buzz")
 })
 
-test_that('massign does not assign .', {
-  massign(list('.'), list('pick me, pick me'))
-  expect_false(exists('.', inherits = FALSE))
+test_that("massign does not assign .", {
+  massign(list("."), list("pick me, pick me"))
+  expect_false(exists(".", inherits = FALSE))
 
-  massign(list('a', '.', 'b'), list(1, 2, 3))
+  massign(list("a", ".", "b"), list(1, 2, 3))
   expect_equal(a, 1)
-  expect_false(exists('.', inherits = FALSE))
+  expect_false(exists(".", inherits = FALSE))
   expect_equal(b, 3)
 })
 
-test_that('massign does not destructure when using rest prefix', {
-  massign(list('...rest'), list(1, list(2, 3)))
+test_that("massign does not destructure when using rest prefix", {
+  massign(list("...rest"), list(1, list(2, 3)))
   expect_equal(rest, list(1, list(2, 3)))
 
-  massign(list('a', '...all'), list(1, list('a', 'b')))
+  massign(list("a", "...all"), list(1, list("a", "b")))
   expect_equal(a, 1)
-  expect_equal(all, list('a', 'b'))
+  expect_equal(all, list("a", "b"))
 
-  massign(list('f', '...rest'), list('foo', 'bar', 'baz'))
-  expect_equal(f, 'foo')
-  expect_equal(rest, list('bar', 'baz'))
+  massign(list("f", "...rest"), list("foo", "bar", "baz"))
+  expect_equal(f, "foo")
+  expect_equal(rest, list("bar", "baz"))
 })
 
-test_that('massign throws error for invalid rest prefix', {
-  expect_error(massign(list('a', '...'), list(1, 2)),
-               'invalid collector variable')
+test_that("massign throws error for invalid rest prefix", {
+  skip("skipped for now per issue #18")
+  expect_error(massign(list("a", "..."), list(1, 2)),
+               "invalid collector variable")
 })

tests/testthat/test-operator.R

@@ -1,29 +1,31 @@
-context(' * testing assignment operator')
+context(" * testing assignment operator")
 
-test_that('%<-% does *not* act like <-', {
-  expect_error(a %<-% 1, 'use `<-` for standard assignment', fixed = TRUE)
-  expect_error(b %<-% NULL, 'use `<-` for standard assignment', fixed = TRUE)
+test_that("%<-% can perform standard assignment", {
+  a %<-% "foo"
+  expect_equal(a, "foo")
+  b %<-% list(1, 2, 3)
+  expect_equal(b, list(1, 2, 3))
 })
 
-test_that('%<-% handles list of 1 name and list of 1 value', {
-  {a} %<-% list('foo')
-  expect_equal(a, 'foo')
+test_that("%<-% handles list of 1 name and list of 1 value", {
+  {a} %<-% list("foo")
+  expect_equal(a, "foo")
 
   expect_error(
-    {a} %<-% 'foo',
-    'expecting list of values, but found vector'
+    {a} %<-% "foo",
+    "expecting list of values, but found vector"
   )
 })
 
-test_that('%<-% throws error if value is list, but no braces on lhs', {
-  expect_error(a: b %<-% list(1, 2), 'expecting vector of values, but found list')
+test_that("%<-% throws error if value is list, but no braces on lhs", {
+  expect_error(a: b %<-% list(1, 2), "expecting vector of values, but found list")
 })
 
-test_that('%<-% throws error if value is vector, but lhs has braces', {
-  expect_error({a: b} %<-% c(1, 2), 'expecting list of values, but found vector')
+test_that("%<-% throws error if value is vector, but lhs has braces", {
+  expect_error({a: b} %<-% c(1, 2), "expecting list of values, but found vector")
 })
 
-test_that('%<-% preserves class when collecting atomic vectors', {
+test_that("%<-% preserves class when collecting atomic vectors", {
   a : ...b %<-% 1:5
   expect_equal(a, 1)
   expect_equal(b, 2:5)
@@ -33,92 +35,123 @@ test_that('%<-% preserves class when collecting atomic vectors', {
   expect_equal(d, FALSE)
 })
 
-test_that('%<-% requires braces when destructuring single object', {
-  {a: b} %<-% faithful
+test_that("%<-% requires braces when destructuring single object", {
+  {a : b} %<-% faithful
   expect_equal(a, faithful[[1]])
   expect_equal(b, faithful[[2]])
 
-  expect_error(c: d %<-% faithful, 'expecting vector of values, but found data.frame')
+  expect_error(c : d %<-% faithful, "expecting vector of values, but found data.frame")
 })
 
-test_that('%<-% destructures vector', {
-  a: b %<-% c('hello', 'world')
-  expect_equal(a, 'hello')
-  expect_equal(b, 'world')
+test_that("%<-% destructures vector", {
+  a : b %<-% c("hello", "world")
+  expect_equal(a, "hello")
+  expect_equal(b, "world")
 })
 
-test_that('%<-% cannot destructure nested vectors', {
-  expect_error({{a: b}: {c: d}} %<-% list(c(1, 2), c(3, 4)), 'expecting 2 values, but found 1')
+test_that("%<-% cannot destructure nested vectors", {
+  expect_error(
+    {{a : b} : {c : d}} %<-% list(c(1, 2), c(3, 4)),
+    "invalid `%<-%` right-hand side, incorrect number of values"
+  )
 })
 
-test_that('%<-% destructure list', {
-  {a: b} %<-% list('hello', 3030)
-  expect_equal(a, 'hello')
+test_that("%<-% destructure list", {
+  {a : b} %<-% list("hello", 3030)
+  expect_equal(a, "hello")
   expect_equal(b, 3030)
 })
 
-test_that('%<-% destructure list of lists', {
-  {a: b} %<-% list(list('hello', 'world'), list('goodnight', 'moon'))
-  expect_equal(a, list('hello', 'world'))
-  expect_equal(b, list('goodnight', 'moon'))
+test_that("%<-% destructure list of lists", {
+  {a: b} %<-% list(list("hello", "world"), list("goodnight", "moon"))
+  expect_equal(a, list("hello", "world"))
+  expect_equal(b, list("goodnight", "moon"))
 })
 
-test_that('%<-% destructure internal vector to list', {
-  {a: b} %<-% list(list('hello', 'world'), 1:5)
-  expect_equal(a, list('hello', 'world'))
+test_that("%<-% destructure internal vector to list", {
+  {a: b} %<-% list(list("hello", "world"), 1:5)
+  expect_equal(a, list("hello", "world"))
   expect_equal(b, 1:5)
 })
 
-test_that('%<-% assigns nested names', {
-  {a: {b: c}} %<-% list('hello', list('moon', list('world', '!')))
-  expect_equal(a, 'hello')
-  expect_equal(b, 'moon')
-  expect_equal(c, list('world', '!'))
+test_that("%<-% assigns nested names", {
+  {a: {b: c}} %<-% list("hello", list("moon", list("world", "!")))
+  expect_equal(a, "hello")
+  expect_equal(b, "moon")
+  expect_equal(c, list("world", "!"))
 })
 
-test_that('%<-% handles S3 objects with underlying list structure', {
-  shape <- function(sides = 4, color = 'red') {
+test_that("%<-% handles S3 objects with underlying list structure", {
+  shape <- function(sides = 4, color = "red") {
     structure(
       list(
         sides = sides,
         color = color
       ),
-      class = 'shape'
+      class = "shape"
     )
   }
 
-  expect_error(a %<-% shape(), 'use `<-` for standard assignment', fixed = TRUE)
-
-  expect_error({a: b} %<-% shape(), 'cannot de-structure shape')
+  expect_error(
+    {a : b} %<-% shape(),
+    "invalid `%<-%` right-hand side, incorrect number of values"
+  )
 })
 
-test_that('%<-% skips values using .', {
+test_that("%<-% skips values using .", {
   {a: .: c} %<-% list(1, 2, 3)
   expect_equal(a, 1)
-  expect_false(exists('.', inherits = FALSE))
+  expect_false(exists(".", inherits = FALSE))
   expect_equal(c, 3)
 
 
   {d: {e: .: f}: g} %<-% list(4, list(5, 6, 7), 8)
   expect_equal(d, 4)
   expect_equal(e, 5)
-  expect_false(exists('.', inherits = FALSE))
+  expect_false(exists(".", inherits = FALSE))
   expect_equal(f, 7)
   expect_equal(g, 8)
 })
 
-test_that('%<-% throws error if unequal nesting', {
-  expect_error({a: b} %<-% list(1), 'cannot de-structure numeric')
-  expect_error({a: b: c} %<-% list(1), 'cannot de-structure numeric')
-  expect_error({a: b: c} %<-% list(1, 2), 'expecting 3 values, but found 2')
+test_that("%<-% skips multiple values using ...", {
+  { a : ... } %<-% list(1, 2, 3, 4)
+  expect_equal(a, 1)
+  { ... : b } %<-% list(1, 2, 3, 4)
+  expect_equal(b, 4)
+})
+
+test_that("%<-% throws error if unequal nesting", {
+  expect_error(
+    {a : b} %<-% list(1),
+    "invalid `%<-%` right-hand side, incorrect number of values"
+  )
+  expect_error(
+    {a : b : c} %<-% list(1),
+    "invalid `%<-%` right-hand side, incorrect number of values"
+  )
+  expect_error(
+    {a : b : c} %<-% list(1, 2),
+    "invalid `%<-%` right-hand side, incorrect number of values"
+  )
 
-  expect_error({{a: b}: {c: d: e}} %<-% list(list(1, 2), list(3, 4)),
-               'expecting 3 values, but found 2')
+  expect_error(
+    {{a : b} : {c : d : e}} %<-% list(list(1, 2), list(3, 4)),
+    "invalid `%<-%` right-hand side, incorrect number of values"
+  )
 })
 
-test_that('%<-% throws error if invalid calls used on LHS', {
-  expect_error({a + b} %<-% list(1), 'unexpected call `+`', fixed = TRUE)
-  expect_error({a: {quote(d): c}} %<-% list(1, list(2, 3)),
-               'unexpected call `quote`')
-  expect_error({mean(1, 2): a} %<-% list(1, 2), 'unexpected call `mean`')
+test_that("%<-% throws error if invalid calls used on LHS", {
+  expect_error(
+    {a + b} %<-% list(1),
+    "invalid `%<-%` left-hand side, unexpected call `+`",
+    fixed = TRUE
+  )
+  expect_error(
+    {a : {quote(d) : c}} %<-% list(1, list(2, 3)),
+    "invalid `%<-%` left-hand side, unexpected call `quote`"
+  )
+  expect_error(
+    {mean(1, 2) : a} %<-% list(1, 2),
+    "invalid `%<-%` left-hand side, unexpected call `mean`"
+  )
 })