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

> verbose <- Arguments$getVerbose(TRUE, timestamp=TRUE)
> 
> # Run only tests if this platform/client supports symbolic file links
> canSymlink <- tryCatch({
+   res <- file.symlink(".", "test-symlink-dir")
+   if (isDirectory("test-symlink-dir")) removeDirectory("test-symlink-dir")
+   res
+ }, error = function(ex) FALSE)
Warning message:
In file.symlink(".", "test-symlink-dir") :
  cannot symlink '.' to 'test-symlink-dir', reason 'Dem Client fehlt ein erforderliches Recht'
> 
> 
> # Test only if symlinks are supported
> if (canSymlink) {
+ 
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # Local functions
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ fileAccessT <- function(pathname, modes=c(exist=0, exec=1, write=2, read=4)) {
+   sapply(modes, FUN=function(mode) fileAccess(pathname, mode=mode))
+ }
+ 
+ 
+ filename <- "foo.txt"
+ paths <- list(".", tempdir())
+ 
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # FILES
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ for (path in paths) {
+   verbose && enter(verbose, "Symbolic links to files")
+   verbose && cat(verbose, "Path: ", path)
+ 
+   pathnameS <- pathname <- file.path(path, filename)
+ 
+   # WORKAROUND: On Windows, file.symlink() does not translate forward
+   # slashes for you! Fixed (PR#15631) in r64711 2014-01-09.
+   if (.Platform$OS.type == "windows") {
+     pathnameS <- gsub("/", "\\", pathname, fixed=TRUE)
+   }
+ 
+   # Create a target file
+   cat("Hello", file=pathname)
+ 
+   # Create a symbolic link
+   pathnameL <- file.path(path, sprintf("link-to-%s", filename))
+   file.symlink(pathnameS, pathnameL)
+   stopifnot(isFile(pathnameL))
+   stopifnot(identical(lastModified(pathnameL), lastModified(pathname)))
+ 
+   # Get target pathname
+   pathnameT <- Sys.readlink2(pathnameL)
+   # Should be equal
+   stopifnot(getAbsolutePath(pathnameT) == getAbsolutePath(pathname))
+ 
+   # Read contents (directly and via link)
+   bfr <- readChar(pathname, n=1e6)
+   bfrL <- readChar(pathnameL, n=1e6)
+   # Should be identical content
+   stopifnot(identical(bfrL, bfr))
+ 
+   # Append content (via link)
+   cat(" world!", file=pathnameL, append=TRUE)
+ 
+   # Read contents (directly and via link)
+   bfr <- readChar(pathname, n=1e6)
+   printf("Target content: '%s'\n", bfr)
+   bfrL <- readChar(pathnameL, n=1e6)
+   printf("Link content  : '%s'\n", bfrL)
+   # Should be identical content
+   stopifnot(identical(bfrL, bfr))
+ 
+   # Retrieve file information (directly and via link)
+   fi <- file.info(pathname)
+   printf("*** file.info('%s'):\n", pathname)
+   print(fi)
+   fiL <- file.info2(pathnameL)
+   printf("*** file.info2('%s'):\n", pathnameL)
+   print(fiL)
+   # Should be equal file information except the filenames
+   stopifnot(all.equal(fiL, fi, check.attributes=FALSE))
+   stopifnot(identical(lastModified(pathnameL), lastModified(pathname)))
+ 
+   # Note that file.info() does not follow links on Windows
+   if (.Platform$OS.type == "windows") {
+     fiLx <- file.info(pathnameL)
+     printf("*** file.info('%s'):\n", pathnameL)
+     print(fiLx)
+     res <- all.equal(fiLx, fi, check.attributes=FALSE)
+   }
+ 
+   # Renaming
+   verbose && enter(verbose, "Renaming file link")
+   pathnameL2 <- sprintf("%s-new", pathnameL)
+   renameFile(pathnameL, pathnameL2)
+   stopifnot(isFile(pathnameL2))
+   stopifnot(!isFile(pathnameL))
+   renameFile(pathnameL2, pathnameL)
+   stopifnot(isFile(pathnameL))
+   stopifnot(!isFile(pathnameL2))
+   verbose && exit(verbose)
+ 
+   # File access
+   verbose && enter(verbose, "Testing file permissions & access information")
+   fa <- fileAccessT(pathname)
+   faL <- fileAccessT(pathnameL)
+   stopifnot(identical(faL, fa))
+ 
+   # Disable write permission on target
+   Sys.chmod(pathname, mode="0077")
+   fa <- fileAccessT(pathname)
+   faL <- fileAccessT(pathnameL)
+   stopifnot(identical(faL, fa))
+   # Reset
+   Sys.chmod(pathname, mode="0777")
+   verbose && exit(verbose)
+ 
+ 
+   # Removing & cleanup
+   verbose && enter(verbose, "Cleanup")
+ 
+   verbose && enter(verbose, "Removing file link")
+   verbose && cat(verbose, "Link: ", pathnameL)
+   verbose && cat(verbose, "Target: ", pathname)
+   file.remove(pathnameL)  # unlink() cannot remove symbolic links
+   stopifnot(!file.exists(pathnameL))
+   stopifnot(isFile(pathname))
+   verbose && exit(verbose)
+ 
+   verbose && enter(verbose, "Removing target")
+   file.remove(pathname)
+   stopifnot(!file.exists(pathname))
+   verbose && exit(verbose)
+ 
+   verbose && exit(verbose)
+ 
+   verbose && exit(verbose)
+ } # for (path in ...)
+ 
+ } # if (canSymlink)
> 
> proc.time()
   user  system elapsed 
   0.35    0.14    0.43