[Rd] Control statements with condition with greater than one should give error (not just warning) [PATCH]

[Henrik Bengtsson]

I'd like to propose that the whenever the length of condition passed
to an if or a while statement differs from one, an error is produced
rather than just a warning as today:

> x <- 1:2
> if (x == 1) message("x == 1")
x == 1
Warning message:
In if (x == 1) message("x == 1") :
  the condition has length > 1 and only the first element will be used

There are probably legacy reasons for why this is accepted by R in the
first place, but I cannot imagine than anyone wants to use an if/while
statement this way on purpose.  The warning about this misuse, was
introduced in November 2002 (R-devel thread 'vector arguments to
if()'; https://stat.ethz.ch/pipermail/r-devel/2002-November/025537.html).

Below is patch (also attached) that introduces option
'check.condition' such that when TRUE, it will generate an error
rather than a warning (default).  This option allows for a smooth
migration as it can be added to 'R CMD check --as-cran' and developers
can give time to check and fix their packages.  Eventually,
check.condition=TRUE can become the new default.

With options(check.condition = TRUE), one gets:

> x <- 1:2
> if (x == 1) message("x == 1")
Error in if (x == 1) message("x == 1") : the condition has length > 1

and

> while (x < 2) message("x < 2")
Error in while (x < 2) message("x < 2") : the condition has length > 1


Index: src/library/base/man/options.Rd
===================================================================
--- src/library/base/man/options.Rd (revision 72298)
+++ src/library/base/man/options.Rd (working copy)
@@ -86,6 +86,11 @@
       vector (atomic or \code{\link{list}}) is extended, by something
       like \code{x <- 1:3; x[5] <- 6}.}

