summaryrefslogtreecommitdiffstats
path: root/tests/expr.test
diff options
context:
space:
mode:
authorstanton <stanton>1999-04-16 00:46:29 (GMT)
committerstanton <stanton>1999-04-16 00:46:29 (GMT)
commit97464e6cba8eb0008cf2727c15718671992b913f (patch)
treece9959f2747257d98d52ec8d18bf3b0de99b9535 /tests/expr.test
parenta8c96ddb94d1483a9de5e340b740cb74ef6cafa7 (diff)
downloadtcl-97464e6cba8eb0008cf2727c15718671992b913f.zip
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.gz
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.bz2
merged tcl 8.1 branch back into the main trunk
Diffstat (limited to 'tests/expr.test')
-rw-r--r--tests/expr.test75
1 files changed, 57 insertions, 18 deletions
diff --git a/tests/expr.test b/tests/expr.test
index 2a5c860..7b0135a 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -5,13 +5,16 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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.2 1998/09/14 18:40:09 stanton Exp $
+# RCS: @(#) $Id: expr.test,v 1.3 1999/04/16 00:47:27 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
set gotT1 0
@@ -88,7 +91,7 @@ test expr-1.5 {TclCompileExprCmd: quoted expression word} {
test expr-1.6 {TclCompileExprCmd: quoted expression word} {
catch {expr "0005"zxy} msg
set msg
-} {quoted string doesn't terminate properly}
+} {extra characters after close-quote}
test expr-1.7 {TclCompileExprCmd: expression word in braces} {
expr {-0005}
} -5
@@ -98,7 +101,7 @@ test expr-1.8 {TclCompileExprCmd: expression word in braces} {
test expr-1.9 {TclCompileExprCmd: expression word in braces} {
catch {expr {-0005}foo} msg
set msg
-} {argument word in braces doesn't terminate properly}
+} {extra characters after close-brace}
test expr-1.10 {TclCompileExprCmd: other expression word in braces} {
expr 4*[llength "6 2"]
} 8
@@ -479,7 +482,6 @@ test expr-14.16 {CompilePrimaryExpr: error compiling var reference primary} {
catch {expr {$a(foo}} msg
set errorInfo
} {missing )
- (parsing index for array "a")
while compiling
"expr {$a(foo}"}
test expr-14.17 {CompilePrimaryExpr: string primary that looks like var ref} {
@@ -516,9 +518,7 @@ test expr-14.23 {CompilePrimaryExpr: error in subcommand primary} {
test expr-14.24 {CompilePrimaryExpr: error in subcommand primary} {
catch {expr {[set i}} msg
set errorInfo
-} {missing close-bracket or close-brace
- while compiling
-"set i"
+} {missing close-bracket
while compiling
"expr {[set i}"}
test expr-14.25 {CompilePrimaryExpr: math function primary} {
@@ -531,7 +531,7 @@ test expr-14.27 {CompilePrimaryExpr: error in math function primary} {
catch {expr sinh::(2.0)} msg
set errorInfo
} {syntax error in expression "sinh::(2.0)"
- while executing
+ while compiling
"expr sinh::(2.0)"}
test expr-14.28 {CompilePrimaryExpr: subexpression primary} {
expr 2+(3*4)
@@ -548,7 +548,7 @@ test expr-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} {
catch {expr 2+(3*(4+5)} msg
set errorInfo
} {syntax error in expression "2+(3*(4+5)"
- while executing
+ while compiling
"expr 2+(3*(4+5)"}
test expr-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} {
set i "5+10"
@@ -558,44 +558,44 @@ test expr-14.32 {CompilePrimaryExpr: unexpected token} {
catch {expr @} msg
set errorInfo
} {syntax error in expression "@"
- while executing
+ while compiling
"expr @"}
test expr-15.1 {CompileMathFuncCall: missing parenthesis} {
catch {expr sinh2.0)} msg
set errorInfo
} {syntax error in expression "sinh2.0)"
- while executing
+ while compiling
"expr sinh2.0)"}
test expr-15.2 {CompileMathFuncCall: unknown math function} {
catch {expr whazzathuh(1)} msg
set errorInfo
} {unknown math function "whazzathuh"
- while executing
+ while compiling
"expr whazzathuh(1)"}
test expr-15.3 {CompileMathFuncCall: too many arguments} {
catch {expr sin(1,2,3)} msg
set errorInfo
} {too many arguments for math function
- while executing
+ while compiling
"expr sin(1,2,3)"}
test expr-15.4 {CompileMathFuncCall: ')' found before last required arg} {
catch {expr sin()} msg
set errorInfo
-} {syntax error in expression "sin()"
- while executing
+} {too few arguments for math function
+ while compiling
"expr sin()"}
test expr-15.5 {CompileMathFuncCall: too few arguments} {
catch {expr pow(1)} msg
set errorInfo
} {too few arguments for math function
- while executing
+ while compiling
"expr pow(1)"}
test expr-15.6 {CompileMathFuncCall: missing ')'} {
catch {expr sin(1} msg
set errorInfo
} {syntax error in expression "sin(1"
- while executing
+ while compiling
"expr sin(1"}
if $gotT1 {
test expr-15.7 {CompileMathFuncCall: call registered math function} {
@@ -667,4 +667,43 @@ test expr-19.1 {expr and interpreter result object resetting} {
p
} 3
+# Test for incorrect "double evaluation" semantics
+
+test expr-20.1 {wrong brace matching} {
+ catch {unset l}
+ catch {unset r}
+ catch {unset q}
+ catch {unset cmd}
+ catch {unset a}
+ set l "\{"; set r "\}"; set q "\""
+ set cmd "expr $l$q|$q == $q$r$q$r"
+ list [catch $cmd a] $a
+} {1 {extra characters after close-brace}}
+test expr-20.2 {double invocation of variable traces} {knownBug} {
+ set exprtracecounter 0
+ proc exprtraceproc {args} {
+ upvar #0 exprtracecounter counter
+ set argc [llength $args]
+ set extraargs [lrange $args 0 [expr {$argc - 4}]]
+ set name [lindex $args [expr {$argc - 3}]]
+ upvar 1 $name var
+ if {[incr counter] % 2 == 1} {
+ set var "$counter oops [concat $extraargs]"
+ } else {
+ set var "$counter + [concat $extraargs]"
+ }
+ }
+ trace variable exprtracevar r [list exprtraceproc 10]
+ list [catch {expr "$exprtracevar + 20"} a] $a \
+ [catch {expr "$exprtracevar + 20"} b] $b \
+ [unset exprtracevar exprtracecounter]
+} {1 {syntax error in expression "1 oops 10 + 20"} 0 32 {}}
+test expr-20.3 {broken substitution of integer digits} {
+ # fails with 8.0.x, but not 8.1b2
+ list [set a 000; expr 0x1$a] [set a 1; expr ${a}000]
+} {4096 1000}
+
+# cleanup
unset a
+::tcltest::cleanupTests
+return