From 341cfa533b51784f8cb9183ec8e2ed6fe6a26e32 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 28 Sep 2006 20:06:42 +0000
Subject:         * generic/tclExecute.c: Corrected error in INST_LSHIFT in the
         * tests/expr.test:      calculation done to determine whether a      
   shift in the (long int) type is possible.  The calculation had        
 literal value "1" where it needed a value "1L" to compute the         correct
 result.  Error detected via testing with the         math::bigfloat package
 [Bug 1567222]

---
 ChangeLog            | 7 +++++++
 generic/tclExecute.c | 4 ++--
 tests/expr.test      | 4 +++-
 3 files changed, 12 insertions(+), 3 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index a5cee9a..de9e314 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -5,6 +5,13 @@
 
 2006-09-27  Don Porter  <dgp@users.sourceforge.net>
 
+	* generic/tclExecute.c:	Corrected error in INST_LSHIFT in the
+	* tests/expr.test:	calculation done to determine whether a
+	shift in the (long int) type is possible.  The calculation had
+	literal value "1" where it needed a value "1L" to compute the
+	correct result.  Error detected via testing with the
+	math::bigfloat package [Bug 1567222]
+
 	* generic/tclPkg.c (CompareVersion):	Flatten strcmp() results to
 	{-1, 0, 1} to match expectations of CompareVersion() callers.
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 7006d00..660be98 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -12,7 +12,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.245 2006/09/19 16:31:56 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.246 2006/09/28 20:06:42 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3942,7 +3942,7 @@ TclExecuteByteCode(
 	    if ((type1 == TCL_NUMBER_LONG) && ((size_t)shift < CHAR_BIT*sizeof(long))
 		    && (l1 = *((CONST long *)ptr1))
 		    && !(((l1>0) ? l1 : ~l1)
-			    & -(1<<(CHAR_BIT*sizeof(long)-1-shift)))) {
+			    & -(1L<<(CHAR_BIT*sizeof(long)-1-shift)))) {
 		TclNewLongObj(objResultPtr, (l1<<shift));
 		TRACE(("%s\n", O2S(objResultPtr)));
 		NEXT_INST_F(1, 2, 1);
diff --git a/tests/expr.test b/tests/expr.test
index 20ab38b..0af0747 100644
--- a/tests/expr.test
+++ b/tests/expr.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: expr.test,v 1.61 2006/09/19 16:31:57 dgp Exp $
+# RCS: @(#) $Id: expr.test,v 1.62 2006/09/28 20:06:43 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -992,6 +992,8 @@ test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480
 test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0
 test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0
 
+test expr-24.10 {INST_LSHIFT: Bug 1567222} {expr 500000000000000<<28} 134217728000000000000000
+
 # List membership tests
 test expr-25.1 {'in' operator} {expr {"a" in "a b c"}} 1
 test expr-25.2 {'in' operator} {expr {"a" in "b a c"}} 1
-- 
cgit v0.12