options(warn=1e11) now errors directly (w/o warning!)

git-svn-id: https://svn.r-project.org/R/trunk@77226 00db46b3-68df-0310-9c12-caf00c1e9a41
wch · Sep 27, 2019 · 5d9a776 · 5d9a776
1 parent 04abf59
commit 5d9a776
Show file tree

Hide file tree

Showing 4 changed files with 36 additions and 9 deletions.
diff --git a/doc/NEWS.Rd b/doc/NEWS.Rd
@@ -332,6 +332,9 @@
       \code{qchisq()} calls.
 
       \item \code{grepl(NA, *)} now returns \code{logical} as documented.
+
+      \item \code{options(warn=1e11)} is an error now, instead of later
+      leading to C stack overflow because of infinite recursion.
     }
   }
 }

diff --git a/src/library/base/man/options.Rd b/src/library/base/man/options.Rd
@@ -429,8 +429,8 @@ getOption(x, default = NULL)
       signalled.  An object called \code{last.warning} is
       created and can be printed through the function
       \code{\link{warnings}}.  If \code{warn} is one, warnings are
-      printed as they occur.  If \code{warn} is two or larger all
-      warnings are turned into errors.}
+      printed as they occur.  If \code{warn} is two (or larger, coercible
+      to integer), all warnings are turned into errors.}
 
     \item{\code{warnPartialMatchArgs}:}{logical.  If true, warns if
       partial matching is used in argument matching.}

diff --git a/src/main/options.c b/src/main/options.c
@@ -105,7 +105,7 @@ static SEXP FindTaggedItem(SEXP lst, SEXP tag)
 {
     for ( ; lst != R_NilValue ; lst = CDR(lst)) {
 	if (TAG(lst) == tag) {
-	    if (CAR(lst) == R_NilValue) 
+	    if (CAR(lst) == R_NilValue)
 		error("option %s has NULL value", CHAR(PRINTNAME(tag)));
 	    return lst;
 	}
@@ -516,8 +516,8 @@ SEXP attribute_hidden do_options(SEXP call, SEXP op, SEXP args, SEXP rho)
 	    } else if (streql(CHAR(namei), "width")) {
 		int k = asInteger(argi);
 		if (k < R_MIN_WIDTH_OPT || k > R_MAX_WIDTH_OPT)
-		    error(_("invalid 'width' parameter, allowed %d...%d"),
-			  R_MIN_WIDTH_OPT, R_MAX_WIDTH_OPT);
+		    error(_("invalid '%s' parameter, allowed %d...%d"),
+			  CHAR(namei), R_MIN_WIDTH_OPT, R_MAX_WIDTH_OPT);
 		SET_VECTOR_ELT(value, i, SetOption(tag, ScalarInteger(k)));
 	    }
 	    else if (streql(CHAR(namei), "deparse.cutoff")) {
@@ -527,14 +527,14 @@ SEXP attribute_hidden do_options(SEXP call, SEXP op, SEXP args, SEXP rho)
 	    else if (streql(CHAR(namei), "digits")) {
 		int k = asInteger(argi);
 		if (k < R_MIN_DIGITS_OPT || k > R_MAX_DIGITS_OPT)
-		    error(_("invalid 'digits' parameter, allowed %d...%d"),
-			  R_MIN_DIGITS_OPT, R_MAX_DIGITS_OPT);
+		    error(_("invalid '%s' parameter, allowed %d...%d"),
+			  CHAR(namei), R_MIN_DIGITS_OPT, R_MAX_DIGITS_OPT);
 		SET_VECTOR_ELT(value, i, SetOption(tag, ScalarInteger(k)));
 	    }
 	    else if (streql(CHAR(namei), "expressions")) {
 		int k = asInteger(argi);
 		if (k < R_MIN_EXPRESSIONS_OPT || k > R_MAX_EXPRESSIONS_OPT)
-		    error(_("'expressions' parameter invalid, allowed %d...%d"),
+		    error(_("invalid '%s' parameter, allowed %d...%d"), CHAR(namei),
 			  R_MIN_EXPRESSIONS_OPT, R_MAX_EXPRESSIONS_OPT);
 		R_Expressions = R_Expressions_keep = k;
 		SET_VECTOR_ELT(value, i, SetOption(tag, ScalarInteger(k)));
@@ -583,7 +583,26 @@ SEXP attribute_hidden do_options(SEXP call, SEXP op, SEXP args, SEXP rho)
 	    else if (streql(CHAR(namei), "warn")) {
 		if (!isNumeric(argi) || LENGTH(argi) != 1)
 		    error(_("invalid value for '%s'"), CHAR(namei));
-		SET_VECTOR_ELT(value, i, SetOption(tag, argi));
+		int k;
+		// k = asInteger(argi) wld give both error + warning
+		if(TYPEOF(argi) == REALSXP) {
+		    int w;
+		    k = IntegerFromReal(REAL_ELT(argi, 0), &w);
+		} else {
+		    k = asInteger(argi);
+		}
+		if (k == NA_INTEGER)
+		    error(_("invalid value for '%s'"), CHAR(namei));
+#ifdef _NOT_YET_
+		char *p = getenv("R_WARN_BOUNDS_OPT");
+		if ((p && (strcmp(p, "yes") == 0)) && (k < -1 || k > 2)) {
+		    int k_n = (k < 0) ? -1 : 2;
+		    REprintf(_("value for '%s' outside of -1:2 is set to %d\n"),
+			     CHAR(namei), k_n);
+		    k = k_n;
+		}
+#endif
+		SET_VECTOR_ELT(value, i, SetOption(tag, ScalarInteger(k)));
 	    }
 	    else if (streql(CHAR(namei), "warning.length")) {
 		int k = asInteger(argi);

diff --git a/tests/reg-tests-1d.R b/tests/reg-tests-1d.R
@@ -3101,6 +3101,11 @@ stopifnot(is.na(N), is.logical(N))
 ## gave integer instead of logical in R <= 3.6.1
 
 
+## options(warn=1e11) leading to infinite loop -> "C Stack ..." error
+tools::assertError(options(warn = 1+.Machine$integer.max))
+## "worked" and gave problems later in R <= 3.6.1
+
+
 
 ## keep at end
 rbind(last =  proc.time() - .pt,