prevent options(scipen = NULL) or = 1e99; set and document limits.

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

Author: maechler

doc/NEWS.Rd

@@ -386,6 +386,12 @@
       (non integer) seconds.  Fixes \PR{17350}, thanks to new contributions
       by \I{LatinR}'s \sQuote{\I{R Dev Day}} participants, \I{Heather
       Turner} and \I{Dirk Eddelbuettel}.
+
+      \item \code{options(scipen = NULL)} and other invalid values now
+      signal an error instead of invalidating ops relying on a finite
+      integer value.  Newly, values outside the range -9 .. 9999 are warned
+      about and set to a respective boundary or to the default \code{0},
+      e.g., in case of an \code{NA}.
     }
   }
 }

src/include/Print.h

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 1997--2021  The R Core Team.
+ *  Copyright (C) 1997--2024  The R Core Team.
  *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
  *
  *  This program is free software; you can redistribute it and/or modify
@@ -74,9 +74,12 @@ void R_PV(SEXP s);
 /* Offset for rowlabels if there are named dimnames */
 #define R_MIN_LBLOFF 2
 
+/* Enforced in  ../main/options.c : */
 #define R_MIN_WIDTH_OPT		10
 #define R_MAX_WIDTH_OPT		10000
 #define R_MIN_DIGITS_OPT	1
 #define R_MAX_DIGITS_OPT	22
+#define R_MIN_SCIPEN_OPT        -9
+#define R_MAX_SCIPEN_OPT	9999
 
 #endif

src/library/base/man/options.Rd

@@ -366,7 +366,13 @@ getOption(x, default = NULL)
       when deciding to print numeric values in fixed or exponential
       notation.  Positive values bias towards fixed and negative towards
       scientific notation: fixed notation will be preferred unless it is
-      more than \code{scipen} digits wider.}
+      more than \code{scipen} digits wider.  The default is \code{0}.
+      Valid values are between -9 and 9999 where \dQuote{relevant} values
+      (for double precision accuracy) are in \code{-6:319}.
+      Some invalid values currently signal a \code{\link{warning}} and are set
+      to legal boundaries if finite.  These may signal an error in a future
+      version of \R.
+    }
 
     \item{\code{setWidthOnResize}:}{a logical. If set and \code{TRUE}, \R
       run in a terminal using a recent \code{readline} library will set

src/main/options.c

@@ -44,7 +44,7 @@
  *	Either accessing and/or setting a global C variable,
  *	or just accessed by e.g.  GetOption1(install("pager"))
  *
- * A (complete?!) list of these (2) {plus some of 1)}:
+ * An (incomplete) list of these (2) {plus some of 1)}:
  *
  *	"prompt"
  *	"continue"
@@ -57,7 +57,6 @@
  *	"keep.source.pkgs"
  *	"keep.parse.data"
  *	"keep.parse.data.pkgs"
- *	"browserNLdisabled"
 
  *	"de.cellwidth"		../unix/X11/ & ../gnuwin32/dataentry.c
  *	"device"
@@ -78,6 +77,8 @@
  *	"warning.expression"
  *	"nwarnings"
 
+ *	"browserNLdisabled"
+
  *	"matprod"
  *      "PCRE_study"
  *      "PCRE_use_JIT"
@@ -174,6 +175,34 @@ attribute_hidden int GetOptionDigits(void)
     return FixupDigits(GetOption1(install("digits")), iWARN);
 }
 
