tests/withCapture.R

In R.utils: Various Programming Utilities

library("R.utils")

oopts <- options(prompt = "> ")

print(withCapture({
 n <- 3
 n

 for (kk in 1:3) {
   printf("Iteration #%d\n", kk)
 }

 print(Sys.time())

 type <- "horse"
 type
}))


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Assert correct capture of code and output
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
bfr <- withCapture({
 x <- 1
 x
}, newline=TRUE)
print(bfr)
stopifnot(bfr == "> x <- 1\n> x\n[1] 1\n")

bfr <- withCapture({
 x <- 1
 x
}, code=TRUE, output=FALSE, newline=TRUE)
print(bfr)
stopifnot(bfr == "> x <- 1\n> x\n")

bfr <- withCapture({
 x <- 1
 x
}, code=FALSE, output=TRUE, newline=TRUE)
print(bfr)
stopifnot(bfr == "[1] 1\n")


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Fixed substitutions
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
bfr <- withCapture({ x <- a }, replace=list(a="abc"))
print(bfr)
stopifnot(bfr == '> x <- "abc"\n')

res <- tryCatch({
  withCapture({ x <- a }, substitute=list(a="abc"))
}, error = identity)
stopifnot(inherits(res, "error"))


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# With automatic variable substitute
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
a <- 2
bfr <- withCapture({
 x <- .a.
 x
}, newline=TRUE)
print(bfr)
stopifnot(bfr == "> x <- 2\n> x\n[1] 2\n")


# Make sure not to substitute parts of variable names
# or expressions
foo.bar.yaa <- function(x) x
a <- 2
b.c <- 3
bfr <- withCapture({
  res <- foo.bar.yaa(3.14)
  R.utils::use("R.utils")
  x <- .a.
  y <- .b.c.
})
print(bfr)
## ODD: Different results when sourcing and R CMD check:ing
## this test script. /HB 2014-08-12
## stopifnot(bfr ==""> res <- foo.bar.yaa(3.14)\n> R.utils::use(\"R.utils\")\n> x <- 2\n> y <- 3\n")


# Make sure '...' is not substituted
bfr <- withCapture({
  benchmark <- function(fcn, n, len=100L, ...) {
    x <- lineBuffer(n, len=len, ...)
    foo(...)
    system.time({
      fcn(cat(x))
    }, gcFirst=TRUE)[[3]]
 } # benchmark()
})
print(bfr)
## ODD: Different results when sourcing and R CMD check:ing
## this test script. /HB 2014-08-12
## stopifnot(bfr == "> benchmark <- function(fcn, n, len = 100L, ...) {\n+     x <- lineBuffer(n, len = len, ...)\n+     foo(...)\n+     system.time({\n+         fcn(cat(x))\n+     }, gcFirst = TRUE)[[3]]\n+ }\n")


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# BUG TEST: if-else statements
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
bfr <- withCapture(if (TRUE) 1 else 2)
print(bfr)
stopifnot(bfr == "> if (TRUE) 1 else 2\n[1] 1\n")

bfr <- withCapture({if (TRUE) 1 else 2 })
print(bfr)
## ODD: Different results when sourcing and R CMD check:ing
## this test script. /HB 2014-08-12
## stopifnot(bfr == "> if (TRUE) \n+     1 else 2\n[1] 1\n")


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Empty
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
bfr <- withCapture({})
print(bfr)
stopifnot(length(bfr) == 0L)

options(oopts)