Merge branch 'hotfix/nchar'

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: R.utils
-Version: 2.0.1
+Version: 2.0.2
 Depends:
   R (>= 2.5.0),
   R.oo (>= 1.18.0)
@@ -9,7 +9,7 @@ Imports:
   R.methodsS3 (>= 1.7.0)
 Suggests:
   digest (>= 0.6.8)
-Date: 2015-04-24
+Date: 2015-04-27
 Title: Various Programming Utilities
 Authors@R: c(person("Henrik", "Bengtsson", role=c("aut", "cre", "cph"),
                                           email = "henrikb@braju.com"))

NEWS

@@ -2,6 +2,15 @@
 Package: R.utils
 ================
 
+Version: 2.0.2 [2015-04-27]
+o ROBUSTNESS: Now nchar(..., type="chars") is used internally for
+  all file and directory names.
+o BUG FIX: Arguments$getReadablePathname(NA, mustExist=FALSE) no
+  longer gives an error with recent R devel (>= 2015-04-23) related
+  to an update on how nchar() handles missing values. This bug
+  affected only Windows.
+
+
 Version: 2.0.1 [2015-04-24]
 o CLEANUP: R.utils no longer generates a warning if the R session
   is saved when R exits.  Thanks to Jose Alquicira Hernandez for

R/Arguments.R

