* generic/tclExecute.c (IllegalExprOperandType): [Bug 3024379]: Made

	sure that errors caused by an argument to an operator being outside
	the domain of the operator all result in ::errorCode being ARITH
	DOMAIN and not NONE.

3 files changed, 30 insertions, 18 deletions

diff --git a/ChangeLog b/ChangeLog
index d0387f8..cad83dc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,14 @@
+2010-07-02  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclExecute.c (IllegalExprOperandType): [Bug 3024379]: Made
+	sure that errors caused by an argument to an operator being outside
+	the domain of the operator all result in ::errorCode being ARITH
+	DOMAIN and not NONE.
+
 2010-07-02  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* generic/tclIntDecls.h [Bug #803489] Tcl_FindNamespace problem in the
-	Stubs table
+	* generic/tclIntDecls.h: [Bug 803489]: Tcl_FindNamespace problem in
+	the Stubs table.
 
 2010-07-01  Donal K. Fellows  <dkf@users.sf.net>
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index cf26e87..41ea4f9 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.369.2.13 2010/02/02 20:51:47 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.369.2.14 2010/07/02 20:58:07 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -7701,6 +7701,7 @@ IllegalExprOperandType(
 
     Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 	    "can't use %s as operand of \"%s\"", description, operator));
+    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
 }
 
 /*
diff --git a/tests/mathop.test b/tests/mathop.test
index b60b29d..e0d5920 100644
--- a/tests/mathop.test
+++ b/tests/mathop.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: mathop.test,v 1.11.2.1 2008/03/31 17:21:15 dgp Exp $
+# RCS: @(#) $Id: mathop.test,v 1.11.2.2 2010/07/02 20:58:08 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -777,9 +777,13 @@ test mathop-20.6 { one arg, error } {
         # skipping - for now, knownbug...
         foreach op {+ * / & | ^ **} {
             lappend res [TestOp $op {*}$vals]
-            lappend exp "can't use non-numeric string as operand of \"$op\" NONE"
+            lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
         }
     }
+    foreach op {+ * / & | ^ **} {
+	lappend res [TestOp $op NaN 1]
+	lappend exp "can't use non-numeric floating-point value as operand of \"$op\" ARITH DOMAIN {non-numeric floating-point value}"
+    }
     expr {$res eq $exp ? 0 : $res}
 } 0
 test mathop-20.7 { multi arg } {
@@ -846,15 +850,15 @@ test mathop-21.5 { unary ops, bad values } {
     set res {}
     set exp {}
     lappend res [TestOp / x]
-    lappend exp "can't use non-numeric string as operand of \"/\" NONE"
+    lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}"
     lappend res [TestOp - x]
-    lappend exp "can't use non-numeric string as operand of \"-\" NONE"
+    lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}"
     lappend res [TestOp ~ x]
-    lappend exp "can't use non-numeric string as operand of \"~\" NONE"
+    lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}"
     lappend res [TestOp ! x]
-    lappend exp "can't use non-numeric string as operand of \"!\" NONE"
+    lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}"
     lappend res [TestOp ~ 5.0]
-    lappend exp "can't use floating-point value as operand of \"~\" NONE"
+    lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}"
     expr {$res eq $exp ? 0 : $res}
 } 0
 test mathop-21.6 { unary ops, too many } {
@@ -961,9 +965,9 @@ test mathop-22.4 { unary ops, bad values } {
     set exp {}
     foreach op {& | ^} {
         lappend res [TestOp $op x 5]
-        lappend exp "can't use non-numeric string as operand of \"$op\" NONE"
+        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
         lappend res [TestOp $op 5 x]
-        lappend exp "can't use non-numeric string as operand of \"$op\" NONE"
+        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
     }
     expr {$res eq $exp ? 0 : $res}
 } 0
@@ -1076,15 +1080,15 @@ test mathop-24.3 { binary ops, bad values } {
     set exp {}
     foreach op {% << >>} {
         lappend res [TestOp $op x 1]
-        lappend exp "can't use non-numeric string as operand of \"$op\" NONE"
+        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
         lappend res [TestOp $op 1 x]
-        lappend exp "can't use non-numeric string as operand of \"$op\" NONE"
+        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
     }
     foreach op {% << >>} {
         lappend res [TestOp $op 5.0 1]
-        lappend exp "can't use floating-point value as operand of \"$op\" NONE"
+        lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
         lappend res [TestOp $op 1 5.0]
-        lappend exp "can't use floating-point value as operand of \"$op\" NONE"
+        lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
     }
     foreach op {in ni} {
         lappend res [TestOp $op 5 "a b \{ c"]
@@ -1236,9 +1240,9 @@ test mathop-25.23 { exp operator errors } {
     lappend res [TestOp ** $huge 2.1]
     lappend exp "Inf"
     lappend res [TestOp ** 2 foo]
-    lappend exp "can't use non-numeric string as operand of \"**\" NONE"
+    lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
     lappend res [TestOp ** foo 2]
-    lappend exp "can't use non-numeric string as operand of \"**\" NONE"
+    lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
 
     expr {$res eq $exp ? 0 : $res}
 } 0