dput() & dump() must not truncate when "deparse.max.lines" is set

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

doc/NEWS.Rd

@@ -21,14 +21,17 @@
       when \code{r} has been \dQuote{reproduced} from serialization,
       typically after saving to and reading from an RDS file.
 
-      \item \code{substr()} and \code{substring()} now signal error when
-      the input is invalid UTF-8.
+      \item \code{substr()} and \code{substring()} now signal an error
+      when the input is invalid UTF-8.
 
-      \item \code{file.copy()} now works also when its argument \code{to} is
-      of length greater than one.
+      \item \code{file.copy()} now works also when its argument \code{to}
+      is of length greater than one.
 
       \item \code{mantelhaen.test()} no longer suffers from integer
       overflow in largish cases, thanks to Ben Bolker's \PR{17383}.
+
+      \item \code{dput()} and \code{dump()} are no longer truncating
+      when \code{options(deparse.max.lines = *)} is set.
     }
   }
 

src/include/Defn.h

@@ -698,17 +698,17 @@ extern0 RCNTXT* R_ExitContext;      /* The active context for on.exit processing
 #endif
 extern Rboolean R_Visible;	    /* Value visibility flag */
 extern0 int	R_EvalDepth	INI_as(0);	/* Evaluation recursion depth */
-extern0 int	R_BrowseLines	INI_as(0);	/* lines/per call in browser */
-
+extern0 int	R_BrowseLines	INI_as(0);	/* lines/per call in browser :
+						 * options(deparse.max.lines) */
 extern0 int	R_Expressions	INI_as(5000);	/* options(expressions) */
-extern0 int	R_Expressions_keep INI_as(5000);	/* options(expressions) */
+extern0 int	R_Expressions_keep INI_as(5000);/* options(expressions) */
 extern0 Rboolean R_KeepSource	INI_as(FALSE);	/* options(keep.source) */
 extern0 Rboolean R_CBoundsCheck	INI_as(FALSE);	/* options(CBoundsCheck) */
 extern0 MATPROD_TYPE R_Matprod	INI_as(MATPROD_DEFAULT);  /* options(matprod) */
 extern0 int	R_WarnLength	INI_as(1000);	/* Error/warning max length */
 extern0 int	R_nwarnings	INI_as(50);
 extern uintptr_t R_CStackLimit	INI_as((uintptr_t)-1);	/* C stack limit */
-extern uintptr_t R_OldCStackLimit INI_as((uintptr_t)0); /* Old value while 
+extern uintptr_t R_OldCStackLimit INI_as((uintptr_t)0); /* Old value while
 							   handling overflow */
 extern uintptr_t R_CStackStart	INI_as((uintptr_t)-1);	/* Initial stack address */
 extern int	R_CStackDir	INI_as(1);	/* C stack direction */

src/main/deparse.c

@@ -35,7 +35,8 @@
  *    do_dump() -> deparse1() -> deparse1WithCutoff()
  *  ---------
  *  Workhorse: deparse1WithCutoff() -> deparse2() -> deparse2buff() --> {<itself>, ...}
