tests/testthat/test-pipe.R

In magrittr: A Forward-Pipe Operator for R

test_that("exposition operator wraps `with()`", {
  out <- mtcars %>% identity() %$% (head(cyl) / mean(am))
  expect_identical(out, head(mtcars$cyl) / mean(mtcars$am))
})

test_that("compound operator works with fancy pipes", {
  data <- mtcars
  data %<>% identity %$% (head(cyl) / mean(am))
  data
  expect_identical(data, head(mtcars$cyl) / mean(mtcars$am))
})

test_that("eager pipe expressions are evaluated in the current environment", {
  rlang::local_bindings(`%>%` = pipe_eager_lexical)

  fn <- function(...) parent.frame()
  out <- NULL %>% identity() %>% fn()
  expect_identical(out, environment())

  fn <- function() {
    NULL %>% identity() %>% { return(TRUE) }
    FALSE
  }
  expect_true(fn())
})

test_that("`.` is restored", {
  1 %>% identity()
  expect_error(., "not found")

  . <- "foo"
  1 %>% identity()
  expect_identical(., "foo")
})

test_that("lazy pipe evaluates expressions lazily (#120)", {
   out <- stop("foo") %>% identity() %>% tryCatch(error = identity)
   expect_true(inherits(out, "simpleError"))

   ignore <- function(...) NA
   out <- stop("foo") %>% identity() %>% ignore()
   expect_identical(out, NA)

   out <- stop("foo") %T>% identity() %>% ignore()
   expect_identical(out, NA)

   out %<>% stop() %>% ignore()
   expect_identical(out, NA)
})

test_that("lazy pipe evaluates `.` in correct environments", {
  out <- NA %>% list(.) %>% list(.) %>% list(.)
  expect_identical(out, list(list(list(NA))))
})

test_that("nested pipe can't use multiple placeholders", {
  rlang::local_bindings(`%>%` = pipe_nested)
  expect_error(
    1 %>% list(., .),
    "multiple"
  )
})

test_that("can splice magrittr input (#191)", {
  out <- 1:3 %>% rlang::list2(!!!.)
  exp <- rlang::list2(!!!1:3)
  expect_identical(out, exp)
})

test_that("allow trailing return for backward compatibility", {
  expect_error(1 %>% { return(.) })
  expect_identical(1 %>% return(), 1)

  f <- function() 1 %>% identity() %>% return()
  expect_identical(f(), 1)
})

test_that("visibility is forwarded", {
  expect_equal(
    withVisible(mtcars %>% { identity(.$cyl) }),
    list(value = mtcars$cyl, visible = TRUE)
  )
  expect_equal(
    withVisible(mtcars %$% cyl),
    list(value = mtcars$cyl, visible = TRUE)
  )
  expect_equal(
    withVisible(mtcars %T>% identity() %>% { identity(.$cyl) }),
    list(value = mtcars$cyl, visible = TRUE)
  )

  expect_equal(
    withVisible(mtcars %>% { invisible(.$cyl) }),
    list(value = mtcars$cyl, visible = FALSE)
  )
  expect_equal(
    withVisible(mtcars %$% invisible(cyl)),
    list(value = mtcars$cyl, visible = FALSE)
  )
  expect_equal(
    withVisible(mtcars %T>% identity() %>% { invisible(.$cyl) }),
    list(value = mtcars$cyl, visible = FALSE)
  )
})

test_that("`%<>%` always returns invisibly", {
  foo <- 1
  expect_equal(
    withVisible(foo %<>% add(1) %>% identity()),
    list(value = 2, visible = FALSE)
  )
  expect_equal(
    withVisible(foo %<>% add(1) %>% invisible()),
    list(value = 3, visible = FALSE)
  )
})

test_that("internal parameters are not looked up beyond private envs of the pipes (#233)", {
  nested <- "not looked up"

  # Fails because of the duplicate placeholder if nested transformation is performed
  expect_equal(1 %>% list(., .), list(1, 1))
})

test_that("eager pipe evaluates sequentially", {
  local_edition(3)

  f <- function(x) {
    message("foo")
    x
  }
  g <- function(x) {
    message("bar")
    x
  }
  h <- function(x) {
    message("baz")
    invisible(x)
  }
  expect_snapshot({
    NULL %>% f() %>% g() %>% h()
    NULL %!>% f() %!>% g() %!>% h()
  })
})