@@ -48,6 +48,10 @@ setConstructorS3("Arguments", function(...) {
 #  otherwise an exception is thrown.
 # }
 #
+# \section{Missing values}{
+#   If \code{filename} is a missing value, then an exception is thrown.
+# }
+#
 # \details{
 #   When argument \code{class="safe"}, the following 86 ASCII characters
 #   are allowed in filenames:
@@ -99,6 +103,9 @@ setMethodS3("getFilename", "Arguments", function(static, filename, nchar=c(1,128
   }
 
   # Argument 'filename':
+  if (is.na(filename)) {
+    throw("Argument 'filename' cannot be a missing value: ", filename)
+  }
   filename <- getCharacter(static, filename, nchar=nchar, .name=.name);
 
   # Argument 'class':
@@ -126,7 +133,7 @@ setMethodS3("getFilename", "Arguments", function(static, filename, nchar=c(1,128
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Check for remaining (=invalid) characters
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-  if (nchar(chars) > 0) {
+  if (nchar(chars, type="chars") > 0L) {
     chars <- unlist(strsplit(chars, split=""));
     chars <- sort(unique(chars));
     chars <- sprintf("'%s'", chars);
@@ -251,8 +258,8 @@ setMethodS3("getReadablePathname", "Arguments", function(static, file=NULL, path
   # https://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   if (.Platform$OS.type == "windows") {
-    if (nchar(pathname) > 255L) {
-      msg <- sprintf("A too long pathname (%d characters) was detected on Windows, where maximum number of symbols is 256 and in R it is one less: %s", nchar(pathname), pathname);
+    if (!is.na(pathname) && nchar(pathname, type="chars") > 255L) {
+      msg <- sprintf("A too long pathname (%d characters) was detected on Windows, where maximum number of symbols is 256 and in R it is one less: %s", nchar(pathname, type="chars"), pathname);
       warning(msg);
     }
   }
@@ -297,8 +304,8 @@ setMethodS3("getReadablePathname", "Arguments", function(static, file=NULL, path
   # https://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   if (.Platform$OS.type == "windows") {
-    if (nchar(pathname) > 255L) {
-      msg <- sprintf("A too long pathname (%d characters) was detected on Windows, where maximum number of symbols is 256 and in R it is one less: %s", nchar(pathname), pathname);
+    if (!is.na(pathname) && nchar(pathname, type="chars") > 255L) {
+      msg <- sprintf("A too long pathname (%d characters) was detected on Windows, where maximum number of symbols is 256 and in R it is one less: %s", nchar(pathname, type="chars"), pathname);
       warning(msg);
     }
   }
@@ -740,6 +747,11 @@ setMethodS3("getVector", "Arguments", function(static, x, length=NULL, .name=NUL
 #  thrown.
 # }
 #
+# \section{Missing values}{
+#   If \code{s} contains missing values, and \code{nchar} is not @NULL,
+#   then an exception is thrown.
+# }
+#
 # @author
 #
 # \seealso{
@@ -788,12 +800,17 @@ setMethodS3("getCharacters", "Arguments", function(static, s, length=NULL, trim=
   if (is.null(nchar))
     return(s);
 
+  # At this point, missing values are not allowed
+  if (any(is.na(s))) {
+    throw("Argument 'nchar' cannot be specified if character vector contains missing values: ", hpaste(sQuote(s)))
+  }
+
   if (length(nchar) == 1L)
     nchar <- c(1L, nchar);
 
   # Check the string length of each character string
   for (kk in seq(length=length(s))) {
-    slen <- nchar(s[kk]);
+    slen <- nchar(s[kk], type="chars");
     if (slen < nchar[1L] || slen > nchar[2L]) {
       throw(sprintf("String length of elements #%d in '%s' is out of range [%d,%d]: %d '%s'", kk, .name, nchar[1L], nchar[2L], slen, s[kk]));
     }

R/Options.R

@@ -2,7 +2,7 @@
 # @RdocClass Options
 #
 # @title "The Options class"
-# 
+#
 # @synopsis
 #
 # \arguments{
@@ -27,9 +27,9 @@
 # \value{
 #  The constructor returns an Options object.
 # }
-# 
+#
 # \details{
-#  Note, this class and its methods do \emph{not} operate on the global 
+#  Note, this class and its methods do \emph{not} operate on the global
 #  options structure defined in \R (\link{options}).
 # }
 #
@@ -62,7 +62,7 @@ setConstructorS3("Options", function(options=list(), ...) {
 # \description{
 #   @get "title".
 # }
-# 
+#
 # @synopsis
 #
 # \arguments{
@@ -94,7 +94,7 @@ setMethodS3("as.character", "Options", function(x, ...) {
 # @RdocMethod as.list
 #
 # @title "Gets a list representation of the options"
-# 
+#
 # \description{
 #  @get "title".
 # }
@@ -127,7 +127,7 @@ setMethodS3("as.list", "Options", function(x, ...) {
 # @RdocMethod equals
 #
 # @title "Checks if this object is equal to another Options object"
-# 
+#
 # \description{
 #  @get "title".
 # }
@@ -150,9 +150,9 @@ setMethodS3("as.list", "Options", function(x, ...) {
 # @keyword programming
 #*/#########################################################################
 setMethodS3("equals", "Options", function(this, other, ...) {
-  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Local functions
-  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   equals.list <- function(list1, list2) {
     if (length(list1) != length(list2))
       return(FALSE);
@@ -172,9 +172,9 @@ setMethodS3("equals", "Options", function(this, other, ...) {
     TRUE;
   }
 
-  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Main comparison
-  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   if (!inherits(other, "Options"))
     return(FALSE);
 
@@ -195,7 +195,7 @@ setMethodS3("equals", "Options", function(this, other, ...) {
 # \description{
 #   @get "title".
 # }
-# 
+#
 # @synopsis
 #
 # \arguments{
@@ -231,7 +231,7 @@ setMethodS3("str", "Options", function(object, header=paste(class(this)[1], ":\n
 # @RdocMethod names
 #
 # @title "Gets the full pathname of all (non-list) options"
-# 
+#
 # \description{
 #  @get "title".
 # }
@@ -265,7 +265,7 @@ setMethodS3("names", "Options", function(x, ...) {
 # @RdocMethod getLeaves
 #
 # @title "Gets all (non-list) options in a flat list"
-# 
+#
 # \description{
 #  @get "title".
 # }
@@ -287,9 +287,9 @@ setMethodS3("names", "Options", function(x, ...) {
 # @keyword programming
 #*/#########################################################################
 setMethodS3("getLeaves", "Options", function(this, ...) {
-  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Local functions
-  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   getLeaves <- function(list, ...) {
     if (length(list) == 0)
       return(NULL);
@@ -319,7 +319,7 @@ setMethodS3("getLeaves", "Options", function(this, ...) {
 # @RdocMethod nbrOfOptions
 #
 # @title "Gets the number of options set"
-# 
+#
 # \description{
 #  @get "title".
 # }
@@ -351,7 +351,7 @@ setMethodS3("nbrOfOptions", "Options", function(this, ...) {
 # @RdocMethod hasOption
 #
 # @title "Checks if an option exists"
-# 
+#
 # \description{
 #  @get "title".
 # }
@@ -389,7 +389,7 @@ setMethodS3("hasOption", "Options", function(this, pathname, ...) {
   pathname <- as.character(pathname);
 
   if (length(pathname) != 1) {
-    throw("Argument 'pathname' must be a single character string: ", 
+    throw("Argument 'pathname' must be a single character string: ",
                                            paste(pathname, collapse=", "));
   }
 
@@ -399,7 +399,7 @@ setMethodS3("hasOption", "Options", function(this, pathname, ...) {
 
   pathname <- unlist(strsplit(pathname, split="/"));
 
-  if (any(nchar(pathname) == 0))
+  if (any(nchar(pathname, type="chars") == 0))
     throw("Argument 'pathname' contains a zero length elements.");
 
   cur <- as.list(this);
@@ -430,7 +430,7 @@ setMethodS3("hasOption", "Options", function(this, pathname, ...) {
 # @RdocMethod getOption
 #
 # @title "Gets an option"
-# 
+#
 # \description{
 #  @get "title" in the options tree structure or return a default value.
 # }
@@ -441,13 +441,13 @@ setMethodS3("hasOption", "Options", function(this, pathname, ...) {
 #   \item{pathname}{A single or a @vector of @character strings specifying
 #      the paths to the options to be queried.
 #      By default the complete options structure is returned.}
-#   \item{defaultValue}{The default value to be returned, if option is 
+#   \item{defaultValue}{The default value to be returned, if option is
 #      missing. If multiple options are queried at the same times, multiple
 #      default values may be specified as a @vector or a @list.}
 #   \item{...}{Not used.}
 # }
 #
-# \value{If a single option is queried, a single value is returned. 
+# \value{If a single option is queried, a single value is returned.
 #   If a @vector of options are queried, a @list of values are returned.
 #   For non-existing options, the default value is returned.}
 #
@@ -478,7 +478,7 @@ setMethodS3("getOption", "Options", function(this, pathname=NULL, defaultValue=N
   pathname <- as.character(pathname);
 
   if (length(pathname) != 1) {
-    throw("Argument 'pathname' must be a single character string: ", 
+    throw("Argument 'pathname' must be a single character string: ",
                                            paste(pathname, collapse=", "));
   }
 
@@ -488,7 +488,7 @@ setMethodS3("getOption", "Options", function(this, pathname=NULL, defaultValue=N
 
   pathname <- unlist(strsplit(pathname, split="/"));
 
-  if (any(nchar(pathname) == 0))
+  if (any(nchar(pathname, type="chars") == 0))
     throw("Argument 'pathname' contains a zero length elements.");
 
   cur <- as.list(this);
@@ -523,7 +523,7 @@ setMethodS3("getOption", "Options", function(this, pathname=NULL, defaultValue=N
 # @RdocMethod setOption
 #
 # @title "Sets an option"
-# 
+#
 # \description{
 #  @get "title" in the options tree structure.
 # }
@@ -572,7 +572,7 @@ setMethodS3("setOption", "Options", function(this, pathname, value, overwrite=TR
   pathname <- as.character(pathname);
 
   if (length(pathname) != 1) {
-    throw("Argument 'pathname' must be a single character string: ", 
+    throw("Argument 'pathname' must be a single character string: ",
                                            paste(pathname, collapse=", "));
   }
 
@@ -588,7 +588,7 @@ setMethodS3("setOption", "Options", function(this, pathname, value, overwrite=TR
 
   pathname <- unlist(strsplit(pathname, split="/"));
 
-  if (any(nchar(pathname) == 0))
+  if (any(nchar(pathname, type="chars") == 0))
     throw("Argument 'pathname' contains a zero length elements.");
 
   if (is.null(this$.options))

R/Sys.readlink2.R

@@ -162,7 +162,7 @@ file.info2 <- function(...) {
   pathnames <- sapply(pathnames, FUN=Sys.readlink2);
 
   # Drop non-symbolic links
-  keep <- (!is.na(pathnames) & nchar(pathnames) > 0L);
+  keep <- (!is.na(pathnames) & nchar(pathnames, type="chars") > 0L);
   pathnames <- pathnames[keep];
   idxs <- idxs[keep];
 

R/System.R

@@ -493,12 +493,12 @@ setMethodS3("findGhostscript", "System", function(static, updateRGSCMD=TRUE, fir
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   isFileX <- function(pathname, ...) {
     if (length(pathname) == 0L) return(logical(0L));
-    (nchar(pathname) > 0L) & sapply(pathname, FUN=isFile);
+    (nchar(pathname, type="chars") > 0L) & sapply(pathname, FUN=isFile);
   } # isFileX()
 
   isDirectoryX <- function(path, ...) {
     if (length(path) == 0L) return(logical(0L));
-    (nchar(path) > 0L) & sapply(path, FUN=isDirectory);
+    (nchar(path, type="chars") > 0L) & sapply(path, FUN=isDirectory);
   } # isDirectoryX()
 
   findGSBySysEnv <- function(names=c("R_GSCMD"), ...) {

R/fileAccess.R

@@ -69,7 +69,7 @@ setMethodS3("fileAccess", "default", function(pathname, mode=0, safe=TRUE, ...)
   # Follow symbol file links
   pathname0 <- pathname;
   pathnameT <- Sys.readlink2(pathname, what="corrected");
-  if (!is.na(pathnameT) && nchar(pathnameT) > 0L) {
+  if (!is.na(pathnameT) && nchar(pathnameT, type="chars") > 0L) {
     pathname <- pathnameT;
   }
 

R/findFiles.R

@@ -60,7 +60,7 @@ setMethodS3("findFiles", "default", function(pattern=NULL, paths=NULL, recursive
     # If in format "path1; path2;path3", split it to multiple strings.
     paths <- unlist(strsplit(paths, split=";"));
     paths <- gsub("[ \t]*$", "", gsub("^[ \t]*", "", paths));
-    paths <- paths[nchar(paths) > 0];
+    paths <- paths[nchar(paths, type="chars") > 0];
     if (length(paths) == 0)
       return(NULL);
     paths;
@@ -133,7 +133,7 @@ setMethodS3("findFiles", "default", function(pattern=NULL, paths=NULL, recursive
 
     # Exclude listings that are neither files nor directories
     files <- gsub("^[.][/\\]", "", files);
-    files <- files[nchar(files) > 0];
+    files <- files[nchar(files, type="chars") > 0L];
     if (length(files) > 0) {
       excl <- (basename(files) %in% c(".", "..", "/", "\\"));
       files <- files[!excl];

R/isEof.connection.R

@@ -45,5 +45,5 @@ setMethodS3("isEof", "connection", function(con, ...) {
 # 2007-11-26
 # o Added Rdoc comments.
 # 2007-04-01
-# o Created. 
-############################################################################ 
+# o Created.
+############################################################################