more uses of asRbool catching incorrect calls

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

Author: ripley

doc/NEWS.Rd

@@ -48,7 +48,7 @@
       respective metadata.
       (Thanks to \I{Edzer Pebesma}.)
 
-      \item \code{grDevices::glyphInfo()} gains \code{rot} argument
+      \item \code{grDevices::glyphInfo()} gains a \code{rot} argument
       to allow per-glyph rotation.
       (Thanks to \I{Daniel Sabanes Bove}.)
 
@@ -633,6 +633,11 @@
       more thoroughly.  The most commonly seen errors are in
       \code{unlink(, recursive)}, \code{tempdir()} and the \code{na.rm}
       argument of \code{max()}, \code{min()}, \code{sum()}, \dots.
+
+      \code{grep()} and similar took non-\code{TRUE} values of their logical
+      arguments as \code{FALSE}, but these were almost always coding
+      mistakes and are now reported as \code{NA}. [In progress, in place
+      for \code{regexpr()].]
     }
   }
 }

src/main/Rdynload.c

@@ -1470,7 +1470,7 @@ R_getSymbolInfo(SEXP sname, SEXP spackage, SEXP withRegistrationInfo)
 
     if(f)
 	sym = createRSymbolObject(sname, f, &symbol,
-				  LOGICAL(withRegistrationInfo)[0]);
+				  asRbool(withRegistrationInfo, R_NilValue));
 
     vmaxset(vmax);
     return sym;

src/main/agrep.c

@@ -490,7 +490,7 @@ attribute_hidden SEXP do_adist(SEXP call, SEXP op, SEXP args, SEXP env)
     SEXP x, y;
     SEXP ans, counts, offsets, dimnames, names, elt;
     SEXP opt_costs;
-    int opt_fixed, opt_partial, opt_counts, opt_icase, useBytes;
+    Rboolean opt_fixed, opt_partial, opt_counts, opt_icase, useBytes;
     int i = 0, j = 0, m, nx, ny, nxy;
     const char *s, *t;
     const void *vmax = NULL;
@@ -509,11 +509,11 @@ attribute_hidden SEXP do_adist(SEXP call, SEXP op, SEXP args, SEXP env)
     x = CAR(args); args = CDR(args);
     y = CAR(args); args = CDR(args);
     opt_costs = CAR(args); args = CDR(args);
-    opt_counts = asLogical(CAR(args)); args = CDR(args);
-    opt_fixed = asInteger(CAR(args)); args = CDR(args);
-    opt_partial = asInteger(CAR(args)); args = CDR(args);
-    opt_icase = asLogical(CAR(args)); args = CDR(args);
-    useBytes = asLogical(CAR(args));
+    opt_counts = asRbool(CAR(args), call); args = CDR(args);
+    opt_fixed = asRbool(CAR(args), call); args = CDR(args);
+    opt_partial = asRbool(CAR(args), call); args = CDR(args);
+    opt_icase = asRbool(CAR(args), call); args = CDR(args);
+    useBytes = asRbool(CAR(args), call);
 
     if(opt_counts == NA_INTEGER) opt_counts = 0;
     if(opt_fixed == NA_INTEGER) opt_fixed = 1;

src/main/character.c

