os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/if.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/if.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,1115 @@
1.4 +# Commands covered: if
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1996 Sun Microsystems, Inc.
1.11 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.12 +#
1.13 +# See the file "license.terms" for information on usage and redistribution
1.14 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.15 +#
1.16 +# RCS: @(#) $Id: if.test,v 1.7 2001/12/04 15:36:29 dkf Exp $
1.17 +
1.18 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.19 + package require tcltest
1.20 + namespace import -force ::tcltest::*
1.21 +}
1.22 +
1.23 +# Basic "if" operation.
1.24 +
1.25 +catch {unset a}
1.26 +test if-1.1 {TclCompileIfCmd: missing if/elseif test} {
1.27 + list [catch {if} msg] $msg
1.28 +} {1 {wrong # args: no expression after "if" argument}}
1.29 +test if-1.2 {TclCompileIfCmd: error in if/elseif test} {
1.30 + list [catch {if {[error "error in condition"]} foo} msg] $msg
1.31 +} {1 {error in condition}}
1.32 +test if-1.3 {TclCompileIfCmd: error in if/elseif test} {
1.33 + list [catch {if {1+}} msg] $msg $errorInfo
1.34 +} {1 {syntax error in expression "1+": premature end of expression} {syntax error in expression "1+": premature end of expression
1.35 + ("if" test expression)
1.36 + while compiling
1.37 +"if {1+}"}}
1.38 +test if-1.4 {TclCompileIfCmd: if/elseif test in braces} {
1.39 + set a {}
1.40 + if {1<2} {set a 1}
1.41 + set a
1.42 +} {1}
1.43 +test if-1.5 {TclCompileIfCmd: if/elseif test not in braces} {
1.44 + set a {}
1.45 + if 1<2 {set a 1}
1.46 + set a
1.47 +} {1}
1.48 +test if-1.6 {TclCompileIfCmd: multiline test expr} {
1.49 + set a {}
1.50 + if {($tcl_platform(platform) != "foobar1") && \
1.51 + ($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
1.52 + set a
1.53 +} 3
1.54 +test if-1.7 {TclCompileIfCmd: "then" after if/elseif test} {
1.55 + set a {}
1.56 + if 4>3 then {set a 1}
1.57 + set a
1.58 +} {1}
1.59 +test if-1.8 {TclCompileIfCmd: keyword other than "then" after if/elseif test} {
1.60 + set a {}
1.61 + catch {if 1<2 therefore {set a 1}} msg
1.62 + set msg
1.63 +} {invalid command name "therefore"}
1.64 +test if-1.9 {TclCompileIfCmd: missing "then" body} {
1.65 + set a {}
1.66 + catch {if 1<2 then} msg
1.67 + set msg
1.68 +} {wrong # args: no script following "then" argument}
1.69 +test if-1.10 {TclCompileIfCmd: error in "then" body} {
1.70 + set a {}
1.71 + list [catch {if {$a!="xxx"} then {set}} msg] $msg $errorInfo
1.72 +} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
1.73 + while compiling
1.74 +"set"
1.75 + ("if" then script line 1)
1.76 + while compiling
1.77 +"if {$a!="xxx"} then {set}"}}
1.78 +test if-1.11 {TclCompileIfCmd: error in "then" body} {
1.79 + list [catch {if 2 then {[error "error in then clause"]}} msg] $msg
1.80 +} {1 {error in then clause}}
1.81 +test if-1.12 {TclCompileIfCmd: "then" body in quotes} {
1.82 + set a {}
1.83 + if 27>17 "append a x"
1.84 + set a
1.85 +} {x}
1.86 +test if-1.13 {TclCompileIfCmd: computed "then" body} {
1.87 + catch {unset x1}
1.88 + catch {unset x2}
1.89 + set a {}
1.90 + set x1 {append a x1}
1.91 + set x2 {; append a x2}
1.92 + set a {}
1.93 + if 1 $x1$x2
1.94 + set a
1.95 +} {x1x2}
1.96 +test if-1.14 {TclCompileIfCmd: taking proper branch} {
1.97 + set a {}
1.98 + if 1<2 {set a 1}
1.99 + set a
1.100 +} 1
1.101 +test if-1.15 {TclCompileIfCmd: taking proper branch} {
1.102 + set a {}
1.103 + if 1>2 {set a 1}
1.104 + set a
1.105 +} {}
1.106 +test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long "then" body} {
1.107 + catch {unset i}
1.108 + set a {}
1.109 + if 1<2 {
1.110 + set a 1
1.111 + while {$a != "xxx"} {
1.112 + break;
1.113 + while {$i >= 0} {
1.114 + if {[string compare $a "bar"] < 0} {
1.115 + set i $i
1.116 + set i [lindex $s $i]
1.117 + }
1.118 + if {[string compare $a "bar"] < 0} {
1.119 + set i $i
1.120 + set i [lindex $s $i]
1.121 + }
1.122 + if {[string compare $a "bar"] < 0} {
1.123 + set i $i
1.124 + set i [lindex $s $i]
1.125 + }
1.126 + if {[string compare $a "bar"] < 0} {
1.127 + set i $i
1.128 + set i [lindex $s $i]
1.129 + }
1.130 + set i [expr $i-1]
1.131 + }
1.132 + }
1.133 + set a 2
1.134 + while {$a != "xxx"} {
1.135 + break;
1.136 + while {$i >= 0} {
1.137 + if {[string compare $a "bar"] < 0} {
1.138 + set i $i
1.139 + set i [lindex $s $i]
1.140 + }
1.141 + if {[string compare $a "bar"] < 0} {
1.142 + set i $i
1.143 + set i [lindex $s $i]
1.144 + }
1.145 + if {[string compare $a "bar"] < 0} {
1.146 + set i $i
1.147 + set i [lindex $s $i]
1.148 + }
1.149 + if {[string compare $a "bar"] < 0} {
1.150 + set i $i
1.151 + set i [lindex $s $i]
1.152 + }
1.153 + set i [expr $i-1]
1.154 + }
1.155 + }
1.156 + set a 3
1.157 + }
1.158 + set a
1.159 +} 3
1.160 +test if-1.17 {TclCompileIfCmd: if/elseif test in quotes} {
1.161 + set a {}
1.162 + list [catch {if {"0 < 3"} {set a 1}} msg] $msg
1.163 +} {1 {expected boolean value but got "0 < 3"}}
1.164 +
1.165 +
1.166 +test if-2.1 {TclCompileIfCmd: "elseif" after if/elseif test} {
1.167 + set a {}
1.168 + if 3>4 {set a 1} elseif 1 {set a 2}
1.169 + set a
1.170 +} {2}
1.171 +# Since "else" is optional, the "elwood" below is treated as a command.
1.172 +# But then there shouldn't be any additional argument words for the "if".
1.173 +test if-2.2 {TclCompileIfCmd: keyword other than "elseif"} {
1.174 + set a {}
1.175 + catch {if 1<2 {set a 1} elwood {set a 2}} msg
1.176 + set msg
1.177 +} {wrong # args: extra words after "else" clause in "if" command}
1.178 +test if-2.3 {TclCompileIfCmd: missing expression after "elseif"} {
1.179 + set a {}
1.180 + catch {if 1<2 {set a 1} elseif} msg
1.181 + set msg
1.182 +} {wrong # args: no expression after "elseif" argument}
1.183 +test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} {
1.184 + set a {}
1.185 + list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
1.186 +} {1 {syntax error in expression "1>": premature end of expression} {syntax error in expression "1>": premature end of expression
1.187 + ("if" test expression)
1.188 + while compiling
1.189 +"if 3>4 {set a 1} elseif {1>}"}}
1.190 +test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long "elseif" body} {
1.191 + catch {unset i}
1.192 + set a {}
1.193 + if 1>2 {
1.194 + set a 1
1.195 + while {$a != "xxx"} {
1.196 + break;
1.197 + while {$i >= 0} {
1.198 + if {[string compare $a "bar"] < 0} {
1.199 + set i $i
1.200 + set i [lindex $s $i]
1.201 + }
1.202 + if {[string compare $a "bar"] < 0} {
1.203 + set i $i
1.204 + set i [lindex $s $i]
1.205 + }
1.206 + if {[string compare $a "bar"] < 0} {
1.207 + set i $i
1.208 + set i [lindex $s $i]
1.209 + }
1.210 + if {[string compare $a "bar"] < 0} {
1.211 + set i $i
1.212 + set i [lindex $s $i]
1.213 + }
1.214 + set i [expr $i-1]
1.215 + }
1.216 + }
1.217 + set a 2
1.218 + while {$a != "xxx"} {
1.219 + break;
1.220 + while {$i >= 0} {
1.221 + if {[string compare $a "bar"] < 0} {
1.222 + set i $i
1.223 + set i [lindex $s $i]
1.224 + }
1.225 + if {[string compare $a "bar"] < 0} {
1.226 + set i $i
1.227 + set i [lindex $s $i]
1.228 + }
1.229 + if {[string compare $a "bar"] < 0} {
1.230 + set i $i
1.231 + set i [lindex $s $i]
1.232 + }
1.233 + if {[string compare $a "bar"] < 0} {
1.234 + set i $i
1.235 + set i [lindex $s $i]
1.236 + }
1.237 + set i [expr $i-1]
1.238 + }
1.239 + }
1.240 + set a 3
1.241 + } elseif 1<2 then { #; this if arm should be taken
1.242 + set a 4
1.243 + while {$a != "xxx"} {
1.244 + break;
1.245 + while {$i >= 0} {
1.246 + if {[string compare $a "bar"] < 0} {
1.247 + set i $i
1.248 + set i [lindex $s $i]
1.249 + }
1.250 + if {[string compare $a "bar"] < 0} {
1.251 + set i $i
1.252 + set i [lindex $s $i]
1.253 + }
1.254 + if {[string compare $a "bar"] < 0} {
1.255 + set i $i
1.256 + set i [lindex $s $i]
1.257 + }
1.258 + if {[string compare $a "bar"] < 0} {
1.259 + set i $i
1.260 + set i [lindex $s $i]
1.261 + }
1.262 + set i [expr $i-1]
1.263 + }
1.264 + }
1.265 + set a 5
1.266 + while {$a != "xxx"} {
1.267 + break;
1.268 + while {$i >= 0} {
1.269 + if {[string compare $a "bar"] < 0} {
1.270 + set i $i
1.271 + set i [lindex $s $i]
1.272 + }
1.273 + if {[string compare $a "bar"] < 0} {
1.274 + set i $i
1.275 + set i [lindex $s $i]
1.276 + }
1.277 + if {[string compare $a "bar"] < 0} {
1.278 + set i $i
1.279 + set i [lindex $s $i]
1.280 + }
1.281 + if {[string compare $a "bar"] < 0} {
1.282 + set i $i
1.283 + set i [lindex $s $i]
1.284 + }
1.285 + set i [expr $i-1]
1.286 + }
1.287 + }
1.288 + set a 6
1.289 + }
1.290 + set a
1.291 +} 6
1.292 +
1.293 +test if-3.1 {TclCompileIfCmd: "else" clause} {
1.294 + set a {}
1.295 + if 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3}
1.296 + set a
1.297 +} 3
1.298 +# Since "else" is optional, the "elsex" below is treated as a command.
1.299 +# But then there shouldn't be any additional argument words for the "if".
1.300 +test if-3.2 {TclCompileIfCmd: keyword other than "else"} {
1.301 + set a {}
1.302 + catch {if 1<2 then {set a 1} elsex {set a 2}} msg
1.303 + set msg
1.304 +} {wrong # args: extra words after "else" clause in "if" command}
1.305 +test if-3.3 {TclCompileIfCmd: missing body after "else"} {
1.306 + set a {}
1.307 + catch {if 2<1 {set a 1} else} msg
1.308 + set msg
1.309 +} {wrong # args: no script following "else" argument}
1.310 +test if-3.4 {TclCompileIfCmd: error compiling body after "else"} {
1.311 + set a {}
1.312 + catch {if 2<1 {set a 1} else {set}} msg
1.313 + set errorInfo
1.314 +} {wrong # args: should be "set varName ?newValue?"
1.315 + while compiling
1.316 +"set"
1.317 + ("if" else script line 1)
1.318 + while compiling
1.319 +"if 2<1 {set a 1} else {set}"}
1.320 +test if-3.5 {TclCompileIfCmd: extra arguments after "else" argument} {
1.321 + set a {}
1.322 + catch {if 2<1 {set a 1} else {set a 2} or something} msg
1.323 + set msg
1.324 +} {wrong # args: extra words after "else" clause in "if" command}
1.325 +# The following test also checks whether contained loops and other
1.326 +# commands are properly relocated because a short jump must be replaced
1.327 +# by a "long distance" one.
1.328 +test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long "else" clause} {
1.329 + catch {unset i}
1.330 + set a {}
1.331 + if 1>2 {
1.332 + set a 1
1.333 + while {$a != "xxx"} {
1.334 + break;
1.335 + while {$i >= 0} {
1.336 + if {[string compare $a "bar"] < 0} {
1.337 + set i $i
1.338 + set i [lindex $s $i]
1.339 + }
1.340 + if {[string compare $a "bar"] < 0} {
1.341 + set i $i
1.342 + set i [lindex $s $i]
1.343 + }
1.344 + if {[string compare $a "bar"] < 0} {
1.345 + set i $i
1.346 + set i [lindex $s $i]
1.347 + }
1.348 + if {[string compare $a "bar"] < 0} {
1.349 + set i $i
1.350 + set i [lindex $s $i]
1.351 + }
1.352 + set i [expr $i-1]
1.353 + }
1.354 + }
1.355 + set a 2
1.356 + while {$a != "xxx"} {
1.357 + break;
1.358 + while {$i >= 0} {
1.359 + if {[string compare $a "bar"] < 0} {
1.360 + set i $i
1.361 + set i [lindex $s $i]
1.362 + }
1.363 + if {[string compare $a "bar"] < 0} {
1.364 + set i $i
1.365 + set i [lindex $s $i]
1.366 + }
1.367 + if {[string compare $a "bar"] < 0} {
1.368 + set i $i
1.369 + set i [lindex $s $i]
1.370 + }
1.371 + if {[string compare $a "bar"] < 0} {
1.372 + set i $i
1.373 + set i [lindex $s $i]
1.374 + }
1.375 + set i [expr $i-1]
1.376 + }
1.377 + }
1.378 + set a 3
1.379 + } elseif 1==2 then { #; this if arm should be taken
1.380 + set a 4
1.381 + while {$a != "xxx"} {
1.382 + break;
1.383 + while {$i >= 0} {
1.384 + if {[string compare $a "bar"] < 0} {
1.385 + set i $i
1.386 + set i [lindex $s $i]
1.387 + }
1.388 + if {[string compare $a "bar"] < 0} {
1.389 + set i $i
1.390 + set i [lindex $s $i]
1.391 + }
1.392 + if {[string compare $a "bar"] < 0} {
1.393 + set i $i
1.394 + set i [lindex $s $i]
1.395 + }
1.396 + if {[string compare $a "bar"] < 0} {
1.397 + set i $i
1.398 + set i [lindex $s $i]
1.399 + }
1.400 + set i [expr $i-1]
1.401 + }
1.402 + }
1.403 + set a 5
1.404 + while {$a != "xxx"} {
1.405 + break;
1.406 + while {$i >= 0} {
1.407 + if {[string compare $a "bar"] < 0} {
1.408 + set i $i
1.409 + set i [lindex $s $i]
1.410 + }
1.411 + if {[string compare $a "bar"] < 0} {
1.412 + set i $i
1.413 + set i [lindex $s $i]
1.414 + }
1.415 + if {[string compare $a "bar"] < 0} {
1.416 + set i $i
1.417 + set i [lindex $s $i]
1.418 + }
1.419 + if {[string compare $a "bar"] < 0} {
1.420 + set i $i
1.421 + set i [lindex $s $i]
1.422 + }
1.423 + set i [expr $i-1]
1.424 + }
1.425 + }
1.426 + set a 6
1.427 + } else {
1.428 + set a 7
1.429 + while {$a != "xxx"} {
1.430 + break;
1.431 + while {$i >= 0} {
1.432 + if {[string compare $a "bar"] < 0} {
1.433 + set i $i
1.434 + set i [lindex $s $i]
1.435 + }
1.436 + if {[string compare $a "bar"] < 0} {
1.437 + set i $i
1.438 + set i [lindex $s $i]
1.439 + }
1.440 + if {[string compare $a "bar"] < 0} {
1.441 + set i $i
1.442 + set i [lindex $s $i]
1.443 + }
1.444 + if {[string compare $a "bar"] < 0} {
1.445 + set i $i
1.446 + set i [lindex $s $i]
1.447 + }
1.448 + set i [expr $i-1]
1.449 + }
1.450 + }
1.451 + set a 8
1.452 + while {$a != "xxx"} {
1.453 + break;
1.454 + while {$i >= 0} {
1.455 + if {[string compare $a "bar"] < 0} {
1.456 + set i $i
1.457 + set i [lindex $s $i]
1.458 + }
1.459 + if {[string compare $a "bar"] < 0} {
1.460 + set i $i
1.461 + set i [lindex $s $i]
1.462 + }
1.463 + if {[string compare $a "bar"] < 0} {
1.464 + set i $i
1.465 + set i [lindex $s $i]
1.466 + }
1.467 + if {[string compare $a "bar"] < 0} {
1.468 + set i $i
1.469 + set i [lindex $s $i]
1.470 + }
1.471 + set i [expr $i-1]
1.472 + }
1.473 + }
1.474 + set a 9
1.475 + }
1.476 + set a
1.477 +} 9
1.478 +
1.479 +test if-4.1 {TclCompileIfCmd: "if" command result} {
1.480 + set a {}
1.481 + set a [if 3<4 {set i 27}]
1.482 + set a
1.483 +} 27
1.484 +test if-4.2 {TclCompileIfCmd: "if" command result} {
1.485 + set a {}
1.486 + set a [if 3>4 {set i 27}]
1.487 + set a
1.488 +} {}
1.489 +test if-4.3 {TclCompileIfCmd: "if" command result} {
1.490 + set a {}
1.491 + set a [if 0 {set i 1} elseif 1 {set i 2}]
1.492 + set a
1.493 +} 2
1.494 +test if-4.4 {TclCompileIfCmd: "if" command result} {
1.495 + set a {}
1.496 + set a [if 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}]
1.497 + set a
1.498 +} 4
1.499 +test if-4.5 {TclCompileIfCmd: return value} {
1.500 + if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
1.501 +} def
1.502 +
1.503 +# Check "if" and computed command names.
1.504 +
1.505 +catch {unset a}
1.506 +test if-5.1 {if cmd with computed command names: missing if/elseif test} {
1.507 + set z if
1.508 + list [catch {$z} msg] $msg
1.509 +} {1 {wrong # args: no expression after "if" argument}}
1.510 +
1.511 +test if-5.2 {if cmd with computed command names: error in if/elseif test} {
1.512 + set z if
1.513 + list [catch {$z {[error "error in condition"]} foo} msg] $msg
1.514 +} {1 {error in condition}}
1.515 +test if-5.3 {if cmd with computed command names: error in if/elseif test} {
1.516 + set z if
1.517 + list [catch {$z {1+}} msg] $msg $errorInfo
1.518 +} {1 {syntax error in expression "1+": premature end of expression} {syntax error in expression "1+": premature end of expression
1.519 + while executing
1.520 +"$z {1+}"}}
1.521 +test if-5.4 {if cmd with computed command names: if/elseif test in braces} {
1.522 + set z if
1.523 + set a {}
1.524 + $z {1<2} {set a 1}
1.525 + set a
1.526 +} {1}
1.527 +test if-5.5 {if cmd with computed command names: if/elseif test not in braces} {
1.528 + set z if
1.529 + set a {}
1.530 + $z 1<2 {set a 1}
1.531 + set a
1.532 +} {1}
1.533 +test if-5.6 {if cmd with computed command names: multiline test expr} {
1.534 + set z if
1.535 + set a {}
1.536 + $z {($tcl_platform(platform) != "foobar1") && \
1.537 + ($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
1.538 + set a
1.539 +} 3
1.540 +test if-5.7 {if cmd with computed command names: "then" after if/elseif test} {
1.541 + set z if
1.542 + set a {}
1.543 + $z 4>3 then {set a 1}
1.544 + set a
1.545 +} {1}
1.546 +test if-5.8 {if cmd with computed command names: keyword other than "then" after if/elseif test} {
1.547 + set z if
1.548 + set a {}
1.549 + catch {$z 1<2 therefore {set a 1}} msg
1.550 + set msg
1.551 +} {invalid command name "therefore"}
1.552 +test if-5.9 {if cmd with computed command names: missing "then" body} {
1.553 + set z if
1.554 + set a {}
1.555 + catch {$z 1<2 then} msg
1.556 + set msg
1.557 +} {wrong # args: no script following "then" argument}
1.558 +test if-5.10 {if cmd with computed command names: error in "then" body} {
1.559 + set z if
1.560 + set a {}
1.561 + list [catch {$z {$a!="xxx"} then {set}} msg] $msg $errorInfo
1.562 +} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
1.563 + while compiling
1.564 +"set"
1.565 + invoked from within
1.566 +"$z {$a!="xxx"} then {set}"}}
1.567 +test if-5.11 {if cmd with computed command names: error in "then" body} {
1.568 + set z if
1.569 + list [catch {$z 2 then {[error "error in then clause"]}} msg] $msg
1.570 +} {1 {error in then clause}}
1.571 +test if-5.12 {if cmd with computed command names: "then" body in quotes} {
1.572 + set z if
1.573 + set a {}
1.574 + $z 27>17 "append a x"
1.575 + set a
1.576 +} {x}
1.577 +test if-5.13 {if cmd with computed command names: computed "then" body} {
1.578 + set z if
1.579 + catch {unset x1}
1.580 + catch {unset x2}
1.581 + set a {}
1.582 + set x1 {append a x1}
1.583 + set x2 {; append a x2}
1.584 + set a {}
1.585 + $z 1 $x1$x2
1.586 + set a
1.587 +} {x1x2}
1.588 +test if-5.14 {if cmd with computed command names: taking proper branch} {
1.589 + set z if
1.590 + set a {}
1.591 + $z 1<2 {set a 1}
1.592 + set a
1.593 +} 1
1.594 +test if-5.15 {if cmd with computed command names: taking proper branch} {
1.595 + set z if
1.596 + set a {}
1.597 + $z 1>2 {set a 1}
1.598 + set a
1.599 +} {}
1.600 +test if-5.16 {if cmd with computed command names: test jumpFalse instruction replacement after long "then" body} {
1.601 + set z if
1.602 + catch {unset i}
1.603 + set a {}
1.604 + $z 1<2 {
1.605 + set a 1
1.606 + while {$a != "xxx"} {
1.607 + break;
1.608 + while {$i >= 0} {
1.609 + $z {[string compare $a "bar"] < 0} {
1.610 + set i $i
1.611 + set i [lindex $s $i]
1.612 + }
1.613 + $z {[string compare $a "bar"] < 0} {
1.614 + set i $i
1.615 + set i [lindex $s $i]
1.616 + }
1.617 + $z {[string compare $a "bar"] < 0} {
1.618 + set i $i
1.619 + set i [lindex $s $i]
1.620 + }
1.621 + $z {[string compare $a "bar"] < 0} {
1.622 + set i $i
1.623 + set i [lindex $s $i]
1.624 + }
1.625 + set i [expr $i-1]
1.626 + }
1.627 + }
1.628 + set a 2
1.629 + while {$a != "xxx"} {
1.630 + break;
1.631 + while {$i >= 0} {
1.632 + $z {[string compare $a "bar"] < 0} {
1.633 + set i $i
1.634 + set i [lindex $s $i]
1.635 + }
1.636 + $z {[string compare $a "bar"] < 0} {
1.637 + set i $i
1.638 + set i [lindex $s $i]
1.639 + }
1.640 + $z {[string compare $a "bar"] < 0} {
1.641 + set i $i
1.642 + set i [lindex $s $i]
1.643 + }
1.644 + $z {[string compare $a "bar"] < 0} {
1.645 + set i $i
1.646 + set i [lindex $s $i]
1.647 + }
1.648 + set i [expr $i-1]
1.649 + }
1.650 + }
1.651 + set a 3
1.652 + }
1.653 + set a
1.654 +} 3
1.655 +test if-5.17 {if cmd with computed command names: if/elseif test in quotes} {
1.656 + set z if
1.657 + set a {}
1.658 + list [catch {$z {"0 < 3"} {set a 1}} msg] $msg
1.659 +} {1 {expected boolean value but got "0 < 3"}}
1.660 +
1.661 +
1.662 +test if-6.1 {if cmd with computed command names: "elseif" after if/elseif test} {
1.663 + set z if
1.664 + set a {}
1.665 + $z 3>4 {set a 1} elseif 1 {set a 2}
1.666 + set a
1.667 +} {2}
1.668 +# Since "else" is optional, the "elwood" below is treated as a command.
1.669 +# But then there shouldn't be any additional argument words for the "if".
1.670 +test if-6.2 {if cmd with computed command names: keyword other than "elseif"} {
1.671 + set z if
1.672 + set a {}
1.673 + catch {$z 1<2 {set a 1} elwood {set a 2}} msg
1.674 + set msg
1.675 +} {wrong # args: extra words after "else" clause in "if" command}
1.676 +test if-6.3 {if cmd with computed command names: missing expression after "elseif"} {
1.677 + set z if
1.678 + set a {}
1.679 + catch {$z 1<2 {set a 1} elseif} msg
1.680 + set msg
1.681 +} {wrong # args: no expression after "elseif" argument}
1.682 +test if-6.4 {if cmd with computed command names: error in expression after "elseif"} {
1.683 + set z if
1.684 + set a {}
1.685 + list [catch {$z 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
1.686 +} {1 {syntax error in expression "1>": premature end of expression} {syntax error in expression "1>": premature end of expression
1.687 + while executing
1.688 +"$z 3>4 {set a 1} elseif {1>}"}}
1.689 +test if-6.5 {if cmd with computed command names: test jumpFalse instruction replacement after long "elseif" body} {
1.690 + set z if
1.691 + catch {unset i}
1.692 + set a {}
1.693 + $z 1>2 {
1.694 + set a 1
1.695 + while {$a != "xxx"} {
1.696 + break;
1.697 + while {$i >= 0} {
1.698 + $z {[string compare $a "bar"] < 0} {
1.699 + set i $i
1.700 + set i [lindex $s $i]
1.701 + }
1.702 + $z {[string compare $a "bar"] < 0} {
1.703 + set i $i
1.704 + set i [lindex $s $i]
1.705 + }
1.706 + $z {[string compare $a "bar"] < 0} {
1.707 + set i $i
1.708 + set i [lindex $s $i]
1.709 + }
1.710 + $z {[string compare $a "bar"] < 0} {
1.711 + set i $i
1.712 + set i [lindex $s $i]
1.713 + }
1.714 + set i [expr $i-1]
1.715 + }
1.716 + }
1.717 + set a 2
1.718 + while {$a != "xxx"} {
1.719 + break;
1.720 + while {$i >= 0} {
1.721 + $z {[string compare $a "bar"] < 0} {
1.722 + set i $i
1.723 + set i [lindex $s $i]
1.724 + }
1.725 + $z {[string compare $a "bar"] < 0} {
1.726 + set i $i
1.727 + set i [lindex $s $i]
1.728 + }
1.729 + $z {[string compare $a "bar"] < 0} {
1.730 + set i $i
1.731 + set i [lindex $s $i]
1.732 + }
1.733 + $z {[string compare $a "bar"] < 0} {
1.734 + set i $i
1.735 + set i [lindex $s $i]
1.736 + }
1.737 + set i [expr $i-1]
1.738 + }
1.739 + }
1.740 + set a 3
1.741 + } elseif 1<2 then { #; this if arm should be taken
1.742 + set a 4
1.743 + while {$a != "xxx"} {
1.744 + break;
1.745 + while {$i >= 0} {
1.746 + $z {[string compare $a "bar"] < 0} {
1.747 + set i $i
1.748 + set i [lindex $s $i]
1.749 + }
1.750 + $z {[string compare $a "bar"] < 0} {
1.751 + set i $i
1.752 + set i [lindex $s $i]
1.753 + }
1.754 + $z {[string compare $a "bar"] < 0} {
1.755 + set i $i
1.756 + set i [lindex $s $i]
1.757 + }
1.758 + $z {[string compare $a "bar"] < 0} {
1.759 + set i $i
1.760 + set i [lindex $s $i]
1.761 + }
1.762 + set i [expr $i-1]
1.763 + }
1.764 + }
1.765 + set a 5
1.766 + while {$a != "xxx"} {
1.767 + break;
1.768 + while {$i >= 0} {
1.769 + $z {[string compare $a "bar"] < 0} {
1.770 + set i $i
1.771 + set i [lindex $s $i]
1.772 + }
1.773 + $z {[string compare $a "bar"] < 0} {
1.774 + set i $i
1.775 + set i [lindex $s $i]
1.776 + }
1.777 + $z {[string compare $a "bar"] < 0} {
1.778 + set i $i
1.779 + set i [lindex $s $i]
1.780 + }
1.781 + $z {[string compare $a "bar"] < 0} {
1.782 + set i $i
1.783 + set i [lindex $s $i]
1.784 + }
1.785 + set i [expr $i-1]
1.786 + }
1.787 + }
1.788 + set a 6
1.789 + }
1.790 + set a
1.791 +} 6
1.792 +
1.793 +test if-7.1 {if cmd with computed command names: "else" clause} {
1.794 + set z if
1.795 + set a {}
1.796 + $z 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3}
1.797 + set a
1.798 +} 3
1.799 +# Since "else" is optional, the "elsex" below is treated as a command.
1.800 +# But then there shouldn't be any additional argument words for the "if".
1.801 +test if-7.2 {if cmd with computed command names: keyword other than "else"} {
1.802 + set z if
1.803 + set a {}
1.804 + catch {$z 1<2 then {set a 1} elsex {set a 2}} msg
1.805 + set msg
1.806 +} {wrong # args: extra words after "else" clause in "if" command}
1.807 +test if-7.3 {if cmd with computed command names: missing body after "else"} {
1.808 + set z if
1.809 + set a {}
1.810 + catch {$z 2<1 {set a 1} else} msg
1.811 + set msg
1.812 +} {wrong # args: no script following "else" argument}
1.813 +test if-7.4 {if cmd with computed command names: error compiling body after "else"} {
1.814 + set z if
1.815 + set a {}
1.816 + catch {$z 2<1 {set a 1} else {set}} msg
1.817 + set errorInfo
1.818 +} {wrong # args: should be "set varName ?newValue?"
1.819 + while compiling
1.820 +"set"
1.821 + invoked from within
1.822 +"$z 2<1 {set a 1} else {set}"}
1.823 +test if-7.5 {if cmd with computed command names: extra arguments after "else" argument} {
1.824 + set z if
1.825 + set a {}
1.826 + catch {$z 2<1 {set a 1} else {set a 2} or something} msg
1.827 + set msg
1.828 +} {wrong # args: extra words after "else" clause in "if" command}
1.829 +# The following test also checks whether contained loops and other
1.830 +# commands are properly relocated because a short jump must be replaced
1.831 +# by a "long distance" one.
1.832 +test if-7.6 {if cmd with computed command names: test jumpFalse instruction replacement after long "else" clause} {
1.833 + set z if
1.834 + catch {unset i}
1.835 + set a {}
1.836 + $z 1>2 {
1.837 + set a 1
1.838 + while {$a != "xxx"} {
1.839 + break;
1.840 + while {$i >= 0} {
1.841 + $z {[string compare $a "bar"] < 0} {
1.842 + set i $i
1.843 + set i [lindex $s $i]
1.844 + }
1.845 + $z {[string compare $a "bar"] < 0} {
1.846 + set i $i
1.847 + set i [lindex $s $i]
1.848 + }
1.849 + $z {[string compare $a "bar"] < 0} {
1.850 + set i $i
1.851 + set i [lindex $s $i]
1.852 + }
1.853 + $z {[string compare $a "bar"] < 0} {
1.854 + set i $i
1.855 + set i [lindex $s $i]
1.856 + }
1.857 + set i [expr $i-1]
1.858 + }
1.859 + }
1.860 + set a 2
1.861 + while {$a != "xxx"} {
1.862 + break;
1.863 + while {$i >= 0} {
1.864 + $z {[string compare $a "bar"] < 0} {
1.865 + set i $i
1.866 + set i [lindex $s $i]
1.867 + }
1.868 + $z {[string compare $a "bar"] < 0} {
1.869 + set i $i
1.870 + set i [lindex $s $i]
1.871 + }
1.872 + $z {[string compare $a "bar"] < 0} {
1.873 + set i $i
1.874 + set i [lindex $s $i]
1.875 + }
1.876 + $z {[string compare $a "bar"] < 0} {
1.877 + set i $i
1.878 + set i [lindex $s $i]
1.879 + }
1.880 + set i [expr $i-1]
1.881 + }
1.882 + }
1.883 + set a 3
1.884 + } elseif 1==2 then { #; this if arm should be taken
1.885 + set a 4
1.886 + while {$a != "xxx"} {
1.887 + break;
1.888 + while {$i >= 0} {
1.889 + $z {[string compare $a "bar"] < 0} {
1.890 + set i $i
1.891 + set i [lindex $s $i]
1.892 + }
1.893 + $z {[string compare $a "bar"] < 0} {
1.894 + set i $i
1.895 + set i [lindex $s $i]
1.896 + }
1.897 + $z {[string compare $a "bar"] < 0} {
1.898 + set i $i
1.899 + set i [lindex $s $i]
1.900 + }
1.901 + $z {[string compare $a "bar"] < 0} {
1.902 + set i $i
1.903 + set i [lindex $s $i]
1.904 + }
1.905 + set i [expr $i-1]
1.906 + }
1.907 + }
1.908 + set a 5
1.909 + while {$a != "xxx"} {
1.910 + break;
1.911 + while {$i >= 0} {
1.912 + $z {[string compare $a "bar"] < 0} {
1.913 + set i $i
1.914 + set i [lindex $s $i]
1.915 + }
1.916 + $z {[string compare $a "bar"] < 0} {
1.917 + set i $i
1.918 + set i [lindex $s $i]
1.919 + }
1.920 + $z {[string compare $a "bar"] < 0} {
1.921 + set i $i
1.922 + set i [lindex $s $i]
1.923 + }
1.924 + $z {[string compare $a "bar"] < 0} {
1.925 + set i $i
1.926 + set i [lindex $s $i]
1.927 + }
1.928 + set i [expr $i-1]
1.929 + }
1.930 + }
1.931 + set a 6
1.932 + } else {
1.933 + set a 7
1.934 + while {$a != "xxx"} {
1.935 + break;
1.936 + while {$i >= 0} {
1.937 + $z {[string compare $a "bar"] < 0} {
1.938 + set i $i
1.939 + set i [lindex $s $i]
1.940 + }
1.941 + $z {[string compare $a "bar"] < 0} {
1.942 + set i $i
1.943 + set i [lindex $s $i]
1.944 + }
1.945 + $z {[string compare $a "bar"] < 0} {
1.946 + set i $i
1.947 + set i [lindex $s $i]
1.948 + }
1.949 + $z {[string compare $a "bar"] < 0} {
1.950 + set i $i
1.951 + set i [lindex $s $i]
1.952 + }
1.953 + set i [expr $i-1]
1.954 + }
1.955 + }
1.956 + set a 8
1.957 + while {$a != "xxx"} {
1.958 + break;
1.959 + while {$i >= 0} {
1.960 + $z {[string compare $a "bar"] < 0} {
1.961 + set i $i
1.962 + set i [lindex $s $i]
1.963 + }
1.964 + $z {[string compare $a "bar"] < 0} {
1.965 + set i $i
1.966 + set i [lindex $s $i]
1.967 + }
1.968 + $z {[string compare $a "bar"] < 0} {
1.969 + set i $i
1.970 + set i [lindex $s $i]
1.971 + }
1.972 + $z {[string compare $a "bar"] < 0} {
1.973 + set i $i
1.974 + set i [lindex $s $i]
1.975 + }
1.976 + set i [expr $i-1]
1.977 + }
1.978 + }
1.979 + set a 9
1.980 + }
1.981 + set a
1.982 +} 9
1.983 +
1.984 +test if-8.1 {if cmd with computed command names: "if" command result} {
1.985 + set z if
1.986 + set a {}
1.987 + set a [$z 3<4 {set i 27}]
1.988 + set a
1.989 +} 27
1.990 +test if-8.2 {if cmd with computed command names: "if" command result} {
1.991 + set z if
1.992 + set a {}
1.993 + set a [$z 3>4 {set i 27}]
1.994 + set a
1.995 +} {}
1.996 +test if-8.3 {if cmd with computed command names: "if" command result} {
1.997 + set z if
1.998 + set a {}
1.999 + set a [$z 0 {set i 1} elseif 1 {set i 2}]
1.1000 + set a
1.1001 +} 2
1.1002 +test if-8.4 {if cmd with computed command names: "if" command result} {
1.1003 + set z if
1.1004 + set a {}
1.1005 + set a [$z 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}]
1.1006 + set a
1.1007 +} 4
1.1008 +test if-8.5 {if cmd with computed command names: return value} {
1.1009 + set z if
1.1010 + $z 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
1.1011 +} def
1.1012 +
1.1013 +test if-9.1 {if cmd with namespace qualifiers} {
1.1014 + ::if {1} {set x 4}
1.1015 +} 4
1.1016 +
1.1017 +# Test for incorrect "double evaluation semantics"
1.1018 +
1.1019 +test if-10.1 {delayed substitution of then body} {
1.1020 + set j 0
1.1021 + set if if
1.1022 + # this is not compiled
1.1023 + $if {[incr j] == 1} "
1.1024 + set result $j
1.1025 + "
1.1026 + # this will be compiled
1.1027 + proc p {} {
1.1028 + set j 0
1.1029 + if {[incr j]} "
1.1030 + set result $j
1.1031 + "
1.1032 + set result
1.1033 + }
1.1034 + append result [p]
1.1035 +} {00}
1.1036 +test if-10.2 {delayed substitution of elseif expression} {
1.1037 + set j 0
1.1038 + set if if
1.1039 + # this is not compiled
1.1040 + $if {[incr j] == 0} {
1.1041 + set result badthen
1.1042 + } elseif "$j == 1" {
1.1043 + set result badelseif
1.1044 + } else {
1.1045 + set result 0
1.1046 + }
1.1047 + # this will be compiled
1.1048 + proc p {} {
1.1049 + set j 0
1.1050 + if {[incr j] == 0} {
1.1051 + set result badthen
1.1052 + } elseif "$j == 1" {
1.1053 + set result badelseif
1.1054 + } else {
1.1055 + set result 0
1.1056 + }
1.1057 + set result
1.1058 + }
1.1059 + append result [p]
1.1060 +} {00}
1.1061 +test if-10.3 {delayed substitution of elseif body} {
1.1062 + set j 0
1.1063 + set if if
1.1064 + # this is not compiled
1.1065 + $if {[incr j] == 0} {
1.1066 + set result badthen
1.1067 + } elseif {1} "
1.1068 + set result $j
1.1069 + "
1.1070 + # this will be compiled
1.1071 + proc p {} {
1.1072 + set j 0
1.1073 + if {[incr j] == 0} {
1.1074 + set result badthen
1.1075 + } elseif {1} "
1.1076 + set result $j
1.1077 + "
1.1078 + }
1.1079 + append result [p]
1.1080 +} {00}
1.1081 +test if-10.4 {delayed substitution of else body} {
1.1082 + set j 0
1.1083 + if {[incr j] == 0} {
1.1084 + set result badthen
1.1085 + } else "
1.1086 + set result $j
1.1087 + "
1.1088 + set result
1.1089 +} {0}
1.1090 +test if-10.5 {substituted control words} {
1.1091 + set then then; proc then {} {return badthen}
1.1092 + set else else; proc else {} {return badelse}
1.1093 + set elseif elseif; proc elseif {} {return badelseif}
1.1094 + list [catch {if 1 $then {if 0 {} $elseif 1 {if 0 {} $else {list ok}}}} a] $a
1.1095 +} {0 ok}
1.1096 +test if-10.6 {double invocation of variable traces} {
1.1097 + set iftracecounter 0
1.1098 + proc iftraceproc {args} {
1.1099 + upvar #0 iftracecounter counter
1.1100 + set argc [llength $args]
1.1101 + set extraargs [lrange $args 0 [expr {$argc - 4}]]
1.1102 + set name [lindex $args [expr {$argc - 3}]]
1.1103 + upvar 1 $name var
1.1104 + if {[incr counter] % 2 == 1} {
1.1105 + set var "$counter oops [concat $extraargs]"
1.1106 + } else {
1.1107 + set var "$counter + [concat $extraargs]"
1.1108 + }
1.1109 + }
1.1110 + trace variable iftracevar r [list iftraceproc 10]
1.1111 + list [catch {if "$iftracevar + 20" {}} a] $a \
1.1112 + [catch {if "$iftracevar + 20" {}} b] $b \
1.1113 + [unset iftracevar iftracecounter]
1.1114 +} {1 {syntax error in expression "1 oops 10 + 20": extra tokens at end of expression} 0 {} {}}
1.1115 +
1.1116 +# cleanup
1.1117 +::tcltest::cleanupTests
1.1118 +return