+    \item{\code{check.condition}:}{logical, defaulting to \code{FALSE}.  If
+      \code{TRUE}, an error is produced whenever the condition to an
+      \code{if} or a \code{while} control statement is of length greater
+      than one.  If \code{FALSE}, a \link{warning} is produced.}
+
     \item{\code{CBoundsCheck}:}{logical, controlling whether
       \code{\link{.C}} and \code{\link{.Fortran}} make copies to check for
       array over-runs on the atomic vector arguments.
@@ -445,6 +450,7 @@
   \tabular{ll}{
     \code{add.smooth} \tab \code{TRUE}\cr
     \code{check.bounds} \tab \code{FALSE}\cr
+    \code{check.condition} \tab \code{FALSE}\cr
     \code{continue} \tab \code{"+ "}\cr
     \code{digits} \tab \code{7}\cr
     \code{echo} \tab \code{TRUE}\cr
Index: src/library/utils/R/completion.R
===================================================================
--- src/library/utils/R/completion.R (revision 72298)
+++ src/library/utils/R/completion.R (working copy)
@@ -1304,8 +1304,8 @@
           "plt", "ps", "pty", "smo", "srt", "tck", "tcl", "usr",
           "xaxp", "xaxs", "xaxt", "xpd", "yaxp", "yaxs", "yaxt")

-    options <- c("add.smooth", "browser", "check.bounds", "continue",
- "contrasts", "defaultPackages", "demo.ask", "device",
+    options <- c("add.smooth", "browser", "check.bounds", "check.condition",
+        "continue", "contrasts", "defaultPackages", "demo.ask", "device",
  "digits", "dvipscmd", "echo", "editor", "encoding",
  "example.ask", "expressions", "help.search.types",
  "help.try.all.packages", "htmlhelp", "HTTPUserAgent",
Index: src/main/eval.c
===================================================================
--- src/main/eval.c (revision 72298)
+++ src/main/eval.c (working copy)
@@ -1851,9 +1851,13 @@
     Rboolean cond = NA_LOGICAL;

     if (length(s) > 1) {
+ int check = asInteger(GetOption1(install("check.condition")));
  PROTECT(s); /* needed as per PR#15990.  call gets protected by
warningcall() */
- warningcall(call,
-    _("the condition has length > 1 and only the first element will be used"));
+ if(check != NA_INTEGER && check > 0)
+    errorcall(call, _("the condition has length > 1"));
+ else
+    warningcall(call,
+ _("the condition has length > 1 and only the first element will be used"));
  UNPROTECT(1);
     }
     if (length(s) > 0) {
Index: src/main/options.c
===================================================================
--- src/main/options.c (revision 72298)
+++ src/main/options.c (working copy)
@@ -65,6 +65,7 @@
  * "timeout" ./connections.c

  * "check.bounds"
+ * "check.condition"
  * "error"
  * "error.messages"
  * "show.error.messages"
@@ -248,9 +249,9 @@
     char *p;

 #ifdef HAVE_RL_COMPLETION_MATCHES
+    PROTECT(v = val = allocList(22));
+#else
     PROTECT(v = val = allocList(21));
-#else
-    PROTECT(v = val = allocList(20));
 #endif

     SET_TAG(v, install("prompt"));
@@ -289,6 +290,10 @@
     SETCAR(v, ScalarLogical(0)); /* no checking */
     v = CDR(v);

+    SET_TAG(v, install("check.condition"));
+    SETCAR(v, ScalarLogical(0)); /* no checking */
+    v = CDR(v);
+
     p = getenv("R_KEEP_PKG_SOURCE");
     R_KeepSource = (p && (strcmp(p, "yes") == 0)) ? 1 : 0;


I'm happy to file this via https://bugs.r-project.org, if preferred.

/Henrik
-------------- next part --------------
Index: src/library/base/man/options.Rd
===================================================================
--- src/library/base/man/options.Rd	(revision 72298)
+++ src/library/base/man/options.Rd	(working copy)
@@ -86,6 +86,11 @@
       vector (atomic or \code{\link{list}}) is extended, by something
       like \code{x <- 1:3; x[5] <- 6}.}
 
+    \item{\code{check.condition}:}{logical, defaulting to \code{FALSE}.  If
+      \code{TRUE}, an error is produced whenever the condition to an
+      \code{if} or a \code{while} control statement is of length greater
+      than one.  If \code{FALSE}, a \link{warning} is produced.}
+
     \item{\code{CBoundsCheck}:}{logical, controlling whether
       \code{\link{.C}} and \code{\link{.Fortran}} make copies to check for
       array over-runs on the atomic vector arguments.
@@ -445,6 +450,7 @@
   \tabular{ll}{
     \code{add.smooth} \tab \code{TRUE}\cr
     \code{check.bounds} \tab \code{FALSE}\cr
+    \code{check.condition} \tab \code{FALSE}\cr
     \code{continue} \tab \code{"+ "}\cr
     \code{digits} \tab \code{7}\cr
     \code{echo} \tab \code{TRUE}\cr
Index: src/library/utils/R/completion.R
===================================================================
--- src/library/utils/R/completion.R	(revision 72298)
+++ src/library/utils/R/completion.R	(working copy)
@@ -1304,8 +1304,8 @@
           "plt", "ps", "pty", "smo", "srt", "tck", "tcl", "usr",
           "xaxp", "xaxs", "xaxt", "xpd", "yaxp", "yaxs", "yaxt")
 
-    options <- c("add.smooth", "browser", "check.bounds", "continue",
-	"contrasts", "defaultPackages", "demo.ask", "device",
+    options <- c("add.smooth", "browser", "check.bounds", "check.condition",
+        "continue", "contrasts", "defaultPackages", "demo.ask", "device",
 	"digits", "dvipscmd", "echo", "editor", "encoding",
 	"example.ask", "expressions", "help.search.types",
 	"help.try.all.packages", "htmlhelp", "HTTPUserAgent",
Index: src/main/eval.c
===================================================================
--- src/main/eval.c	(revision 72298)
+++ src/main/eval.c	(working copy)
@@ -1851,9 +1851,13 @@
     Rboolean cond = NA_LOGICAL;
 
     if (length(s) > 1) {
+	int check = asInteger(GetOption1(install("check.condition")));
 	PROTECT(s);	 /* needed as per PR#15990.  call gets protected by warningcall() */
-	warningcall(call,
-		    _("the condition has length > 1 and only the first element will be used"));
+	if(check != NA_INTEGER && check > 0)
+	    errorcall(call, _("the condition has length > 1"));
+	else
+	    warningcall(call,
+			_("the condition has length > 1 and only the first element will be used"));
 	UNPROTECT(1);
     }
     if (length(s) > 0) {
Index: src/main/options.c
===================================================================
--- src/main/options.c	(revision 72298)
+++ src/main/options.c	(working copy)
@@ -65,6 +65,7 @@
  *	"timeout"		./connections.c
 
  *	"check.bounds"
+ *	"check.condition"
  *	"error"
  *	"error.messages"
  *	"show.error.messages"
@@ -248,9 +249,9 @@
     char *p;
 
 #ifdef HAVE_RL_COMPLETION_MATCHES
+    PROTECT(v = val = allocList(22));
+#else
     PROTECT(v = val = allocList(21));
-#else
-    PROTECT(v = val = allocList(20));
 #endif
 
     SET_TAG(v, install("prompt"));
@@ -289,6 +290,10 @@
     SETCAR(v, ScalarLogical(0));	/* no checking */
     v = CDR(v);
 
+    SET_TAG(v, install("check.condition"));
+    SETCAR(v, ScalarLogical(0));	/* no checking */
+    v = CDR(v);
+    
     p = getenv("R_KEEP_PKG_SOURCE");
     R_KeepSource = (p && (strcmp(p, "yes") == 0)) ? 1 : 0;