tests/withSink.R

In HenrikBengtsson/R.utils: Various Programming Utilities

library("R.utils")

mfile <- function(file, ...) {
  mprintf("\n%s:\n", file)
  mcat("-------------------------------------------------\n")
  mcat(readLines(pathname), sep="\n")
  mcat("-------------------------------------------------\n")
} # mfile()


# Display warnings as they occur
oopts <- options(warn=1L)

cons0 <- showConnections()

# Divert standard output
pathname <- tempfile(fileext=".output.txt")
mprint(pathname)
res <- withSink(file=pathname, {
  print(letters)
  NULL
})
mfile(pathname)
mprint(warnings())


# Divert standard error/messages
pathname <- tempfile(fileext=".message.txt")
mprint(pathname)
res <- withSink(file=pathname, type="message", {
  mprint(letters)
  NULL
})
mfile(pathname)
mprint(warnings())


# Divert standard output (and make sure to close any other sinks opened)
pathname <- tempfile(fileext=".output2.txt")
mprint(pathname)
res <- withSink(file=pathname, {
  print(letters)
  pathnameT <- tempfile(fileext=".output3.txt")
  sink(pathnameT, type="output")
  print(LETTERS)
  mstr(1:10)
}, append=TRUE)
mfile(pathname)
mprint(warnings())


# Assert that all connections opened were closed
cons1 <- showConnections()
mprint(cons0)
mprint(cons1)
stopifnot(all.equal(cons1, cons0))

# Reset how warnings are displayed
options(oopts)


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Visibility
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
pathname <- tempfile(fileext=".output.txt")
res <- withVisible({
  withSink({ print(1); 1 }, file=pathname)
})
str(res)
stopifnot(all.equal(res$value, 1))
stopifnot(res$visible)

x <- 0
res <- withVisible({
  withSink({ print(1); x <- 1 }, file=pathname)
})
str(res)
stopifnot(all.equal(res$value, 1))
stopifnot(!res$visible)
stopifnot(all.equal(x, 1))