R Under development (unstable) (2023-11-16 r85542 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2023 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library("R.utils")
Loading required package: R.oo
Loading required package: R.methodsS3
R.methodsS3 v1.8.2 (2022-06-13 22:00:14 UTC) successfully loaded. See ?R.methodsS3 for help.
R.oo v1.25.0 (2022-06-12 02:20:02 UTC) successfully loaded. See ?R.oo for help.

Attaching package: 'R.oo'

The following object is masked from 'package:R.methodsS3':

    throw

The following objects are masked from 'package:methods':

    getClasses, getMethods

The following objects are masked from 'package:base':

    attach, detach, load, save

R.utils v2.12.3 successfully loaded. See ?R.utils for help.

Attaching package: 'R.utils'

The following object is masked from 'package:utils':

    timestamp

The following objects are masked from 'package:base':

    cat, commandArgs, getOption, isOpen, nullfile, parse, warnings

> 
> 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)
[1] "D:\\temp\\Rtmp8oxsEY\\fileaccc66ef57d0.output.txt"
> res <- withSink(file=pathname, {
+   print(letters)
+   NULL
+ })
> mfile(pathname)

D:\temp\Rtmp8oxsEY\fileaccc66ef57d0.output.txt:
-------------------------------------------------
 [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s"
[20] "t" "u" "v" "w" "x" "y" "z"
-------------------------------------------------
> mprint(warnings())
> 
> 
> # Divert standard error/messages
> pathname <- tempfile(fileext=".message.txt")
> mprint(pathname)
[1] "D:\\temp\\Rtmp8oxsEY\\fileaccc14487c31.message.txt"
> res <- withSink(file=pathname, type="message", {
+   mprint(letters)
+   NULL
+ })
> mfile(pathname)

D:\temp\Rtmp8oxsEY\fileaccc14487c31.message.txt:
-------------------------------------------------
 [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s"
[20] "t" "u" "v" "w" "x" "y" "z"
-------------------------------------------------
> mprint(warnings())
> 
> 
> # Divert standard output (and make sure to close any other sinks opened)
> pathname <- tempfile(fileext=".output2.txt")
> mprint(pathname)
[1] "D:\\temp\\Rtmp8oxsEY\\fileaccc13ad44f9.output2.txt"
> res <- withSink(file=pathname, {
+   print(letters)
+   pathnameT <- tempfile(fileext=".output3.txt")
+   sink(pathnameT, type="output")
+   print(LETTERS)
+   mstr(1:10)
+ }, append=TRUE)
 int [1:10] 1 2 3 4 5 6 7 8 9 10
Warning in withSink(file = pathname, { :
  Closing unclosed sink #2 of type 'output' that was opened during evaluation.
> mfile(pathname)

D:\temp\Rtmp8oxsEY\fileaccc13ad44f9.output2.txt:
-------------------------------------------------
 [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s"
[20] "t" "u" "v" "w" "x" "y" "z"
-------------------------------------------------
> mprint(warnings())
> 
> 
> # Assert that all connections opened were closed
> cons1 <- showConnections()
> mprint(cons0)
     description class mode text isopen can read can write
> mprint(cons1)
     description class mode text isopen can read can write
> 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)
List of 2
 $ value  : num 1
 $ visible: logi TRUE
> stopifnot(all.equal(res$value, 1))
> stopifnot(res$visible)
> 
> x <- 0
> res <- withVisible({
+   withSink({ print(1); x <- 1 }, file=pathname)
+ })
> str(res)
List of 2
 $ value  : num 1
 $ visible: logi FALSE
> stopifnot(all.equal(res$value, 1))
> stopifnot(!res$visible)
> stopifnot(all.equal(x, 1))
> 
> proc.time()
   user  system elapsed 
   2.75   20.68   24.25