new deparse1line_() with opts arg; using NICE_NAMES in coerceVector…

…list()

git-svn-id: https://svn.r-project.org/R/trunk@73774 00db46b3-68df-0310-9c12-caf00c1e9a41

doc/NEWS.Rd

@@ -119,22 +119,27 @@
       \item \code{approx()}, \code{spline()}, \code{splinefun()} and
       \code{approxfun()} also work for long vectors.
 
+      %% one item with several paragraphs
       \item \code{deparse()} (and \code{dump()}) are more useful for S4
-      objects; \code{dput()} now using the same internal C code (instead
-      of its previous imperfect workaround R code).
+      objects; \code{dput()} now using the same internal C code instead
+      of its previous imperfect workaround R code.
 
-      \code{dput()}, \emph{etc} now print the \code{names()} information
-      only once, using the more readable \code{(tag = value)} syntax,
-      notably for \code{list()}s, i.e., including data frames.
+      \code{dput()}, \code{deparse()} and \code{dump()} now print the
+      \code{names()} information only once, using the more readable
+      \code{(tag = value)} syntax, notably for \code{list()}s, i.e.,
+      including data frames.
 
       These functions gain a new control option \code{"niceNames"} (see
       \code{.deparseOpts()}), which when set (as by default) also uses
       the \code{(tag = value)} syntax for atomic vectors.  OTOH, without
       deparse options \code{"showAttributes"} and \code{"niceNames"},
       names are no longer shown also for lists.
+      \code{as.character(list(  c (one = 1)))} now shows the name as
+      \code{as.character(list(list(one = 1)))} has always done.
 
       \code{m:n} now also deparses nicely when \eqn{m > n}.
 
+
       \item If the option \code{setWidthOnResize} is set and \code{TRUE},
       \R run in a terminal using a recent \code{readline} library will
       set the \code{width} option when the terminal is

src/include/Defn.h

@@ -1108,7 +1108,8 @@ void DataFrameClass(SEXP);
 SEXP ddfindVar(SEXP, SEXP);
 SEXP deparse1(SEXP,Rboolean,int);
 SEXP deparse1w(SEXP,Rboolean,int);
-SEXP deparse1line(SEXP,Rboolean);
+SEXP deparse1line (SEXP, Rboolean);
+SEXP deparse1line_(SEXP, Rboolean, int);
 SEXP deparse1s(SEXP call);
 int DispatchAnyOrEval(SEXP, SEXP, const char *, SEXP, SEXP, SEXP*, int, int);
 int DispatchOrEval(SEXP, SEXP, const char *, SEXP, SEXP, SEXP*, int, int);

src/main/coerce.c

@@ -1,8 +1,8 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
+ *  Copyright (C) 1997-2017  The R Core Team
+ *  Copyright (C) 2003-2017  The R Foundation
  *  Copyright (C) 1995,1996  Robert Gentleman, Ross Ihaka
- *  Copyright (C) 1997-2015  The R Core Team
- *  Copyright (C) 2003-2015  The R Foundation
  *
  *  This program is free software; you can redistribute it and/or modify
  *  it under the terms of the GNU General Public License as published by
@@ -1094,7 +1094,8 @@ static SEXP coerceVectorList(SEXP v, SEXPTYPE type)
 #endif
 	    else
 		SET_STRING_ELT(rval, i,
-			       STRING_ELT(deparse1line(VECTOR_ELT(v, i), 0), 0));
+			       STRING_ELT(deparse1line_(VECTOR_ELT(v, i), 0, NICE_NAMES),
+					  0));
 	}
     }
     else if (type == LISTSXP) {
@@ -1628,6 +1629,9 @@ SEXP attribute_hidden do_ascall(SEXP call, SEXP op, SEXP args, SEXP rho)
     case LISTSXP:
 	ans = duplicate(args);
 	break;
+    case STRSXP:
+	errorcall(call, _("as.call(<character string>)  not yet implemented"));
+	break;
     default:
 	errorcall(call, _("invalid argument list"));
 	ans = R_NilValue;
@@ -1794,8 +1798,7 @@ SEXP attribute_hidden do_is(SEXP call, SEXP op, SEXP args, SEXP rho)
 
     /* These are all builtins, so we do not need to worry about
        evaluating arguments in DispatchOrEval */
-    if(PRIMVAL(op) >= 100 && PRIMVAL(op) < 200 &&
-       isObject(CAR(args))) {
+    if(PRIMVAL(op) >= 100 && PRIMVAL(op) < 200 && isObject(CAR(args))) {
 	/* This used CHAR(PRINTNAME(CAR(call))), but that is not
 	   necessarily correct, e.g. when called from lapply() */
 	const char *nm;

src/main/deparse.c

@@ -271,18 +271,20 @@ static SEXP deparse1WithCutoff(SEXP call, Rboolean abbrev, int cutoff,
     return svec;
 }
 
-/* deparse1line concatenates all lines into one long one */
-/* This is needed in terms.formula, where we must be able */
-/* to deparse a term label into a single line of text so */
-/* that it can be reparsed correctly */
-SEXP deparse1line(SEXP call, Rboolean abbrev)
+/* deparse1line(), e.g. for non-trivial list entries in as.character(<list>).
+ * --------------
+ * Concatenates all lines into one long one.
+ * This is needed in terms.formula, where we must be able
+ * to deparse a term label into a single line of text so
+ * that it can be reparsed correctly */
+SEXP deparse1line_(SEXP call, Rboolean abbrev, int opts)
 {
     SEXP temp;
     Rboolean backtick=TRUE;
     int lines;
 
-    PROTECT(temp = deparse1WithCutoff(call, abbrev, MAX_Cutoff, backtick,
-			     SIMPLEDEPARSE, -1));
+    PROTECT(temp =
+	    deparse1WithCutoff(call, abbrev, MAX_Cutoff, backtick, opts, -1));
     if ((lines = length(temp)) > 1) {
 	char *buf;
 	int i;
@@ -311,6 +313,12 @@ SEXP deparse1line(SEXP call, Rboolean abbrev)
     return(temp);
 }
 
+SEXP deparse1line(SEXP call, Rboolean abbrev)
+{
+    return deparse1line_(call, abbrev, SIMPLEDEPARSE);
+}
+
+
 // called only from ./errors.c  for calls in warnings and errors :
 SEXP attribute_hidden deparse1s(SEXP call)
 {

tests/reg-tests-1d.R

@@ -1290,7 +1290,23 @@ x[1] <- numeric(); stopifnot(identical(x, n0))
 NUL <- NULL
 NUL[3] <- integer(0); NUL[,2] <- character() ; NUL[3,4,5] <- list()
 stopifnot(is.null(NUL))
-## had failed for a few days in R-devel
+## had failed for one day in R-devel
+
+
+## as.character(<list>) should keep names in some nested cases
+cl <-     'list(list(a = 1, "B", ch = "CH", L = list(f = 7)))'
+E <- expression(list(a = 1, "B", ch = "CH", L = list(f = 7)))
+str(ll <- eval(parse(text = cl)))
+stopifnot(
+    identical(eval(E), ll[[1]])
+  , identical(as.character(E), as.character(ll) -> cll)
+  , grepl(cll, cl, fixed=TRUE) # currently, cl == paste0("list(", cll, ")")
+)
+## the last two have failed in R-devel for a while
+stopifnot(
+    identical(as.character(list(list(one = 1))), "list(one = 1)")
+  , identical(as.character(list(  c (one = 1))),    "c(one = 1)")
+)## the last gave "1" in all previous versions of R