diff --git a/doc/NEWS.Rd b/doc/NEWS.Rd index 43556739326..ab893d2cb4e 100644 --- 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 index 9ccc1fc5e4c..8a2ff080aaa 100644 --- 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 index 7cd5d90c0c6..19a4b9614b9 100644 --- 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 index a540f218807..5b5f547c0db 100644 --- 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,