tests/testthat/test_arrow.R

In mdequeljoe/fu: javascript-style arrow function operator

context("arrow")

test_that("function with 0 parameters returned",{
  hi <- c() %F% "hi"
  random <- c() %F% rnorm(sample(1:10, 1))
  expect_true(is.function(hi))
  expect_true(is.function(random))
  expect_equal(hi(), "hi")
  expect_true(is.numeric(random()))
})

test_that("function with 1 parameter returned",{
  v <- a %F% {a^2}
  expect_true(is.function(v))
  expect_equal(v(10), 100)

  v <- c(a = 10) %f% {a^2}
  expect_equal(v(), 100)

  val <- (a %F% {a + 1})(10)
  expect_equal(val, 11)

  k <- lapply(1:10, function(d) d^2 * d)
  v <- lapply(1:10, d %F% {d^2 * d})
  expect_equal(k, v)
})

test_that("function with n parameter returned",{
  v <- c(a, b, c) %F% {(a * b)^c}
  expect_true(is.function(v))
  expect_equal(v(5, 2, 2), 100)
})

test_that("formals with default values are preserved",{
  v <- c(a, b = 2, c = 10) %F% {a + b * c}
  args <- formals(v)
  expect_true(identical(args$a, substitute()))
  expect_equal(args$b, 2)
  expect_equal(args$c, 10)
  expect_equal(v(1), 21)
})

test_that("... are preserved", {
  v <- c(a, b, ...) %F% {
    a^b + sum(c(...))
  }
  expect_equal(names(formals(v)), c("a", "b", "..."))
  expect_equal(v(10, 2, 1, 1, 1), 103)
})

test_that("nested functions are properly evaluated",{

  v <- d %F% {
    c() %F% {
      paste(d, "!")
    }
  }
  hi <- v("hi")

  expect_equal(hi(), "hi !")

  o <- function(d){
    function() {
      function(){
        paste(d, "...")
      }
    }
  }

  v <- d %F% {
    c() %F% {
      c() %F% {
        paste(d, "...")
      }
    }
  }
  expect_equal(o("a")()(), v("a")()())


})