* generic/tclExecute.c (TclExecuteByteCode): Added code to handle

* tests/expr.test (expr-23.48-53)	     integer exponentiation
that results in 32- and 64-bit integer results, avoiding calls to
wide integer exponentiation routines in this common case.
[Bug 1767293]

1 files changed, 122 insertions, 2 deletions

diff --git a/tests/expr.test b/tests/expr.test
index f73c613..ed8f586 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.68 2007/08/08 20:25:05 dgp Exp $
+# RCS: @(#) $Id: expr.test,v 1.69 2007/08/25 03:23:18 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -983,7 +983,127 @@ test expr-23.47 {INST_EXPON: Bug 1561260} {
 test expr-23.48 {INST_EXPON: TIP 274: right assoc} {
 expr 2**3**4
 } 2417851639229258349412352
-
+test expr-23.49 {INST_EXPON: optimize powers of 2} {
+    set trouble {test powers of 2}
+    for {set tval 0} {$tval <= 66} {incr tval} {
+	set is [expr {2 ** $tval}]
+	set sb [expr {1 << $tval}]
+	if {$is != $sb} {
+	    append trouble \n "2**" $tval " is " $is " should be " $sb
+	}
+	if {$tval >= 1} {
+	    set is [expr {-2 ** $tval}]
+	    set sb [expr {1 << $tval}]
+	    if {$tval & 1} {
+		set sb [expr {-$sb}]
+	    }
+	    if {$is != $sb} {
+		append trouble \n "-2**" $tval " is " $is " should be " $sb
+	    }
+	}
+    }
+    set trouble
+} {test powers of 2}
+test expr-23.50 {INST_EXPON: small powers of 32-bit integers} {
+    set trouble {test small powers of 32-bit ints}
+    for {set base 3} {$base <= 45} {incr base} {
+	set sb $base
+	set sbm [expr {-$base}]
+	for {set expt 2} {$expt <= 8} {incr expt} {
+	    set sb [expr {$sb * $base}]
+	    set is [expr {$base ** $expt}]
+	    if {$sb != $is} {
+		append trouble \n $base ** $expt " is " $is " should be " $sb
+	    }
+	    set sbm [expr {-$sbm * $base}]
+	    set ism [expr {(-$base) ** $expt}]
+	    if {$sbm != $ism} {
+		append trouble \n - $base ** $expt " is " $ism \
+		    " should be " $sbm
+	    }
+	}
+    }
+    set trouble
+} {test small powers of 32-bit ints}
+test expr-23.51 {INST_EXPON: intermediate powers of 32-bit integers} {
+    set trouble {test intermediate powers of 32-bit ints}
+    for {set base 3} {$base <= 11} {incr base} {
+	set sb [expr {$base ** 8}]
+	set sbm $sb
+	for {set expt 9} {$expt <= 21} {incr expt} {
+	    set sb [expr {$sb * $base}]
+	    set sbm [expr {$sbm * -$base}]
+	    set is [expr {$base ** $expt}]
+	    set ism [expr {-$base ** $expt}]
+	    if {$sb != $is} {
+		append trouble \n $base ** $expt " is " $is " should be " $sb
+	    }
+	    if {$sbm != $ism} {
+		append trouble \n - $base ** $expt " is " $ism  \
+		    " should be " $sbm
+	    }
+	}
+    }
+    set trouble
+} {test intermediate powers of 32-bit ints}
+test expr-23.52 {INST_EXPON: small integer powers with 64-bit results} {
+    set trouble {test small int powers with 64-bit results}
+    for {set exp 2} {$exp <= 16} {incr exp} {
+	set base [expr {entier(pow(double(0x7fffffffffffffff),(1.0/$exp)))}]
+	set sb 1
+	set sbm 1
+	for {set i 0} {$i < $exp} {incr i} {
+	    set sb [expr {$sb * $base}]
+	    set sbm [expr {$sbm * -$base}]
+	}
+	set is [expr {$base ** $exp}]
+	set ism [expr {-$base ** $exp}]
+	if {$sb != $is} {
+	    append trouble \n $base ** $exp " is " $is " should be " $sb
+	}
+	if {$sbm != $ism} {
+	    append trouble \n - $base ** $exp " is " $ism " should be " $sbm
+	}
+	incr base
+	set sb 1
+	set sbm 1
+	for {set i 0} {$i < $exp} {incr i} {
+	    set sb [expr {$sb * $base}]
+	    set sbm [expr {$sbm * -$base}]
+	}
+	set is [expr {$base ** $exp}]
+	set ism [expr {-$base ** $exp}]
+	if {$sb != $is} {
+	    append trouble \n $base ** $exp " is " $is " should be " $sb
+	}
+	if {$sbm != $ism} {
+	    append trouble \n - $base ** $exp " is " $ism " should be " $sbm
+	}
+    }
+    set trouble
+} {test small int powers with 64-bit results}
+test expr-23.53 {INST_EXPON: intermediate powers of 64-bit integers} {
+    set trouble {test intermediate powers of 64-bit ints}
+    for {set base 3} {$base <= 13} {incr base} {
+	set sb [expr {$base ** 15}]
+	set sbm [expr {-$sb}]
+	for {set expt 16} {$expt <= 39} {incr expt} {
+	    set sb [expr {$sb * $base}]
+	    set sbm [expr {$sbm * -$base}]
+	    set is [expr {$base ** $expt}]
+	    set ism [expr {-$base ** $expt}]
+	    if {$sb != $is} {
+		append trouble \n $base ** $expt " is " $is " should be " $sb
+	    }
+	    if {$sbm != $ism} {
+		append trouble \n - $base ** $expt " is " $ism  \
+		    " should be " $sbm
+	    }
+	}
+    }
+    set trouble
+} {test intermediate powers of 64-bit ints}
+	
 # Some compilers get this wrong; ensure that we work around it correctly
 test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
 test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0