@@ -339,7 +339,9 @@ attribute_hidden SEXP do_nchar(SEXP call, SEXP op, SEXP args, SEXP env)
     int *s_ = INTEGER(s);
     for (R_xlen_t i = 0; i < len; i++) {
 	SEXP sxi = STRING_ELT(x, i);
-	int res = R_nchar(sxi, type_, allowNA, keepNA, NULL);
+	// NA_LOGICAL has now been excluded
+	int res = R_nchar(sxi, type_,
+			  (Rboolean) allowNA, (Rboolean) keepNA, NULL);
 	switch(res) {
 	case -1:
 	    error(_("invalid multibyte string, element %ld"), (long)i+1);

src/main/grep.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
@@ -2967,7 +2967,7 @@ attribute_hidden SEXP do_regexpr(SEXP call, SEXP op, SEXP args, SEXP env)
     regex_t reg;
     regmatch_t regmatch[10];
     R_xlen_t i, n;
-    int rc, igcase_opt, perl_opt, fixed_opt, useBytes;
+    Rboolean rc, igcase_opt, perl_opt, fixed_opt, useBytes;
     const char *spat = NULL; /* -Wall */
     const wchar_t *wpat = NULL;
     const char *s = NULL;
@@ -2994,14 +2994,10 @@ attribute_hidden SEXP do_regexpr(SEXP call, SEXP op, SEXP args, SEXP env)
     checkArity(op, args);
     pat = CAR(args); args = CDR(args);
     text = CAR(args); args = CDR(args);
-    igcase_opt = asLogical(CAR(args)); args = CDR(args);
-    perl_opt = asLogical(CAR(args)); args = CDR(args);
-    fixed_opt = asLogical(CAR(args)); args = CDR(args);
-    useBytes = asLogical(CAR(args)); args = CDR(args);
-    if (igcase_opt == NA_INTEGER) igcase_opt = 0;
-    if (perl_opt == NA_INTEGER) perl_opt = 0;
-    if (fixed_opt == NA_INTEGER) fixed_opt = 0;
-    if (useBytes == NA_INTEGER) useBytes = 0;
+    igcase_opt = asRbool(CAR(args), call); args = CDR(args);
+    perl_opt = asRbool(CAR(args), call); args = CDR(args);
+    fixed_opt = asRbool(CAR(args), call); args = CDR(args);
+    useBytes = asRbool(CAR(args), call); args = CDR(args);
     if (fixed_opt && igcase_opt)
 	warning(_("argument '%s' will be ignored"), "ignore.case = TRUE");
     if (fixed_opt && perl_opt) {

src/main/summary.c

@@ -484,7 +484,7 @@ static R_INLINE SEXP real_mean(SEXP x)
 	    for (R_xlen_t k = 0; k < nbatch; k++)
 		s += dx[k];
 	});
-    Rboolean finite_s = R_FINITE((double) s);
+    Rboolean finite_s = R_FINITE((double) s) != 0; //isfinite returns non-zero
     if (finite_s) {
 	s /= n;
 	DbgP3("real_mean(): n=%g, s=%g\n", (double)n, s);

src/main/unique.c

@@ -2307,7 +2307,7 @@ attribute_hidden SEXP do_sample2(SEXP call, SEXP op, SEXP args, SEXP env)
  * Low Level Functions
  */
 
-static int hash_identical(SEXP x, int K, int useCloEnv)
+static int hash_identical(SEXP x, int K, Rboolean useCloEnv)
 {
     /* using 31 seems to work reasonably */
     if (K == 0 || K > 31) K = 31;
@@ -2649,7 +2649,8 @@ attribute_hidden SEXP do_vhash(SEXP call, SEXP op, SEXP args, SEXP env)
     SEXP sUseCloEnv = CADDR(args);
 
     int K = sK == R_NilValue ? 31 : asInteger(sK);
-    int useCloEnv = sUseCloEnv == R_NilValue ? TRUE : asLogical(sUseCloEnv);
+    Rboolean useCloEnv =
+	(sUseCloEnv == R_NilValue) ? TRUE : asRbool(sUseCloEnv,call);
 
     int val = hash_identical(x, K, useCloEnv);
     return ScalarInteger(val);

src/main/util.c

@@ -2838,7 +2838,9 @@ attribute_hidden SEXP do_findinterval(SEXP call, SEXP op, SEXP args, SEXP rho)
     int n = LENGTH(xt);
     if (n == NA_INTEGER) error(_("invalid '%s' argument"), "vec");
     R_xlen_t nx = XLENGTH(x);
-    int sr = asLogical(right), si = asLogical(inside), lO = asLogical(leftOp);
+    Rboolean sr = asRbool(right, call),
+	si = asRbool(inside, call),
+	lO = asRbool(leftOp, call);
     if (sr == NA_INTEGER)
 	error(_("invalid '%s' argument"), "rightmost.closed");
     if (si == NA_INTEGER)