more taking care over Rboolean

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

src/include/Rinlinedfuns.h

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 1999-2024  The R Core Team.
+ *  Copyright (C) 1999-2025  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
@@ -334,11 +334,13 @@ INLINE_FUN R_xlen_t XTRUELENGTH(SEXP x)
     CHECK_STDVEC_LGL(x);
     return (int *) STDVEC_DATAPTR(x);
 }
-HIDDEN INLINE_FUN Rboolean SCALAR_LVAL(SEXP x) {
+/* This should not be Rboolean as could be NA_LOGICAL */
+HIDDEN INLINE_FUN int SCALAR_LVAL(SEXP x) {
     CHECK_SCALAR_LGL(x);
     return LOGICAL(x)[0];
 }
-HIDDEN INLINE_FUN void SET_SCALAR_LVAL(SEXP x, Rboolean v) {
+/* ditto */
+HIDDEN INLINE_FUN void SET_SCALAR_LVAL(SEXP x, int v) {
     CHECK_SCALAR_LGL(x);
     LOGICAL(x)[0] = v;
 }

src/main/array.c

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 1998-2023   The R Core Team
+ *  Copyright (C) 1998-2025   The R Core Team
  *  Copyright (C) 2002-2015   The R Foundation
  *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
  *
@@ -82,7 +82,7 @@ SEXP GetColNames(SEXP dimnames)
 attribute_hidden SEXP do_matrix(SEXP call, SEXP op, SEXP args, SEXP rho)
 {
     SEXP vals, ans, snr, snc, dimnames;
-    int nr = 1, nc = 1, byrow, miss_nr, miss_nc;
+    int nr = 1, nc = 1, byrow0, miss_nr, miss_nc;
     R_xlen_t lendat;
 
     checkArity(op, args);
@@ -104,9 +104,10 @@ attribute_hidden SEXP do_matrix(SEXP call, SEXP op, SEXP args, SEXP rho)
     lendat = XLENGTH(vals);
     snr = CAR(args); args = CDR(args);
     snc = CAR(args); args = CDR(args);
-    byrow = asLogical(CAR(args)); args = CDR(args);
-    if (byrow == NA_INTEGER)
+    byrow0 = asLogical(CAR(args)); args = CDR(args);
+    if (byrow0 == NA_INTEGER)
 	error(_("invalid '%s' argument"), "byrow");
+    Rboolean byrow = (Rboolean) byrow0;
     dimnames = CAR(args);
     args = CDR(args);
     miss_nr = asLogical(CAR(args)); args = CDR(args);
@@ -1898,19 +1899,18 @@ attribute_hidden SEXP do_colsum(SEXP call, SEXP op, SEXP args, SEXP rho)
 {
     SEXP x, ans = R_NilValue;
     int type;
-    Rboolean NaRm, keepNA;
 
     checkArity(op, args);
     x = CAR(args); args = CDR(args);
     R_xlen_t n = asVecSize(CAR(args)); args = CDR(args);
     R_xlen_t p = asVecSize(CAR(args)); args = CDR(args);
-    NaRm = asLogical(CAR(args));
+    int NaRm = asLogical(CAR(args));
     if (n == NA_INTEGER || n < 0)
 	error(_("invalid '%s' argument"), "n");
     if (p == NA_INTEGER || p < 0)
 	error(_("invalid '%s' argument"), "p");
     if (NaRm == NA_LOGICAL) error(_("invalid '%s' argument"), "na.rm");
-    keepNA = !NaRm;
+    Rboolean keepNA = !NaRm;
 
     switch (type = TYPEOF(x)) {
     case LGLSXP:

src/main/attrib.c

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 1997--2024  The R Core Team
+ *  Copyright (C) 1997--2025  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
@@ -746,7 +746,7 @@ static SEXP S4_extends(SEXP klass, Rboolean use_tab) {
 
 attribute_hidden SEXP R_S4_extends(SEXP klass, SEXP useTable)
 {
-    return S4_extends(klass, asLogical(useTable));
+    return S4_extends(klass, asRbool(useTable, R_NilValue));
 }
 
 

src/main/bind.c

@@ -738,7 +738,7 @@ static SEXP c_Extract_opt(SEXP ans, Rboolean *recurse, Rboolean *usenames,
 	    if (n_recurse++ == 1)
 		errorcall(call, _("repeated formal argument 'recursive'"));
 	    if ((v = asLogical(CAR(a))) != NA_INTEGER) {
-		*recurse = v;
+		*recurse = (Rboolean) v;
 	    }
 	    if (last == NULL)
 		ans = next;
@@ -749,7 +749,7 @@ static SEXP c_Extract_opt(SEXP ans, Rboolean *recurse, Rboolean *usenames,
 	    if (n_usenames++ == 1)
 		errorcall(call, _("repeated formal argument 'use.names'"));
 	    if ((v = asLogical(CAR(a))) != NA_INTEGER) {
-		*usenames = v;
+		*usenames = (Rboolean) v;
 	    }
 	    if (last == NULL)
 		ans = next;

src/main/coerce.c

@@ -1829,7 +1829,7 @@ Rboolean asRbool(SEXP x, SEXP call)
     int ans = asLogical2(x, 1, call);
     if (ans == NA_LOGICAL)
 	errorcall(call, _("NA in coercion to Rboolean"));
-    return ans;
+    return (Rboolean) ans;
 }
 
 
@@ -2362,9 +2362,10 @@ static Rboolean anyNA(SEXP call, SEXP op, SEXP args, SEXP env)
 {
     SEXP x = CAR(args);
     SEXPTYPE xT = TYPEOF(x);
-    Rboolean isList =  (xT == VECSXP || xT == LISTSXP), recursive = FALSE;
+    Rboolean isList =  (Rboolean) (xT == VECSXP || xT == LISTSXP),
+	recursive = FALSE;
 
-    if (isList && length(args) > 1) recursive = asLogical(CADR(args));
+    if (isList && length(args) > 1) recursive = asRbool(CADR(args), call);
     if (OBJECT(x) || (isList && !recursive)) {
 	SEXP e0 = PROTECT(lang2(install("is.na"), x));
 	SEXP e = PROTECT(lang2(install("any"), e0));

src/main/datetime.c

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 2000-2024  The R Core Team.
+ *  Copyright (C) 2000-2025  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
@@ -1652,7 +1652,7 @@ attribute_hidden SEXP do_D2POSIXlt(SEXP call, SEXP op, SEXP args, SEXP env)
     for(R_xlen_t i = 0; i < n; i++) {
 	stm tm;
 	double x_i = REAL(x)[i];
-	Rboolean valid = R_FINITE(x_i);
+	Rboolean valid = R_FINITE(x_i) != 0;
 	if(valid) {
 	    /* every 400 years is exactly 146097 days long and the
 	       pattern is repeated */

src/main/debug.c

@@ -105,8 +105,8 @@ attribute_hidden SEXP do_traceOnOff(SEXP call, SEXP op, SEXP args, SEXP rho)
     if(length(onOff) > 0) {
 	int _new = asLogical(onOff);
 	if(_new == TRUE || _new == FALSE)
-	    if(trace) SET_TRACE_STATE(_new);
-	    else      SET_DEBUG_STATE(_new);
+	    if(trace) SET_TRACE_STATE((Rboolean) _new);
+	    else      SET_DEBUG_STATE((Rboolean) _new);
 	else
 	    error(_("Value for '%s' must be TRUE or FALSE"),
 		  trace ? "tracingState" : "debuggingState");

src/main/deparse.c

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 1997--2023  The R Core Team
+ *  Copyright (C) 1997--2025  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
@@ -178,7 +178,7 @@ attribute_hidden SEXP do_deparse(SEXP call, SEXP op, SEXP args, SEXP rho)
 	}
     }
     args = CDR(args);
-    int backtick = isNull(CAR(args)) ? 0 : asLogical(CAR(args));
+    Rboolean backtick = isNull(CAR(args)) ? 0 : asRbool(CAR(args), call);
     args = CDR(args);
     int opts = isNull(CAR(args)) ? SHOWATTRIBUTES : asInteger(CAR(args));
     args = CDR(args);
@@ -734,7 +734,7 @@ static attr_type attr1(SEXP s, LocalParseData *d)
     SEXP a = ATTRIB(s), nm = getAttrib(s, R_NamesSymbol);
     attr_type attr = UNKNOWN;
     Rboolean
-	nice_names = d->opts & NICE_NAMES,
+	nice_names = (Rboolean) (d->opts & NICE_NAMES),
 	show_attr  = d->opts & SHOWATTRIBUTES,
 	has_names = !isNull(nm), ok_names;
 #ifdef DEBUG_DEPARSE
@@ -1633,7 +1633,7 @@ static void vector2buff(SEXP vector, LocalParseData *d)
     }
 
     SEXP nv = R_NilValue;
-    Rboolean do_names = d_opts_in & SHOW_ATTR_OR_NMS;// iff TRUE use '<tag_i> = <comp_i>'
+    Rboolean do_names = (Rboolean)(d_opts_in & SHOW_ATTR_OR_NMS);// iff TRUE use '<tag_i> = <comp_i>'
     if(do_names) {
 	nv = getAttrib(vector, R_NamesSymbol); // only "do names" if have names:
 	if(isNull(nv))

src/main/eval.c

@@ -2639,13 +2639,13 @@ static SEXP replaceCall(SEXP fun, SEXP val, SEXP args, SEXP rhs)
 
 static R_INLINE Rboolean asLogicalNoNA(SEXP s, SEXP call)
 {
-    Rboolean cond = NA_LOGICAL;
+    int cond = NA_LOGICAL; // cannot be Rboolean
 
     /* handle most common special case directly */
     if (IS_SCALAR(s, LGLSXP)) {
 	cond = SCALAR_LVAL(s);
 	if (cond != NA_LOGICAL)
-	    return cond;
+	    return (Rboolean) cond;
     }
     else if (IS_SCALAR(s, INTSXP)) {
 	int val = SCALAR_IVAL(s);
@@ -6908,9 +6908,9 @@ static R_INLINE Rboolean GETSTACK_LOGICAL_NO_NA_PTR(R_bcstack_t *s, int callidx,
 
     SEXP value = GETSTACK_PTR(s);
     if (IS_SCALAR(value, LGLSXP)) {
-	Rboolean lval = SCALAR_LVAL(value);
+	int lval = SCALAR_LVAL(value);
 	if (lval != NA_LOGICAL)
-	    return lval;
+	    return (Rboolean) lval;
     }
     SEXP call = GETCONST(constants, callidx);
     PROTECT(value);
@@ -6924,7 +6924,7 @@ static R_INLINE Rboolean GETSTACK_LOGICAL_PTR(R_bcstack_t *s)
 {
     if (s->tag == LGLSXP) return s->u.ival;
     SEXP value = GETSTACK_PTR(s);
-    return SCALAR_LVAL(value);
+    return SCALAR_LVAL(value); //what about NA_LOGICAL?
 }
 
 /* Find locations table in the constant pool */

src/main/grep.c

@@ -2119,7 +2119,7 @@ attribute_hidden SEXP do_gsub(SEXP call, SEXP op, SEXP args, SEXP env)
 
     checkArity(op, args);
 
-    global = PRIMVAL(op);
+    global = (Rboolean) PRIMVAL(op);
 
     pat = CAR(args); args = CDR(args);
     rep = CAR(args); args = CDR(args);

src/main/platform.c

@@ -1572,21 +1572,21 @@ attribute_hidden SEXP do_listfiles(SEXP call, SEXP op, SEXP args, SEXP rho)
 	pattern = TRUE;
     else if (!isNull(p) && !(isString(p) && LENGTH(p) < 1))
 	error(_("invalid '%s' argument"), "pattern");
-    int allfiles = asLogical(CAR(args)); args = CDR(args);
-    if (allfiles == NA_LOGICAL)
-	error(_("invalid '%s' argument"), "all.files");
+    Rboolean allfiles = asRbool(CAR(args), call); args = CDR(args);
+//    if (allfiles == NA_LOGICAL)
+//	error(_("invalid '%s' argument"), "all.files");
     int fullnames = asLogical(CAR(args)); args = CDR(args);
     if (fullnames == NA_LOGICAL)
 	error(_("invalid '%s' argument"), "full.names");
-    int recursive = asLogical(CAR(args)); args = CDR(args);
-    if (recursive == NA_LOGICAL)
-	error(_("invalid '%s' argument"), "recursive");
+    Rboolean recursive = asRbool(CAR(args), call); args = CDR(args);
+//    if (recursive == NA_LOGICAL)
+//	error(_("invalid '%s' argument"), "recursive");
     int igcase = asLogical(CAR(args)); args = CDR(args);
     if (igcase == NA_LOGICAL)
 	error(_("invalid '%s' argument"), "ignore.case");
-    int idirs = asLogical(CAR(args)); args = CDR(args);
-    if (idirs == NA_LOGICAL)
-	error(_("invalid '%s' argument"), "include.dirs");
+    Rboolean idirs = asRbool(CAR(args), call); args = CDR(args);
+//    if (idirs == NA_LOGICAL)
+//	error(_("invalid '%s' argument"), "include.dirs");
     int nodots = asLogical(CAR(args));
     if (nodots == NA_LOGICAL)
 	error(_("invalid '%s' argument"), "no..");
@@ -1665,9 +1665,9 @@ attribute_hidden SEXP do_listdirs(SEXP call, SEXP op, SEXP args, SEXP rho)
     int fullnames = asLogical(CAR(args)); args = CDR(args);
     if (fullnames == NA_LOGICAL)
 	error(_("invalid '%s' argument"), "full.names");
-    int recursive = asLogical(CAR(args)); args = CDR(args);
-    if (recursive == NA_LOGICAL)
-	error(_("invalid '%s' argument"), "recursive");
+    Rboolean recursive = asRbool(CAR(args), call); args = CDR(args);
+//    if (recursive == NA_LOGICAL)
+//	error(_("invalid '%s' argument"), "recursive");
 
     PROTECT_INDEX idx;
     SEXP ans;

src/main/radixsort.c

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 2016-2024 The R Core Team
+ *  Copyright (C) 2016-2025 The R Core Team
  *
  *  Based on code donated from the data.table package
  *  (C) 2006-2015 Matt Dowle and Arun Srinivasan.
@@ -1566,14 +1566,14 @@ attribute_hidden SEXP do_radixsort(SEXP call, SEXP op, SEXP args, SEXP rho)
     args = CDR(args);
 
     /* If TRUE, return starts of runs of identical values + max group size. */
-    retGrp = asLogical(CAR(args));
+    retGrp = asRbool(CAR(args), call);
     args = CDR(args);
 
     /* If FALSE, get order of strings in appearance order. Essentially
        abuses the CHARSXP table to group strings without hashing
        them. Only makes sense when retGrp=TRUE.
     */
-    sortStr = asLogical(CAR(args));
+    sortStr = asRbool(CAR(args), call );
     args = CDR(args);
 
     /* When grouping, we round off doubles to account for imprecision */

src/main/saveload.c

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 1997--2022  The R Core Team
+ *  Copyright (C) 1997--2025  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
@@ -2344,9 +2344,9 @@ attribute_hidden SEXP do_saveToConn(SEXP call, SEXP op, SEXP args, SEXP env)
 
     con = getConnection(asInteger(CADR(args)));
 
-    if (TYPEOF(CADDR(args)) != LGLSXP)
-	error(_("'ascii' must be logical"));
-    ascii = INTEGER(CADDR(args))[0];
+/*    if (TYPEOF(CADDR(args)) != LGLSXP)
+      error(_("'ascii' must be logical")); */
+    ascii = asRbool(CADDR(args), call);
 
     if (CADDDR(args) == R_NilValue)
 	version = defaultSaveVersion();

src/main/seq.c

@@ -891,7 +891,7 @@ attribute_hidden SEXP do_seq(SEXP call, SEXP op, SEXP args, SEXP rho)
 		ans = seq_colon(rfrom, rto, call);
 		goto done;
 	    }
-	    Rboolean finite_del = R_FINITE(del);
+	    Rboolean finite_del = R_FINITE(del) != 0;
 	    double n = (finite_del)
 		? del/rby
 		: rto/rby - rfrom/rby; /* overflow in  (to - from)  when both are finite */
@@ -965,7 +965,7 @@ attribute_hidden SEXP do_seq(SEXP call, SEXP op, SEXP args, SEXP rho)
 	Rboolean finite_del = 0;
 	if(lout > 2) { // only then, use 'by'
 	    double nint = (double)(lout - 1);
-	    if((finite_del = R_FINITE(rby = (rto - rfrom))))
+	    if((finite_del = (R_FINITE(rby = (rto - rfrom)) != 0)))
 		rby /= nint;
 	    else // overflow in (to - from), nint >= 2  => finite 'by'
 		rby = (rto/nint - rfrom/nint);

src/main/serialize.c

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 1995--2024  The R Core Team
+ *  Copyright (C) 1995--2025  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
@@ -2608,9 +2608,10 @@ do_serializeToConn(SEXP call, SEXP op, SEXP args, SEXP env)
     object = CAR(args);
     con = getConnection(asInteger(CADR(args)));
 
-    if (TYPEOF(CADDR(args)) != LGLSXP)
+/*    if (TYPEOF(CADDR(args)) != LGLSXP)
 	error(_("'ascii' must be logical"));
-    ascii = INTEGER(CADDR(args))[0];
+	ascii = INTEGER(CADDR(args))[0]; */
+    ascii = asRbool(CADDR(args), call);
     if (ascii == NA_LOGICAL) type = R_pstream_asciihex_format;
     else if (ascii) type = R_pstream_ascii_format;
     else type = R_pstream_xdr_format;
@@ -3224,7 +3225,7 @@ static SEXP R_getVarsFromFrame(SEXP vars, SEXP env, SEXP forcesxp)
 	error(_("bad environment"));
     if (TYPEOF(vars) != STRSXP)
 	error(_("bad variable names"));
-    force = asLogical(forcesxp);
+    force = asRbool(forcesxp, R_NilValue);
 
     len = LENGTH(vars);
     PROTECT(val = allocVector(VECSXP, len));