tests/testthat/test.R

context("Tampering")

test_that("We can detect if we are in a pipe", {

  skip(message = "not ready yet for a real test")

  old_handler <- getOption("error")
  on.exit(options(error = old_handler))
  options(error = tamper)

  1:10 %>%
    (function(x) force(x)) %>%
    multiply_by(10) %>%
    add(10) %>%
    add("oh no!") %>%
    subtract(5) %>%
    divide_by(5)

})

test_that("What if the pipe is in a function", {

  skip(message = "not ready yet for a real test")

  old_handler <- getOption("error")
  on.exit(options(error = old_handler))
  options(error = tamper)

  f <- function(data) {
    data %>%
      (function(x) force(x)) %>%
      multiply_by(10) %>%
      add(10) %>%
      add("oh no!") %>%
      subtract(5) %>%
      divide_by(5)
  }

  f(1:10)

})

test_that("Pipes within pipes are OK", {

  skip(message = "not ready yet for a real test")

  old_handler <- getOption("error")
  on.exit(options(error = old_handler))
  options(error = tamper)

  f <- function(data) {
    data %>%
      (function(x) force(x)) %>%
      multiply_by(10) %>%
      add(10) %>%
      add("oh no!") %>%
      subtract(5) %>%
      divide_by(5)
  }

  1:10 %>%
    multiply_by(2) %>%
    f() %>%
    add(1:10)

})

test_that("Error in the lhs is OK", {

  skip(message = "not ready yet for a real test")

  old_handler <- getOption("error")
  on.exit(options(error = old_handler))
  options(error = tamper)

  (1 + "foo") %>%
    multiply_by(2) %>%
    add(1) %>%
    print()

})

test_that("Using non-primitive functions", {

  skip(message = "not ready yet for a real test")

  old_handler <- getOption("error")
  on.exit(options(error = old_handler))
  options(error = tamper)

  ## Make sure these are not primitive
  multiply_by <- function(x, y) if (1) x * y
  add <- function(x, y) if (1) x + y
  subtract <- function(x, y) if (1) x - y
  divide_by <- function(x, y) if (1) x / y

  1:10 %>%
    (function(x) force(x)) %>%
    multiply_by(10) %>%
    add(10) %>%
    add("oh no!") %>%
    subtract(5) %>%
    divide_by(5)

})
gaborcsardi/tamper documentation built on May 16, 2019, 4:16 p.m.