+static
+int FixupScipen(SEXP scipen, warn_type warn)
+{
+    if (!isNumeric(scipen) || LENGTH(scipen) != 1)
+	error(_("invalid 'scipen'"));
+    int d;
+    if(TYPEOF(scipen) == REALSXP) { /* preventing warning + error : */
+	int w = 0;
+	d = IntegerFromReal(REAL_ELT(scipen, 0), &w);
+	if(w && d == NA_INTEGER)
+	    error(_("setting scipen=%g is out of range"), REAL_ELT(scipen,0));
+    } else
+	d = asInteger(scipen);
+    if (d == NA_INTEGER || d < R_MIN_SCIPEN_OPT || d > R_MAX_SCIPEN_OPT) {
+	int dnew = (d == NA_INTEGER) ? 0 :
+	      (d < R_MIN_SCIPEN_OPT) ? R_MIN_SCIPEN_OPT :
+	    /* d > R_MAX_SCIPEN_OPT */ R_MAX_SCIPEN_OPT;
+	switch(warn) {
+	case iWARN: warning(_("invalid 'scipen' %d, used %d"), d, dnew);
+	case iSILENT:
+	    return dnew; // for SILENT and WARN
+	case iERROR: error(_("invalid 'scipen' %d"), d);
+	}
+    }
+    return d;
+}
+
+
 attribute_hidden
 int GetOptionCutoff(void)
 {
@@ -561,20 +590,21 @@ attribute_hidden SEXP do_options(SEXP call, SEXP op, SEXP args, SEXP rho)
 		  "width", "deparse.cutoff", "digits", "echo", "verbose",
 		  "check.bounds", "keep.source", "keep.source.pkgs",
 		  "keep.parse.data", "keep.parse.data.pkgs", "warning.length",
-		  "nwarnings", "OutDec", "browserNLdisabled", "CBoundsCheck",
+		  "nwarnings", "OutDec", "CBoundsCheck",
 		  "matprod", "PCRE_study", "PCRE_use_JIT",
 		  "PCRE_limit_recursion", "rl_word_breaks",
 		  "max.contour.segments", "warnPartialMatchDollar",
 		  "warnPartialMatchArgs", "warnPartialMatchAttr",
 		  "showWarnCalls", "showErrorCalls", "showNCalls",
 		  "browserNLdisabled",
 		  /* ^^^ from InitOptions ^^^ */
-		  "warn", "max.print", "show.error.messages",
+		  "warn", "max.print", "show.error.messages", "scipen",
 		  /* ^^^ from Common.R ^^^ */
 		  NULL};
 		for(int j = 0; mandatory[j] != NULL; j++)
 		    if (streql(CHAR(namei), mandatory[j]))
 			error(_("option '%s' cannot be deleted"), CHAR(namei));
+		// "else" :
 		SET_VECTOR_ELT(value, i, SetOption(tag, R_NilValue));
 	    } else if (streql(CHAR(namei), "width")) {
 		int k = asInteger(argi);
@@ -684,6 +714,10 @@ attribute_hidden SEXP do_options(SEXP call, SEXP op, SEXP args, SEXP rho)
 		if (k < 1) error(_("invalid value for '%s'"), CHAR(namei));
 		SET_VECTOR_ELT(value, i, SetOption(tag, ScalarInteger(k)));
 	    }
+	    else if (streql(CHAR(namei), "scipen")) {
+		int k = FixupScipen(argi, iWARN); /* to become iERROR in say 2027 */
+		SET_VECTOR_ELT(value, i, SetOption(tag, ScalarInteger(k)));
+	    }
 	    else if (streql(CHAR(namei), "nwarnings")) {
 		int k = asInteger(argi);
 		if (k < 1) error(_("invalid value for '%s'"), CHAR(namei));

tests/reg-tests-1e.R

@@ -1599,6 +1599,19 @@ stopifnot(exprs = {
 ## 2nd debugonce() call failed in R <= 4.4.2
 
 
+## options(scipen = <invalid>)
+scipenO <- getOption("scipen")
+assertErrV(options(scipen = NULL))# would work (but ..) in R <= 4.2.2
+assertErrV(options(scipen = 1:2)) # would just work
+assertErrV(options(scipen = 1e99))# would "work" w/ 2 warnings and invalid setting
+stopifnot(identical(getOption("scipen"), scipenO))# unchanged
+tools::assertWarning(verbose=TRUE, options(scipen = -100  ))# warns and sets to min = -9
+stopifnot(identical(getOption("scipen"), -9L))
+tools::assertWarning(verbose=TRUE, options(scipen = 100000))# warns and sets to max = 9999
+stopifnot(identical(getOption("scipen"), 9999L))
+## setting to NULL  would invalidate as.character(Sys.time())
+
+
 
 ## keep at end
 rbind(last =  proc.time() - .pt,