use check_TRUE_FALSE() more consistently

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

Author: maechler

src/main/options.c

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 1998-2023   The R Core Team.
+ *  Copyright (C) 1998-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
@@ -353,7 +353,7 @@ attribute_hidden void InitOptions(void)
     v = CDR(v);
 
     p = getenv("R_C_BOUNDS_CHECK");
-    R_CBoundsCheck = (p && (strcmp(p, "yes") == 0)) ? 1 : 0;
+    R_CBoundsCheck = (p && (strcmp(p, "yes") == 0)) ? TRUE : FALSE;
 
     SET_TAG(v, install("CBoundsCheck"));
     SETCAR(v, ScalarLogical(R_CBoundsCheck));
@@ -445,6 +445,11 @@ attribute_hidden SEXP do_getOption(SEXP call, SEXP op, SEXP args, SEXP rho)
 
 static Rboolean warned_on_strings_as_fact = FALSE; // -> once-per-session warning
 
+static void check_TRUE_FALSE(SEXP arg, const char *chname) {
+    if(TYPEOF(arg) != LGLSXP || LENGTH(arg) != 1 || LOGICAL(arg)[0] == NA_LOGICAL)
+	error(_("invalid value for '%s'"), chname);
+}
+
 /* This needs to manage R_Visible */
 attribute_hidden SEXP do_options(SEXP call, SEXP op, SEXP args, SEXP rho)
 {
@@ -695,18 +700,12 @@ attribute_hidden SEXP do_options(SEXP call, SEXP op, SEXP args, SEXP rho)
 	    }
 /* handle this here to avoid GetOption during error handling */
 	    else if ( streql(CHAR(namei), "show.error.messages") ) {
-		if( !isLogical(argi) && LENGTH(argi) != 1 )
-		    error(_("invalid value for '%s'"), CHAR(namei));
-		SET_VECTOR_ELT(value, i, SetOption(tag, argi));
+		check_TRUE_FALSE(argi, CHAR(namei));
 		R_ShowErrorMessages = LOGICAL(argi)[0];
+		SET_VECTOR_ELT(value, i, SetOption(tag, argi));
 	    }
 	    else if ( streql(CHAR(namei), "catch.script.errors") ) {
-#define CHECK_TRUE_FALSE_(_arg_)					\
-		if (TYPEOF(_arg_) != LGLSXP || LENGTH(_arg_) != 1 ||	\
-		    LOGICAL(_arg_)[0] == NA_LOGICAL)			\
-		    error(_("invalid value for '%s'"), CHAR(namei))
-
-		CHECK_TRUE_FALSE_(argi);
+		check_TRUE_FALSE(argi, CHAR(namei));
 		SET_VECTOR_ELT(value, i, SetOption(tag, argi));
 	    }
 	    else if (streql(CHAR(namei), "echo")) {
@@ -748,39 +747,29 @@ attribute_hidden SEXP do_options(SEXP call, SEXP op, SEXP args, SEXP rho)
 		SET_VECTOR_ELT(value, i, SetOption(tag, duplicate(argi)));
 	    }
 	    else if (streql(CHAR(namei), "warnPartialMatchDollar")) {
-		if (TYPEOF(argi) != LGLSXP || LENGTH(argi) != 1)
-		    error(_("invalid value for '%s'"), CHAR(namei));
-		int k = asLogical(argi);
-		R_warn_partial_match_dollar = k;
-		SET_VECTOR_ELT(value, i, SetOption(tag, ScalarLogical(k)));
+		check_TRUE_FALSE(argi, CHAR(namei));
+		R_warn_partial_match_dollar = LOGICAL(argi)[0];
+		SET_VECTOR_ELT(value, i, SetOption(tag, argi));
 	    }
 	    else if (streql(CHAR(namei), "warnPartialMatchArgs")) {
-		if (TYPEOF(argi) != LGLSXP || LENGTH(argi) != 1)
-		    error(_("invalid value for '%s'"), CHAR(namei));
-		int k = asLogical(argi);
-		R_warn_partial_match_args = k;
-		SET_VECTOR_ELT(value, i, SetOption(tag, ScalarLogical(k)));
+		check_TRUE_FALSE(argi, CHAR(namei));
+		R_warn_partial_match_args = LOGICAL(argi)[0];
+		SET_VECTOR_ELT(value, i, SetOption(tag, argi));
 	    }
 	    else if (streql(CHAR(namei), "warnPartialMatchAttr")) {
-		if (TYPEOF(argi) != LGLSXP || LENGTH(argi) != 1)
-		    error(_("invalid value for '%s'"), CHAR(namei));
-		int k = asLogical(argi);
-		R_warn_partial_match_attr = k;
-		SET_VECTOR_ELT(value, i, SetOption(tag, ScalarLogical(k)));
+		check_TRUE_FALSE(argi, CHAR(namei));
+		R_warn_partial_match_attr = LOGICAL(argi)[0];
+		SET_VECTOR_ELT(value, i, SetOption(tag, argi));
 	    }
 	    else if (streql(CHAR(namei), "showWarnCalls")) {
-		if (TYPEOF(argi) != LGLSXP || LENGTH(argi) != 1)
-		    error(_("invalid value for '%s'"), CHAR(namei));
-		int k = asLogical(argi);
-		R_ShowWarnCalls = k;
-		SET_VECTOR_ELT(value, i, SetOption(tag, ScalarLogical(k)));
+		check_TRUE_FALSE(argi, CHAR(namei));
+		R_ShowWarnCalls = LOGICAL(argi)[0];
+		SET_VECTOR_ELT(value, i, SetOption(tag, argi));
 	    }
 	    else if (streql(CHAR(namei), "showErrorCalls")) {
-		if (TYPEOF(argi) != LGLSXP || LENGTH(argi) != 1)
-		    error(_("invalid value for '%s'"), CHAR(namei));
-		int k = asLogical(argi);
-		R_ShowErrorCalls = k;
-		SET_VECTOR_ELT(value, i, SetOption(tag, ScalarLogical(k)));
+		check_TRUE_FALSE(argi, CHAR(namei));
+		R_ShowErrorCalls = LOGICAL(argi)[0];
+		SET_VECTOR_ELT(value, i, SetOption(tag, argi));
 	    }
 	    else if (streql(CHAR(namei), "showNCalls")) {
 		int k = asInteger(argi);
@@ -793,16 +782,14 @@ attribute_hidden SEXP do_options(SEXP call, SEXP op, SEXP args, SEXP rho)
 		error(_("\"par.ask.default\" has been replaced by \"device.ask.default\""));
 	    }
 	    else if (streql(CHAR(namei), "browserNLdisabled")) {
-		CHECK_TRUE_FALSE_(argi);
+		check_TRUE_FALSE(argi, CHAR(namei));
 		R_DisableNLinBrowser = LOGICAL(argi)[0];
 		SET_VECTOR_ELT(value, i, SetOption(tag, argi));
 	    }
 	    else if (streql(CHAR(namei), "CBoundsCheck")) {
-		if (TYPEOF(argi) != LGLSXP || LENGTH(argi) != 1)
-		    error(_("invalid value for '%s'"), CHAR(namei));
-		int k = asLogical(argi);
-		R_CBoundsCheck = k;
-		SET_VECTOR_ELT(value, i, SetOption(tag, ScalarLogical(k)));
+		check_TRUE_FALSE(argi, CHAR(namei));
+		R_CBoundsCheck = LOGICAL(argi)[0];
+		SET_VECTOR_ELT(value, i, SetOption(tag, argi));
 	    }
 	    else if (streql(CHAR(namei), "matprod")) {
 		SEXP s = asChar(argi);