- *  ---------
+ *  ---------  ~~~~~~~~~~~~~~~~~~ `-- implicit arg R_BrowseLines == getOption("deparse.max.lines")
+ *
  *  ./errors.c: PrintWarnings() | warningcall_dflt() ... -> deparse1s() -> deparse1WithCutoff()
  *  ./print.c : Print[Language|Closure|Expression]()    --> deparse1w() -> deparse1WithCutoff()
  *  bind.c,match.c,..: c|rbind(), match(), switch()...-> deparse1line() -> deparse1WithCutoff()
@@ -185,7 +186,8 @@ SEXP attribute_hidden do_deparse(SEXP call, SEXP op, SEXP args, SEXP rho)
     return deparse1WithCutoff(expr, FALSE, cut0, backtick, opts, nlines);
 }
 
-SEXP deparse1(SEXP call, Rboolean abbrev, int opts)
+// deparse1() version *looking* at getOption("deparse.max.lines")
+SEXP deparse1m(SEXP call, Rboolean abbrev, int opts)
 {
     Rboolean backtick = TRUE;
     int old_bl = R_BrowseLines,
@@ -198,13 +200,25 @@ SEXP deparse1(SEXP call, Rboolean abbrev, int opts)
     return result;
 }
 
+// deparse1() version with R_BrowseLines := 0
+SEXP deparse1(SEXP call, Rboolean abbrev, int opts)
+{
+    Rboolean backtick = TRUE;
+    int old_bl = R_BrowseLines;
+    R_BrowseLines = 0;
+    SEXP result = deparse1WithCutoff(call, abbrev, DEFAULT_Cutoff, backtick,
+				     opts, 0);
+    R_BrowseLines = old_bl;
+    return result;
+}
+
+
 /* used for language objects in print() */
 attribute_hidden
 SEXP deparse1w(SEXP call, Rboolean abbrev, int opts)
 {
     Rboolean backtick = TRUE;
-    return deparse1WithCutoff(call, abbrev, R_print.cutoff, backtick,
-			      opts, -1);
+    return deparse1WithCutoff(call, abbrev, R_print.cutoff, backtick, opts, -1);
 }
 
 static SEXP deparse1WithCutoff(SEXP call, Rboolean abbrev, int cutoff,
@@ -219,14 +233,16 @@ static SEXP deparse1WithCutoff(SEXP call, Rboolean abbrev, int cutoff,
     int savedigits;
     Rboolean need_ellipses = FALSE;
     LocalParseData localData =
-	    {0, 0, 0, 0, /*startline = */TRUE, 0,
-	     NULL,
-	     /*DeparseBuffer=*/{NULL, 0, BUFSIZE},
-	     DEFAULT_Cutoff, FALSE, 0, TRUE,
+	{/* linenumber */ 0,
+	 0, 0, 0, /*startline = */TRUE, 0,
+	 NULL,
+	 /* DeparseBuffer= */ {NULL, 0, BUFSIZE},
+	 DEFAULT_Cutoff, FALSE, 0, TRUE,
 #ifdef longstring_WARN
-	     FALSE,
+	 FALSE,
 #endif
-	     INT_MAX, TRUE, 0, FALSE};
+	 /* maxlines = */ INT_MAX,
+	 /* active = */TRUE, 0, FALSE};
     localData.cutoff = cutoff;
     localData.backtick = backtick;
     localData.opts = opts;
@@ -239,9 +255,9 @@ static SEXP deparse1WithCutoff(SEXP call, Rboolean abbrev, int cutoff,
     svec = R_NilValue;
     if (nlines > 0) {
 	localData.linenumber = localData.maxlines = nlines;
-    } else {
-        if (R_BrowseLines > 0)  /* enough to determine linenumber */
-            localData.maxlines = R_BrowseLines + 1;
+    } else { // default: nlines = -1 (from R), or = 0 (from other C fn's)
+	if(R_BrowseLines > 0)// not by default; e.g. from getOption("deparse.max.lines")
+	    localData.maxlines = R_BrowseLines + 1; // enough to determine linenumber
 	deparse2(call, svec, &localData);
 	localData.active = TRUE;
 	if(R_BrowseLines > 0 && localData.linenumber > R_BrowseLines) {
@@ -292,11 +308,9 @@ static SEXP deparse1WithCutoff(SEXP call, Rboolean abbrev, int cutoff,
  * that it can be reparsed correctly */
 SEXP deparse1line_(SEXP call, Rboolean abbrev, int opts)
 {
-    SEXP temp;
     Rboolean backtick=TRUE;
     int lines;
-
-    PROTECT(temp =
+    SEXP temp = PROTECT(
 	    deparse1WithCutoff(call, abbrev, MAX_Cutoff, backtick, opts, -1));
     if ((lines = length(temp)) > 1) {
 	char *buf;
@@ -335,12 +349,10 @@ SEXP deparse1line(SEXP call, Rboolean abbrev)
 // called only from ./errors.c  for calls in warnings and errors :
 SEXP attribute_hidden deparse1s(SEXP call)
 {
-   SEXP temp;
    Rboolean backtick=TRUE;
-
-   temp = deparse1WithCutoff(call, FALSE, DEFAULT_Cutoff, backtick,
-			     DEFAULTDEPARSE, 1);
-   return(temp);
+   return
+       deparse1WithCutoff(call, FALSE, DEFAULT_Cutoff, backtick,
+			  DEFAULTDEPARSE, /* nlines = */ 1);
 }
 
 #include "Rconnections.h"

src/main/errors.c

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 1995--2017  The R Core Team.
+ *  Copyright (C) 1995--2018  The R Core Team.
  *
  *  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
@@ -1308,7 +1308,7 @@ void WarningMessage(SEXP call, R_WARNING which_warn, ...)
     }
 
 /* clang pre-3.9.0 says
-      warning: passing an object that undergoes default argument promotion to 
+      warning: passing an object that undergoes default argument promotion to
       'va_start' has undefined behavior [-Wvarargs]
 */
     va_start(ap, which_warn);
@@ -1406,7 +1406,7 @@ SEXP R_GetTraceback(int skip)
 	    if (skip > 0)
 		skip--;
 	    else {
-		SETCAR(t, deparse1(c->call, 0, DEFAULTDEPARSE));
+		SETCAR(t, deparse1m(c->call, 0, DEFAULTDEPARSE));
 		if (c->srcref && !isNull(c->srcref)) {
 		    SEXP sref;
 		    if (c->srcref == R_InBCInterpreter)
@@ -2092,7 +2092,7 @@ SEXP R_tryCatch(SEXP (*body)(void *), void *bdata,
 					      R_BaseNamespace);
 	R_PreserveObject(trycatch_callback);
     }
-    
+
     tryCatchData_t tcd = {
 	.body = body,
 	.bdata = bdata,
@@ -2126,7 +2126,7 @@ SEXP do_tryCatchHelper(SEXP call, SEXP op, SEXP args, SEXP env)
     SEXP eptr = CAR(args);
     SEXP sw = CADR(args);
     SEXP cond = CADDR(args);
-    
+
     if (TYPEOF(eptr) != EXTPTRSXP)
 	error("not an external pointer");
 

src/main/print.c

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 2000-2017	The R Core Team.
+ *  Copyright (C) 2000-2018	The R Core Team.
  *  Copyright (C) 1995-1998	Robert Gentleman and Ross Ihaka.
  *
  *  This program is free software; you can redistribute it and/or modify
@@ -684,7 +684,7 @@ static void PrintSpecial(SEXP s)
     if(s2 != R_UnboundValue) {
 	SEXP t;
 	PROTECT(s2);
-	t = deparse1(s2, 0, DEFAULTDEPARSE);
+	t = deparse1m(s2, 0, DEFAULTDEPARSE); // or deparse1() ?
 	Rprintf("%s ", CHAR(STRING_ELT(t, 0))); /* translated */
 	Rprintf(".Primitive(\"%s\")\n", PRIMNAME(s));
 	UNPROTECT(1);
@@ -731,7 +731,7 @@ void attribute_hidden PrintValueRec(SEXP s, SEXP env)
 	break;
     case SYMSXP: /* Use deparse here to handle backtick quotification
 		  * of "weird names" */
-	t = deparse1(s, 0, SIMPLEDEPARSE);
+	t = deparse1(s, 0, SIMPLEDEPARSE); // TODO ? rather deparse1m()
 	Rprintf("%s\n", CHAR(STRING_ELT(t, 0))); /* translated */
 	break;
     case SPECIALSXP:

tests/reg-tests-1d.R

@@ -1744,6 +1744,24 @@ stopifnot(identical(order(x, decreasing=TRUE), as.integer(c(3, 1, 2))))
 ## was incorrect with wrapper optimization (reported by Suharto Anggono)
 
 
+## dump() & dput() where influenced by  "deparse.max.lines" option
+op <- options(deparse.max.lines=NULL) # here
+oNam <- "simplify2array" # (base function which is not very small)
+fn <- get(oNam)
+ffn <- format(fn)
+dp.1 <- capture.output(dput(fn))
+dump(oNam, textConnection("du.1", "w"))
+stopifnot(length(ffn) > 3, identical(dp.1, ffn), identical(du.1[-1], dp.1))
+options(deparse.max.lines = 2) ## "truncate heavily"
+dp.2 <- capture.output(dput(fn))
+dump(oNam, textConnection("du.2", "w"))
+stopifnot(identical(dp.2, dp.1),
+          identical(du.2, du.1))
+options(op); rm(du.1, du.2) # connections
+writeLines(tail(dp.2))
+## dp.2 and du.2  where heavily truncated in R <= 3.4.4, ending  "  ..."
+
+
 
 ## keep at end
 rbind(last =  proc.time() - .pt,