| author | sl@SLION-WIN7.fritz.box |
| Fri, 15 Jun 2012 03:10:57 +0200 | |
| changeset 0 | bde4ae8d615e |
| permissions | -rw-r--r-- |
| sl@0 | 1 |
# Commands covered: if |
| sl@0 | 2 |
# |
| sl@0 | 3 |
# This file contains a collection of tests for one or more of the Tcl |
| sl@0 | 4 |
# built-in commands. Sourcing this file into Tcl runs the tests and |
| sl@0 | 5 |
# generates output for errors. No output means no errors were found. |
| sl@0 | 6 |
# |
| sl@0 | 7 |
# Copyright (c) 1996 Sun Microsystems, Inc. |
| sl@0 | 8 |
# Copyright (c) 1998-1999 by Scriptics Corporation. |
| sl@0 | 9 |
# |
| sl@0 | 10 |
# See the file "license.terms" for information on usage and redistribution |
| sl@0 | 11 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
| sl@0 | 12 |
# |
| sl@0 | 13 |
# RCS: @(#) $Id: if.test,v 1.7 2001/12/04 15:36:29 dkf Exp $ |
| sl@0 | 14 |
|
| sl@0 | 15 |
if {[lsearch [namespace children] ::tcltest] == -1} {
|
| sl@0 | 16 |
package require tcltest |
| sl@0 | 17 |
namespace import -force ::tcltest::* |
| sl@0 | 18 |
} |
| sl@0 | 19 |
|
| sl@0 | 20 |
# Basic "if" operation. |
| sl@0 | 21 |
|
| sl@0 | 22 |
catch {unset a}
|
| sl@0 | 23 |
test if-1.1 {TclCompileIfCmd: missing if/elseif test} {
|
| sl@0 | 24 |
list [catch {if} msg] $msg
|
| sl@0 | 25 |
} {1 {wrong # args: no expression after "if" argument}}
|
| sl@0 | 26 |
test if-1.2 {TclCompileIfCmd: error in if/elseif test} {
|
| sl@0 | 27 |
list [catch {if {[error "error in condition"]} foo} msg] $msg
|
| sl@0 | 28 |
} {1 {error in condition}}
|
| sl@0 | 29 |
test if-1.3 {TclCompileIfCmd: error in if/elseif test} {
|
| sl@0 | 30 |
list [catch {if {1+}} msg] $msg $errorInfo
|
| sl@0 | 31 |
} {1 {syntax error in expression "1+": premature end of expression} {syntax error in expression "1+": premature end of expression
|
| sl@0 | 32 |
("if" test expression)
|
| sl@0 | 33 |
while compiling |
| sl@0 | 34 |
"if {1+}"}}
|
| sl@0 | 35 |
test if-1.4 {TclCompileIfCmd: if/elseif test in braces} {
|
| sl@0 | 36 |
set a {}
|
| sl@0 | 37 |
if {1<2} {set a 1}
|
| sl@0 | 38 |
set a |
| sl@0 | 39 |
} {1}
|
| sl@0 | 40 |
test if-1.5 {TclCompileIfCmd: if/elseif test not in braces} {
|
| sl@0 | 41 |
set a {}
|
| sl@0 | 42 |
if 1<2 {set a 1}
|
| sl@0 | 43 |
set a |
| sl@0 | 44 |
} {1}
|
| sl@0 | 45 |
test if-1.6 {TclCompileIfCmd: multiline test expr} {
|
| sl@0 | 46 |
set a {}
|
| sl@0 | 47 |
if {($tcl_platform(platform) != "foobar1") && \
|
| sl@0 | 48 |
($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
|
| sl@0 | 49 |
set a |
| sl@0 | 50 |
} 3 |
| sl@0 | 51 |
test if-1.7 {TclCompileIfCmd: "then" after if/elseif test} {
|
| sl@0 | 52 |
set a {}
|
| sl@0 | 53 |
if 4>3 then {set a 1}
|
| sl@0 | 54 |
set a |
| sl@0 | 55 |
} {1}
|
| sl@0 | 56 |
test if-1.8 {TclCompileIfCmd: keyword other than "then" after if/elseif test} {
|
| sl@0 | 57 |
set a {}
|
| sl@0 | 58 |
catch {if 1<2 therefore {set a 1}} msg
|
| sl@0 | 59 |
set msg |
| sl@0 | 60 |
} {invalid command name "therefore"}
|
| sl@0 | 61 |
test if-1.9 {TclCompileIfCmd: missing "then" body} {
|
| sl@0 | 62 |
set a {}
|
| sl@0 | 63 |
catch {if 1<2 then} msg
|
| sl@0 | 64 |
set msg |
| sl@0 | 65 |
} {wrong # args: no script following "then" argument}
|
| sl@0 | 66 |
test if-1.10 {TclCompileIfCmd: error in "then" body} {
|
| sl@0 | 67 |
set a {}
|
| sl@0 | 68 |
list [catch {if {$a!="xxx"} then {set}} msg] $msg $errorInfo
|
| sl@0 | 69 |
} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
|
| sl@0 | 70 |
while compiling |
| sl@0 | 71 |
"set" |
| sl@0 | 72 |
("if" then script line 1)
|
| sl@0 | 73 |
while compiling |
| sl@0 | 74 |
"if {$a!="xxx"} then {set}"}}
|
| sl@0 | 75 |
test if-1.11 {TclCompileIfCmd: error in "then" body} {
|
| sl@0 | 76 |
list [catch {if 2 then {[error "error in then clause"]}} msg] $msg
|
| sl@0 | 77 |
} {1 {error in then clause}}
|
| sl@0 | 78 |
test if-1.12 {TclCompileIfCmd: "then" body in quotes} {
|
| sl@0 | 79 |
set a {}
|
| sl@0 | 80 |
if 27>17 "append a x" |
| sl@0 | 81 |
set a |
| sl@0 | 82 |
} {x}
|
| sl@0 | 83 |
test if-1.13 {TclCompileIfCmd: computed "then" body} {
|
| sl@0 | 84 |
catch {unset x1}
|
| sl@0 | 85 |
catch {unset x2}
|
| sl@0 | 86 |
set a {}
|
| sl@0 | 87 |
set x1 {append a x1}
|
| sl@0 | 88 |
set x2 {; append a x2}
|
| sl@0 | 89 |
set a {}
|
| sl@0 | 90 |
if 1 $x1$x2 |
| sl@0 | 91 |
set a |
| sl@0 | 92 |
} {x1x2}
|
| sl@0 | 93 |
test if-1.14 {TclCompileIfCmd: taking proper branch} {
|
| sl@0 | 94 |
set a {}
|
| sl@0 | 95 |
if 1<2 {set a 1}
|
| sl@0 | 96 |
set a |
| sl@0 | 97 |
} 1 |
| sl@0 | 98 |
test if-1.15 {TclCompileIfCmd: taking proper branch} {
|
| sl@0 | 99 |
set a {}
|
| sl@0 | 100 |
if 1>2 {set a 1}
|
| sl@0 | 101 |
set a |
| sl@0 | 102 |
} {}
|
| sl@0 | 103 |
test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long "then" body} {
|
| sl@0 | 104 |
catch {unset i}
|
| sl@0 | 105 |
set a {}
|
| sl@0 | 106 |
if 1<2 {
|
| sl@0 | 107 |
set a 1 |
| sl@0 | 108 |
while {$a != "xxx"} {
|
| sl@0 | 109 |
break; |
| sl@0 | 110 |
while {$i >= 0} {
|
| sl@0 | 111 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 112 |
set i $i |
| sl@0 | 113 |
set i [lindex $s $i] |
| sl@0 | 114 |
} |
| sl@0 | 115 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 116 |
set i $i |
| sl@0 | 117 |
set i [lindex $s $i] |
| sl@0 | 118 |
} |
| sl@0 | 119 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 120 |
set i $i |
| sl@0 | 121 |
set i [lindex $s $i] |
| sl@0 | 122 |
} |
| sl@0 | 123 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 124 |
set i $i |
| sl@0 | 125 |
set i [lindex $s $i] |
| sl@0 | 126 |
} |
| sl@0 | 127 |
set i [expr $i-1] |
| sl@0 | 128 |
} |
| sl@0 | 129 |
} |
| sl@0 | 130 |
set a 2 |
| sl@0 | 131 |
while {$a != "xxx"} {
|
| sl@0 | 132 |
break; |
| sl@0 | 133 |
while {$i >= 0} {
|
| sl@0 | 134 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 135 |
set i $i |
| sl@0 | 136 |
set i [lindex $s $i] |
| sl@0 | 137 |
} |
| sl@0 | 138 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 139 |
set i $i |
| sl@0 | 140 |
set i [lindex $s $i] |
| sl@0 | 141 |
} |
| sl@0 | 142 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 143 |
set i $i |
| sl@0 | 144 |
set i [lindex $s $i] |
| sl@0 | 145 |
} |
| sl@0 | 146 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 147 |
set i $i |
| sl@0 | 148 |
set i [lindex $s $i] |
| sl@0 | 149 |
} |
| sl@0 | 150 |
set i [expr $i-1] |
| sl@0 | 151 |
} |
| sl@0 | 152 |
} |
| sl@0 | 153 |
set a 3 |
| sl@0 | 154 |
} |
| sl@0 | 155 |
set a |
| sl@0 | 156 |
} 3 |
| sl@0 | 157 |
test if-1.17 {TclCompileIfCmd: if/elseif test in quotes} {
|
| sl@0 | 158 |
set a {}
|
| sl@0 | 159 |
list [catch {if {"0 < 3"} {set a 1}} msg] $msg
|
| sl@0 | 160 |
} {1 {expected boolean value but got "0 < 3"}}
|
| sl@0 | 161 |
|
| sl@0 | 162 |
|
| sl@0 | 163 |
test if-2.1 {TclCompileIfCmd: "elseif" after if/elseif test} {
|
| sl@0 | 164 |
set a {}
|
| sl@0 | 165 |
if 3>4 {set a 1} elseif 1 {set a 2}
|
| sl@0 | 166 |
set a |
| sl@0 | 167 |
} {2}
|
| sl@0 | 168 |
# Since "else" is optional, the "elwood" below is treated as a command. |
| sl@0 | 169 |
# But then there shouldn't be any additional argument words for the "if". |
| sl@0 | 170 |
test if-2.2 {TclCompileIfCmd: keyword other than "elseif"} {
|
| sl@0 | 171 |
set a {}
|
| sl@0 | 172 |
catch {if 1<2 {set a 1} elwood {set a 2}} msg
|
| sl@0 | 173 |
set msg |
| sl@0 | 174 |
} {wrong # args: extra words after "else" clause in "if" command}
|
| sl@0 | 175 |
test if-2.3 {TclCompileIfCmd: missing expression after "elseif"} {
|
| sl@0 | 176 |
set a {}
|
| sl@0 | 177 |
catch {if 1<2 {set a 1} elseif} msg
|
| sl@0 | 178 |
set msg |
| sl@0 | 179 |
} {wrong # args: no expression after "elseif" argument}
|
| sl@0 | 180 |
test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} {
|
| sl@0 | 181 |
set a {}
|
| sl@0 | 182 |
list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
|
| sl@0 | 183 |
} {1 {syntax error in expression "1>": premature end of expression} {syntax error in expression "1>": premature end of expression
|
| sl@0 | 184 |
("if" test expression)
|
| sl@0 | 185 |
while compiling |
| sl@0 | 186 |
"if 3>4 {set a 1} elseif {1>}"}}
|
| sl@0 | 187 |
test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long "elseif" body} {
|
| sl@0 | 188 |
catch {unset i}
|
| sl@0 | 189 |
set a {}
|
| sl@0 | 190 |
if 1>2 {
|
| sl@0 | 191 |
set a 1 |
| sl@0 | 192 |
while {$a != "xxx"} {
|
| sl@0 | 193 |
break; |
| sl@0 | 194 |
while {$i >= 0} {
|
| sl@0 | 195 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 196 |
set i $i |
| sl@0 | 197 |
set i [lindex $s $i] |
| sl@0 | 198 |
} |
| sl@0 | 199 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 200 |
set i $i |
| sl@0 | 201 |
set i [lindex $s $i] |
| sl@0 | 202 |
} |
| sl@0 | 203 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 204 |
set i $i |
| sl@0 | 205 |
set i [lindex $s $i] |
| sl@0 | 206 |
} |
| sl@0 | 207 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 208 |
set i $i |
| sl@0 | 209 |
set i [lindex $s $i] |
| sl@0 | 210 |
} |
| sl@0 | 211 |
set i [expr $i-1] |
| sl@0 | 212 |
} |
| sl@0 | 213 |
} |
| sl@0 | 214 |
set a 2 |
| sl@0 | 215 |
while {$a != "xxx"} {
|
| sl@0 | 216 |
break; |
| sl@0 | 217 |
while {$i >= 0} {
|
| sl@0 | 218 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 219 |
set i $i |
| sl@0 | 220 |
set i [lindex $s $i] |
| sl@0 | 221 |
} |
| sl@0 | 222 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 223 |
set i $i |
| sl@0 | 224 |
set i [lindex $s $i] |
| sl@0 | 225 |
} |
| sl@0 | 226 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 227 |
set i $i |
| sl@0 | 228 |
set i [lindex $s $i] |
| sl@0 | 229 |
} |
| sl@0 | 230 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 231 |
set i $i |
| sl@0 | 232 |
set i [lindex $s $i] |
| sl@0 | 233 |
} |
| sl@0 | 234 |
set i [expr $i-1] |
| sl@0 | 235 |
} |
| sl@0 | 236 |
} |
| sl@0 | 237 |
set a 3 |
| sl@0 | 238 |
} elseif 1<2 then { #; this if arm should be taken
|
| sl@0 | 239 |
set a 4 |
| sl@0 | 240 |
while {$a != "xxx"} {
|
| sl@0 | 241 |
break; |
| sl@0 | 242 |
while {$i >= 0} {
|
| sl@0 | 243 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 244 |
set i $i |
| sl@0 | 245 |
set i [lindex $s $i] |
| sl@0 | 246 |
} |
| sl@0 | 247 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 248 |
set i $i |
| sl@0 | 249 |
set i [lindex $s $i] |
| sl@0 | 250 |
} |
| sl@0 | 251 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 252 |
set i $i |
| sl@0 | 253 |
set i [lindex $s $i] |
| sl@0 | 254 |
} |
| sl@0 | 255 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 256 |
set i $i |
| sl@0 | 257 |
set i [lindex $s $i] |
| sl@0 | 258 |
} |
| sl@0 | 259 |
set i [expr $i-1] |
| sl@0 | 260 |
} |
| sl@0 | 261 |
} |
| sl@0 | 262 |
set a 5 |
| sl@0 | 263 |
while {$a != "xxx"} {
|
| sl@0 | 264 |
break; |
| sl@0 | 265 |
while {$i >= 0} {
|
| sl@0 | 266 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 267 |
set i $i |
| sl@0 | 268 |
set i [lindex $s $i] |
| sl@0 | 269 |
} |
| sl@0 | 270 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 271 |
set i $i |
| sl@0 | 272 |
set i [lindex $s $i] |
| sl@0 | 273 |
} |
| sl@0 | 274 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 275 |
set i $i |
| sl@0 | 276 |
set i [lindex $s $i] |
| sl@0 | 277 |
} |
| sl@0 | 278 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 279 |
set i $i |
| sl@0 | 280 |
set i [lindex $s $i] |
| sl@0 | 281 |
} |
| sl@0 | 282 |
set i [expr $i-1] |
| sl@0 | 283 |
} |
| sl@0 | 284 |
} |
| sl@0 | 285 |
set a 6 |
| sl@0 | 286 |
} |
| sl@0 | 287 |
set a |
| sl@0 | 288 |
} 6 |
| sl@0 | 289 |
|
| sl@0 | 290 |
test if-3.1 {TclCompileIfCmd: "else" clause} {
|
| sl@0 | 291 |
set a {}
|
| sl@0 | 292 |
if 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3}
|
| sl@0 | 293 |
set a |
| sl@0 | 294 |
} 3 |
| sl@0 | 295 |
# Since "else" is optional, the "elsex" below is treated as a command. |
| sl@0 | 296 |
# But then there shouldn't be any additional argument words for the "if". |
| sl@0 | 297 |
test if-3.2 {TclCompileIfCmd: keyword other than "else"} {
|
| sl@0 | 298 |
set a {}
|
| sl@0 | 299 |
catch {if 1<2 then {set a 1} elsex {set a 2}} msg
|
| sl@0 | 300 |
set msg |
| sl@0 | 301 |
} {wrong # args: extra words after "else" clause in "if" command}
|
| sl@0 | 302 |
test if-3.3 {TclCompileIfCmd: missing body after "else"} {
|
| sl@0 | 303 |
set a {}
|
| sl@0 | 304 |
catch {if 2<1 {set a 1} else} msg
|
| sl@0 | 305 |
set msg |
| sl@0 | 306 |
} {wrong # args: no script following "else" argument}
|
| sl@0 | 307 |
test if-3.4 {TclCompileIfCmd: error compiling body after "else"} {
|
| sl@0 | 308 |
set a {}
|
| sl@0 | 309 |
catch {if 2<1 {set a 1} else {set}} msg
|
| sl@0 | 310 |
set errorInfo |
| sl@0 | 311 |
} {wrong # args: should be "set varName ?newValue?"
|
| sl@0 | 312 |
while compiling |
| sl@0 | 313 |
"set" |
| sl@0 | 314 |
("if" else script line 1)
|
| sl@0 | 315 |
while compiling |
| sl@0 | 316 |
"if 2<1 {set a 1} else {set}"}
|
| sl@0 | 317 |
test if-3.5 {TclCompileIfCmd: extra arguments after "else" argument} {
|
| sl@0 | 318 |
set a {}
|
| sl@0 | 319 |
catch {if 2<1 {set a 1} else {set a 2} or something} msg
|
| sl@0 | 320 |
set msg |
| sl@0 | 321 |
} {wrong # args: extra words after "else" clause in "if" command}
|
| sl@0 | 322 |
# The following test also checks whether contained loops and other |
| sl@0 | 323 |
# commands are properly relocated because a short jump must be replaced |
| sl@0 | 324 |
# by a "long distance" one. |
| sl@0 | 325 |
test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long "else" clause} {
|
| sl@0 | 326 |
catch {unset i}
|
| sl@0 | 327 |
set a {}
|
| sl@0 | 328 |
if 1>2 {
|
| sl@0 | 329 |
set a 1 |
| sl@0 | 330 |
while {$a != "xxx"} {
|
| sl@0 | 331 |
break; |
| sl@0 | 332 |
while {$i >= 0} {
|
| sl@0 | 333 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 334 |
set i $i |
| sl@0 | 335 |
set i [lindex $s $i] |
| sl@0 | 336 |
} |
| sl@0 | 337 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 338 |
set i $i |
| sl@0 | 339 |
set i [lindex $s $i] |
| sl@0 | 340 |
} |
| sl@0 | 341 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 342 |
set i $i |
| sl@0 | 343 |
set i [lindex $s $i] |
| sl@0 | 344 |
} |
| sl@0 | 345 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 346 |
set i $i |
| sl@0 | 347 |
set i [lindex $s $i] |
| sl@0 | 348 |
} |
| sl@0 | 349 |
set i [expr $i-1] |
| sl@0 | 350 |
} |
| sl@0 | 351 |
} |
| sl@0 | 352 |
set a 2 |
| sl@0 | 353 |
while {$a != "xxx"} {
|
| sl@0 | 354 |
break; |
| sl@0 | 355 |
while {$i >= 0} {
|
| sl@0 | 356 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 357 |
set i $i |
| sl@0 | 358 |
set i [lindex $s $i] |
| sl@0 | 359 |
} |
| sl@0 | 360 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 361 |
set i $i |
| sl@0 | 362 |
set i [lindex $s $i] |
| sl@0 | 363 |
} |
| sl@0 | 364 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 365 |
set i $i |
| sl@0 | 366 |
set i [lindex $s $i] |
| sl@0 | 367 |
} |
| sl@0 | 368 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 369 |
set i $i |
| sl@0 | 370 |
set i [lindex $s $i] |
| sl@0 | 371 |
} |
| sl@0 | 372 |
set i [expr $i-1] |
| sl@0 | 373 |
} |
| sl@0 | 374 |
} |
| sl@0 | 375 |
set a 3 |
| sl@0 | 376 |
} elseif 1==2 then { #; this if arm should be taken
|
| sl@0 | 377 |
set a 4 |
| sl@0 | 378 |
while {$a != "xxx"} {
|
| sl@0 | 379 |
break; |
| sl@0 | 380 |
while {$i >= 0} {
|
| sl@0 | 381 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 382 |
set i $i |
| sl@0 | 383 |
set i [lindex $s $i] |
| sl@0 | 384 |
} |
| sl@0 | 385 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 386 |
set i $i |
| sl@0 | 387 |
set i [lindex $s $i] |
| sl@0 | 388 |
} |
| sl@0 | 389 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 390 |
set i $i |
| sl@0 | 391 |
set i [lindex $s $i] |
| sl@0 | 392 |
} |
| sl@0 | 393 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 394 |
set i $i |
| sl@0 | 395 |
set i [lindex $s $i] |
| sl@0 | 396 |
} |
| sl@0 | 397 |
set i [expr $i-1] |
| sl@0 | 398 |
} |
| sl@0 | 399 |
} |
| sl@0 | 400 |
set a 5 |
| sl@0 | 401 |
while {$a != "xxx"} {
|
| sl@0 | 402 |
break; |
| sl@0 | 403 |
while {$i >= 0} {
|
| sl@0 | 404 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 405 |
set i $i |
| sl@0 | 406 |
set i [lindex $s $i] |
| sl@0 | 407 |
} |
| sl@0 | 408 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 409 |
set i $i |
| sl@0 | 410 |
set i [lindex $s $i] |
| sl@0 | 411 |
} |
| sl@0 | 412 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 413 |
set i $i |
| sl@0 | 414 |
set i [lindex $s $i] |
| sl@0 | 415 |
} |
| sl@0 | 416 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 417 |
set i $i |
| sl@0 | 418 |
set i [lindex $s $i] |
| sl@0 | 419 |
} |
| sl@0 | 420 |
set i [expr $i-1] |
| sl@0 | 421 |
} |
| sl@0 | 422 |
} |
| sl@0 | 423 |
set a 6 |
| sl@0 | 424 |
} else {
|
| sl@0 | 425 |
set a 7 |
| sl@0 | 426 |
while {$a != "xxx"} {
|
| sl@0 | 427 |
break; |
| sl@0 | 428 |
while {$i >= 0} {
|
| sl@0 | 429 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 430 |
set i $i |
| sl@0 | 431 |
set i [lindex $s $i] |
| sl@0 | 432 |
} |
| sl@0 | 433 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 434 |
set i $i |
| sl@0 | 435 |
set i [lindex $s $i] |
| sl@0 | 436 |
} |
| sl@0 | 437 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 438 |
set i $i |
| sl@0 | 439 |
set i [lindex $s $i] |
| sl@0 | 440 |
} |
| sl@0 | 441 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 442 |
set i $i |
| sl@0 | 443 |
set i [lindex $s $i] |
| sl@0 | 444 |
} |
| sl@0 | 445 |
set i [expr $i-1] |
| sl@0 | 446 |
} |
| sl@0 | 447 |
} |
| sl@0 | 448 |
set a 8 |
| sl@0 | 449 |
while {$a != "xxx"} {
|
| sl@0 | 450 |
break; |
| sl@0 | 451 |
while {$i >= 0} {
|
| sl@0 | 452 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 453 |
set i $i |
| sl@0 | 454 |
set i [lindex $s $i] |
| sl@0 | 455 |
} |
| sl@0 | 456 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 457 |
set i $i |
| sl@0 | 458 |
set i [lindex $s $i] |
| sl@0 | 459 |
} |
| sl@0 | 460 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 461 |
set i $i |
| sl@0 | 462 |
set i [lindex $s $i] |
| sl@0 | 463 |
} |
| sl@0 | 464 |
if {[string compare $a "bar"] < 0} {
|
| sl@0 | 465 |
set i $i |
| sl@0 | 466 |
set i [lindex $s $i] |
| sl@0 | 467 |
} |
| sl@0 | 468 |
set i [expr $i-1] |
| sl@0 | 469 |
} |
| sl@0 | 470 |
} |
| sl@0 | 471 |
set a 9 |
| sl@0 | 472 |
} |
| sl@0 | 473 |
set a |
| sl@0 | 474 |
} 9 |
| sl@0 | 475 |
|
| sl@0 | 476 |
test if-4.1 {TclCompileIfCmd: "if" command result} {
|
| sl@0 | 477 |
set a {}
|
| sl@0 | 478 |
set a [if 3<4 {set i 27}]
|
| sl@0 | 479 |
set a |
| sl@0 | 480 |
} 27 |
| sl@0 | 481 |
test if-4.2 {TclCompileIfCmd: "if" command result} {
|
| sl@0 | 482 |
set a {}
|
| sl@0 | 483 |
set a [if 3>4 {set i 27}]
|
| sl@0 | 484 |
set a |
| sl@0 | 485 |
} {}
|
| sl@0 | 486 |
test if-4.3 {TclCompileIfCmd: "if" command result} {
|
| sl@0 | 487 |
set a {}
|
| sl@0 | 488 |
set a [if 0 {set i 1} elseif 1 {set i 2}]
|
| sl@0 | 489 |
set a |
| sl@0 | 490 |
} 2 |
| sl@0 | 491 |
test if-4.4 {TclCompileIfCmd: "if" command result} {
|
| sl@0 | 492 |
set a {}
|
| sl@0 | 493 |
set a [if 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}]
|
| sl@0 | 494 |
set a |
| sl@0 | 495 |
} 4 |
| sl@0 | 496 |
test if-4.5 {TclCompileIfCmd: return value} {
|
| sl@0 | 497 |
if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
|
| sl@0 | 498 |
} def |
| sl@0 | 499 |
|
| sl@0 | 500 |
# Check "if" and computed command names. |
| sl@0 | 501 |
|
| sl@0 | 502 |
catch {unset a}
|
| sl@0 | 503 |
test if-5.1 {if cmd with computed command names: missing if/elseif test} {
|
| sl@0 | 504 |
set z if |
| sl@0 | 505 |
list [catch {$z} msg] $msg
|
| sl@0 | 506 |
} {1 {wrong # args: no expression after "if" argument}}
|
| sl@0 | 507 |
|
| sl@0 | 508 |
test if-5.2 {if cmd with computed command names: error in if/elseif test} {
|
| sl@0 | 509 |
set z if |
| sl@0 | 510 |
list [catch {$z {[error "error in condition"]} foo} msg] $msg
|
| sl@0 | 511 |
} {1 {error in condition}}
|
| sl@0 | 512 |
test if-5.3 {if cmd with computed command names: error in if/elseif test} {
|
| sl@0 | 513 |
set z if |
| sl@0 | 514 |
list [catch {$z {1+}} msg] $msg $errorInfo
|
| sl@0 | 515 |
} {1 {syntax error in expression "1+": premature end of expression} {syntax error in expression "1+": premature end of expression
|
| sl@0 | 516 |
while executing |
| sl@0 | 517 |
"$z {1+}"}}
|
| sl@0 | 518 |
test if-5.4 {if cmd with computed command names: if/elseif test in braces} {
|
| sl@0 | 519 |
set z if |
| sl@0 | 520 |
set a {}
|
| sl@0 | 521 |
$z {1<2} {set a 1}
|
| sl@0 | 522 |
set a |
| sl@0 | 523 |
} {1}
|
| sl@0 | 524 |
test if-5.5 {if cmd with computed command names: if/elseif test not in braces} {
|
| sl@0 | 525 |
set z if |
| sl@0 | 526 |
set a {}
|
| sl@0 | 527 |
$z 1<2 {set a 1}
|
| sl@0 | 528 |
set a |
| sl@0 | 529 |
} {1}
|
| sl@0 | 530 |
test if-5.6 {if cmd with computed command names: multiline test expr} {
|
| sl@0 | 531 |
set z if |
| sl@0 | 532 |
set a {}
|
| sl@0 | 533 |
$z {($tcl_platform(platform) != "foobar1") && \
|
| sl@0 | 534 |
($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
|
| sl@0 | 535 |
set a |
| sl@0 | 536 |
} 3 |
| sl@0 | 537 |
test if-5.7 {if cmd with computed command names: "then" after if/elseif test} {
|
| sl@0 | 538 |
set z if |
| sl@0 | 539 |
set a {}
|
| sl@0 | 540 |
$z 4>3 then {set a 1}
|
| sl@0 | 541 |
set a |
| sl@0 | 542 |
} {1}
|
| sl@0 | 543 |
test if-5.8 {if cmd with computed command names: keyword other than "then" after if/elseif test} {
|
| sl@0 | 544 |
set z if |
| sl@0 | 545 |
set a {}
|
| sl@0 | 546 |
catch {$z 1<2 therefore {set a 1}} msg
|
| sl@0 | 547 |
set msg |
| sl@0 | 548 |
} {invalid command name "therefore"}
|
| sl@0 | 549 |
test if-5.9 {if cmd with computed command names: missing "then" body} {
|
| sl@0 | 550 |
set z if |
| sl@0 | 551 |
set a {}
|
| sl@0 | 552 |
catch {$z 1<2 then} msg
|
| sl@0 | 553 |
set msg |
| sl@0 | 554 |
} {wrong # args: no script following "then" argument}
|
| sl@0 | 555 |
test if-5.10 {if cmd with computed command names: error in "then" body} {
|
| sl@0 | 556 |
set z if |
| sl@0 | 557 |
set a {}
|
| sl@0 | 558 |
list [catch {$z {$a!="xxx"} then {set}} msg] $msg $errorInfo
|
| sl@0 | 559 |
} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
|
| sl@0 | 560 |
while compiling |
| sl@0 | 561 |
"set" |
| sl@0 | 562 |
invoked from within |
| sl@0 | 563 |
"$z {$a!="xxx"} then {set}"}}
|
| sl@0 | 564 |
test if-5.11 {if cmd with computed command names: error in "then" body} {
|
| sl@0 | 565 |
set z if |
| sl@0 | 566 |
list [catch {$z 2 then {[error "error in then clause"]}} msg] $msg
|
| sl@0 | 567 |
} {1 {error in then clause}}
|
| sl@0 | 568 |
test if-5.12 {if cmd with computed command names: "then" body in quotes} {
|
| sl@0 | 569 |
set z if |
| sl@0 | 570 |
set a {}
|
| sl@0 | 571 |
$z 27>17 "append a x" |
| sl@0 | 572 |
set a |
| sl@0 | 573 |
} {x}
|
| sl@0 | 574 |
test if-5.13 {if cmd with computed command names: computed "then" body} {
|
| sl@0 | 575 |
set z if |
| sl@0 | 576 |
catch {unset x1}
|
| sl@0 | 577 |
catch {unset x2}
|
| sl@0 | 578 |
set a {}
|
| sl@0 | 579 |
set x1 {append a x1}
|
| sl@0 | 580 |
set x2 {; append a x2}
|
| sl@0 | 581 |
set a {}
|
| sl@0 | 582 |
$z 1 $x1$x2 |
| sl@0 | 583 |
set a |
| sl@0 | 584 |
} {x1x2}
|
| sl@0 | 585 |
test if-5.14 {if cmd with computed command names: taking proper branch} {
|
| sl@0 | 586 |
set z if |
| sl@0 | 587 |
set a {}
|
| sl@0 | 588 |
$z 1<2 {set a 1}
|
| sl@0 | 589 |
set a |
| sl@0 | 590 |
} 1 |
| sl@0 | 591 |
test if-5.15 {if cmd with computed command names: taking proper branch} {
|
| sl@0 | 592 |
set z if |
| sl@0 | 593 |
set a {}
|
| sl@0 | 594 |
$z 1>2 {set a 1}
|
| sl@0 | 595 |
set a |
| sl@0 | 596 |
} {}
|
| sl@0 | 597 |
test if-5.16 {if cmd with computed command names: test jumpFalse instruction replacement after long "then" body} {
|
| sl@0 | 598 |
set z if |
| sl@0 | 599 |
catch {unset i}
|
| sl@0 | 600 |
set a {}
|
| sl@0 | 601 |
$z 1<2 {
|
| sl@0 | 602 |
set a 1 |
| sl@0 | 603 |
while {$a != "xxx"} {
|
| sl@0 | 604 |
break; |
| sl@0 | 605 |
while {$i >= 0} {
|
| sl@0 | 606 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 607 |
set i $i |
| sl@0 | 608 |
set i [lindex $s $i] |
| sl@0 | 609 |
} |
| sl@0 | 610 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 611 |
set i $i |
| sl@0 | 612 |
set i [lindex $s $i] |
| sl@0 | 613 |
} |
| sl@0 | 614 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 615 |
set i $i |
| sl@0 | 616 |
set i [lindex $s $i] |
| sl@0 | 617 |
} |
| sl@0 | 618 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 619 |
set i $i |
| sl@0 | 620 |
set i [lindex $s $i] |
| sl@0 | 621 |
} |
| sl@0 | 622 |
set i [expr $i-1] |
| sl@0 | 623 |
} |
| sl@0 | 624 |
} |
| sl@0 | 625 |
set a 2 |
| sl@0 | 626 |
while {$a != "xxx"} {
|
| sl@0 | 627 |
break; |
| sl@0 | 628 |
while {$i >= 0} {
|
| sl@0 | 629 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 630 |
set i $i |
| sl@0 | 631 |
set i [lindex $s $i] |
| sl@0 | 632 |
} |
| sl@0 | 633 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 634 |
set i $i |
| sl@0 | 635 |
set i [lindex $s $i] |
| sl@0 | 636 |
} |
| sl@0 | 637 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 638 |
set i $i |
| sl@0 | 639 |
set i [lindex $s $i] |
| sl@0 | 640 |
} |
| sl@0 | 641 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 642 |
set i $i |
| sl@0 | 643 |
set i [lindex $s $i] |
| sl@0 | 644 |
} |
| sl@0 | 645 |
set i [expr $i-1] |
| sl@0 | 646 |
} |
| sl@0 | 647 |
} |
| sl@0 | 648 |
set a 3 |
| sl@0 | 649 |
} |
| sl@0 | 650 |
set a |
| sl@0 | 651 |
} 3 |
| sl@0 | 652 |
test if-5.17 {if cmd with computed command names: if/elseif test in quotes} {
|
| sl@0 | 653 |
set z if |
| sl@0 | 654 |
set a {}
|
| sl@0 | 655 |
list [catch {$z {"0 < 3"} {set a 1}} msg] $msg
|
| sl@0 | 656 |
} {1 {expected boolean value but got "0 < 3"}}
|
| sl@0 | 657 |
|
| sl@0 | 658 |
|
| sl@0 | 659 |
test if-6.1 {if cmd with computed command names: "elseif" after if/elseif test} {
|
| sl@0 | 660 |
set z if |
| sl@0 | 661 |
set a {}
|
| sl@0 | 662 |
$z 3>4 {set a 1} elseif 1 {set a 2}
|
| sl@0 | 663 |
set a |
| sl@0 | 664 |
} {2}
|
| sl@0 | 665 |
# Since "else" is optional, the "elwood" below is treated as a command. |
| sl@0 | 666 |
# But then there shouldn't be any additional argument words for the "if". |
| sl@0 | 667 |
test if-6.2 {if cmd with computed command names: keyword other than "elseif"} {
|
| sl@0 | 668 |
set z if |
| sl@0 | 669 |
set a {}
|
| sl@0 | 670 |
catch {$z 1<2 {set a 1} elwood {set a 2}} msg
|
| sl@0 | 671 |
set msg |
| sl@0 | 672 |
} {wrong # args: extra words after "else" clause in "if" command}
|
| sl@0 | 673 |
test if-6.3 {if cmd with computed command names: missing expression after "elseif"} {
|
| sl@0 | 674 |
set z if |
| sl@0 | 675 |
set a {}
|
| sl@0 | 676 |
catch {$z 1<2 {set a 1} elseif} msg
|
| sl@0 | 677 |
set msg |
| sl@0 | 678 |
} {wrong # args: no expression after "elseif" argument}
|
| sl@0 | 679 |
test if-6.4 {if cmd with computed command names: error in expression after "elseif"} {
|
| sl@0 | 680 |
set z if |
| sl@0 | 681 |
set a {}
|
| sl@0 | 682 |
list [catch {$z 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
|
| sl@0 | 683 |
} {1 {syntax error in expression "1>": premature end of expression} {syntax error in expression "1>": premature end of expression
|
| sl@0 | 684 |
while executing |
| sl@0 | 685 |
"$z 3>4 {set a 1} elseif {1>}"}}
|
| sl@0 | 686 |
test if-6.5 {if cmd with computed command names: test jumpFalse instruction replacement after long "elseif" body} {
|
| sl@0 | 687 |
set z if |
| sl@0 | 688 |
catch {unset i}
|
| sl@0 | 689 |
set a {}
|
| sl@0 | 690 |
$z 1>2 {
|
| sl@0 | 691 |
set a 1 |
| sl@0 | 692 |
while {$a != "xxx"} {
|
| sl@0 | 693 |
break; |
| sl@0 | 694 |
while {$i >= 0} {
|
| sl@0 | 695 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 696 |
set i $i |
| sl@0 | 697 |
set i [lindex $s $i] |
| sl@0 | 698 |
} |
| sl@0 | 699 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 700 |
set i $i |
| sl@0 | 701 |
set i [lindex $s $i] |
| sl@0 | 702 |
} |
| sl@0 | 703 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 704 |
set i $i |
| sl@0 | 705 |
set i [lindex $s $i] |
| sl@0 | 706 |
} |
| sl@0 | 707 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 708 |
set i $i |
| sl@0 | 709 |
set i [lindex $s $i] |
| sl@0 | 710 |
} |
| sl@0 | 711 |
set i [expr $i-1] |
| sl@0 | 712 |
} |
| sl@0 | 713 |
} |
| sl@0 | 714 |
set a 2 |
| sl@0 | 715 |
while {$a != "xxx"} {
|
| sl@0 | 716 |
break; |
| sl@0 | 717 |
while {$i >= 0} {
|
| sl@0 | 718 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 719 |
set i $i |
| sl@0 | 720 |
set i [lindex $s $i] |
| sl@0 | 721 |
} |
| sl@0 | 722 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 723 |
set i $i |
| sl@0 | 724 |
set i [lindex $s $i] |
| sl@0 | 725 |
} |
| sl@0 | 726 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 727 |
set i $i |
| sl@0 | 728 |
set i [lindex $s $i] |
| sl@0 | 729 |
} |
| sl@0 | 730 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 731 |
set i $i |
| sl@0 | 732 |
set i [lindex $s $i] |
| sl@0 | 733 |
} |
| sl@0 | 734 |
set i [expr $i-1] |
| sl@0 | 735 |
} |
| sl@0 | 736 |
} |
| sl@0 | 737 |
set a 3 |
| sl@0 | 738 |
} elseif 1<2 then { #; this if arm should be taken
|
| sl@0 | 739 |
set a 4 |
| sl@0 | 740 |
while {$a != "xxx"} {
|
| sl@0 | 741 |
break; |
| sl@0 | 742 |
while {$i >= 0} {
|
| sl@0 | 743 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 744 |
set i $i |
| sl@0 | 745 |
set i [lindex $s $i] |
| sl@0 | 746 |
} |
| sl@0 | 747 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 748 |
set i $i |
| sl@0 | 749 |
set i [lindex $s $i] |
| sl@0 | 750 |
} |
| sl@0 | 751 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 752 |
set i $i |
| sl@0 | 753 |
set i [lindex $s $i] |
| sl@0 | 754 |
} |
| sl@0 | 755 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 756 |
set i $i |
| sl@0 | 757 |
set i [lindex $s $i] |
| sl@0 | 758 |
} |
| sl@0 | 759 |
set i [expr $i-1] |
| sl@0 | 760 |
} |
| sl@0 | 761 |
} |
| sl@0 | 762 |
set a 5 |
| sl@0 | 763 |
while {$a != "xxx"} {
|
| sl@0 | 764 |
break; |
| sl@0 | 765 |
while {$i >= 0} {
|
| sl@0 | 766 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 767 |
set i $i |
| sl@0 | 768 |
set i [lindex $s $i] |
| sl@0 | 769 |
} |
| sl@0 | 770 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 771 |
set i $i |
| sl@0 | 772 |
set i [lindex $s $i] |
| sl@0 | 773 |
} |
| sl@0 | 774 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 775 |
set i $i |
| sl@0 | 776 |
set i [lindex $s $i] |
| sl@0 | 777 |
} |
| sl@0 | 778 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 779 |
set i $i |
| sl@0 | 780 |
set i [lindex $s $i] |
| sl@0 | 781 |
} |
| sl@0 | 782 |
set i [expr $i-1] |
| sl@0 | 783 |
} |
| sl@0 | 784 |
} |
| sl@0 | 785 |
set a 6 |
| sl@0 | 786 |
} |
| sl@0 | 787 |
set a |
| sl@0 | 788 |
} 6 |
| sl@0 | 789 |
|
| sl@0 | 790 |
test if-7.1 {if cmd with computed command names: "else" clause} {
|
| sl@0 | 791 |
set z if |
| sl@0 | 792 |
set a {}
|
| sl@0 | 793 |
$z 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3}
|
| sl@0 | 794 |
set a |
| sl@0 | 795 |
} 3 |
| sl@0 | 796 |
# Since "else" is optional, the "elsex" below is treated as a command. |
| sl@0 | 797 |
# But then there shouldn't be any additional argument words for the "if". |
| sl@0 | 798 |
test if-7.2 {if cmd with computed command names: keyword other than "else"} {
|
| sl@0 | 799 |
set z if |
| sl@0 | 800 |
set a {}
|
| sl@0 | 801 |
catch {$z 1<2 then {set a 1} elsex {set a 2}} msg
|
| sl@0 | 802 |
set msg |
| sl@0 | 803 |
} {wrong # args: extra words after "else" clause in "if" command}
|
| sl@0 | 804 |
test if-7.3 {if cmd with computed command names: missing body after "else"} {
|
| sl@0 | 805 |
set z if |
| sl@0 | 806 |
set a {}
|
| sl@0 | 807 |
catch {$z 2<1 {set a 1} else} msg
|
| sl@0 | 808 |
set msg |
| sl@0 | 809 |
} {wrong # args: no script following "else" argument}
|
| sl@0 | 810 |
test if-7.4 {if cmd with computed command names: error compiling body after "else"} {
|
| sl@0 | 811 |
set z if |
| sl@0 | 812 |
set a {}
|
| sl@0 | 813 |
catch {$z 2<1 {set a 1} else {set}} msg
|
| sl@0 | 814 |
set errorInfo |
| sl@0 | 815 |
} {wrong # args: should be "set varName ?newValue?"
|
| sl@0 | 816 |
while compiling |
| sl@0 | 817 |
"set" |
| sl@0 | 818 |
invoked from within |
| sl@0 | 819 |
"$z 2<1 {set a 1} else {set}"}
|
| sl@0 | 820 |
test if-7.5 {if cmd with computed command names: extra arguments after "else" argument} {
|
| sl@0 | 821 |
set z if |
| sl@0 | 822 |
set a {}
|
| sl@0 | 823 |
catch {$z 2<1 {set a 1} else {set a 2} or something} msg
|
| sl@0 | 824 |
set msg |
| sl@0 | 825 |
} {wrong # args: extra words after "else" clause in "if" command}
|
| sl@0 | 826 |
# The following test also checks whether contained loops and other |
| sl@0 | 827 |
# commands are properly relocated because a short jump must be replaced |
| sl@0 | 828 |
# by a "long distance" one. |
| sl@0 | 829 |
test if-7.6 {if cmd with computed command names: test jumpFalse instruction replacement after long "else" clause} {
|
| sl@0 | 830 |
set z if |
| sl@0 | 831 |
catch {unset i}
|
| sl@0 | 832 |
set a {}
|
| sl@0 | 833 |
$z 1>2 {
|
| sl@0 | 834 |
set a 1 |
| sl@0 | 835 |
while {$a != "xxx"} {
|
| sl@0 | 836 |
break; |
| sl@0 | 837 |
while {$i >= 0} {
|
| sl@0 | 838 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 839 |
set i $i |
| sl@0 | 840 |
set i [lindex $s $i] |
| sl@0 | 841 |
} |
| sl@0 | 842 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 843 |
set i $i |
| sl@0 | 844 |
set i [lindex $s $i] |
| sl@0 | 845 |
} |
| sl@0 | 846 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 847 |
set i $i |
| sl@0 | 848 |
set i [lindex $s $i] |
| sl@0 | 849 |
} |
| sl@0 | 850 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 851 |
set i $i |
| sl@0 | 852 |
set i [lindex $s $i] |
| sl@0 | 853 |
} |
| sl@0 | 854 |
set i [expr $i-1] |
| sl@0 | 855 |
} |
| sl@0 | 856 |
} |
| sl@0 | 857 |
set a 2 |
| sl@0 | 858 |
while {$a != "xxx"} {
|
| sl@0 | 859 |
break; |
| sl@0 | 860 |
while {$i >= 0} {
|
| sl@0 | 861 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 862 |
set i $i |
| sl@0 | 863 |
set i [lindex $s $i] |
| sl@0 | 864 |
} |
| sl@0 | 865 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 866 |
set i $i |
| sl@0 | 867 |
set i [lindex $s $i] |
| sl@0 | 868 |
} |
| sl@0 | 869 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 870 |
set i $i |
| sl@0 | 871 |
set i [lindex $s $i] |
| sl@0 | 872 |
} |
| sl@0 | 873 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 874 |
set i $i |
| sl@0 | 875 |
set i [lindex $s $i] |
| sl@0 | 876 |
} |
| sl@0 | 877 |
set i [expr $i-1] |
| sl@0 | 878 |
} |
| sl@0 | 879 |
} |
| sl@0 | 880 |
set a 3 |
| sl@0 | 881 |
} elseif 1==2 then { #; this if arm should be taken
|
| sl@0 | 882 |
set a 4 |
| sl@0 | 883 |
while {$a != "xxx"} {
|
| sl@0 | 884 |
break; |
| sl@0 | 885 |
while {$i >= 0} {
|
| sl@0 | 886 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 887 |
set i $i |
| sl@0 | 888 |
set i [lindex $s $i] |
| sl@0 | 889 |
} |
| sl@0 | 890 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 891 |
set i $i |
| sl@0 | 892 |
set i [lindex $s $i] |
| sl@0 | 893 |
} |
| sl@0 | 894 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 895 |
set i $i |
| sl@0 | 896 |
set i [lindex $s $i] |
| sl@0 | 897 |
} |
| sl@0 | 898 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 899 |
set i $i |
| sl@0 | 900 |
set i [lindex $s $i] |
| sl@0 | 901 |
} |
| sl@0 | 902 |
set i [expr $i-1] |
| sl@0 | 903 |
} |
| sl@0 | 904 |
} |
| sl@0 | 905 |
set a 5 |
| sl@0 | 906 |
while {$a != "xxx"} {
|
| sl@0 | 907 |
break; |
| sl@0 | 908 |
while {$i >= 0} {
|
| sl@0 | 909 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 910 |
set i $i |
| sl@0 | 911 |
set i [lindex $s $i] |
| sl@0 | 912 |
} |
| sl@0 | 913 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 914 |
set i $i |
| sl@0 | 915 |
set i [lindex $s $i] |
| sl@0 | 916 |
} |
| sl@0 | 917 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 918 |
set i $i |
| sl@0 | 919 |
set i [lindex $s $i] |
| sl@0 | 920 |
} |
| sl@0 | 921 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 922 |
set i $i |
| sl@0 | 923 |
set i [lindex $s $i] |
| sl@0 | 924 |
} |
| sl@0 | 925 |
set i [expr $i-1] |
| sl@0 | 926 |
} |
| sl@0 | 927 |
} |
| sl@0 | 928 |
set a 6 |
| sl@0 | 929 |
} else {
|
| sl@0 | 930 |
set a 7 |
| sl@0 | 931 |
while {$a != "xxx"} {
|
| sl@0 | 932 |
break; |
| sl@0 | 933 |
while {$i >= 0} {
|
| sl@0 | 934 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 935 |
set i $i |
| sl@0 | 936 |
set i [lindex $s $i] |
| sl@0 | 937 |
} |
| sl@0 | 938 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 939 |
set i $i |
| sl@0 | 940 |
set i [lindex $s $i] |
| sl@0 | 941 |
} |
| sl@0 | 942 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 943 |
set i $i |
| sl@0 | 944 |
set i [lindex $s $i] |
| sl@0 | 945 |
} |
| sl@0 | 946 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 947 |
set i $i |
| sl@0 | 948 |
set i [lindex $s $i] |
| sl@0 | 949 |
} |
| sl@0 | 950 |
set i [expr $i-1] |
| sl@0 | 951 |
} |
| sl@0 | 952 |
} |
| sl@0 | 953 |
set a 8 |
| sl@0 | 954 |
while {$a != "xxx"} {
|
| sl@0 | 955 |
break; |
| sl@0 | 956 |
while {$i >= 0} {
|
| sl@0 | 957 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 958 |
set i $i |
| sl@0 | 959 |
set i [lindex $s $i] |
| sl@0 | 960 |
} |
| sl@0 | 961 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 962 |
set i $i |
| sl@0 | 963 |
set i [lindex $s $i] |
| sl@0 | 964 |
} |
| sl@0 | 965 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 966 |
set i $i |
| sl@0 | 967 |
set i [lindex $s $i] |
| sl@0 | 968 |
} |
| sl@0 | 969 |
$z {[string compare $a "bar"] < 0} {
|
| sl@0 | 970 |
set i $i |
| sl@0 | 971 |
set i [lindex $s $i] |
| sl@0 | 972 |
} |
| sl@0 | 973 |
set i [expr $i-1] |
| sl@0 | 974 |
} |
| sl@0 | 975 |
} |
| sl@0 | 976 |
set a 9 |
| sl@0 | 977 |
} |
| sl@0 | 978 |
set a |
| sl@0 | 979 |
} 9 |
| sl@0 | 980 |
|
| sl@0 | 981 |
test if-8.1 {if cmd with computed command names: "if" command result} {
|
| sl@0 | 982 |
set z if |
| sl@0 | 983 |
set a {}
|
| sl@0 | 984 |
set a [$z 3<4 {set i 27}]
|
| sl@0 | 985 |
set a |
| sl@0 | 986 |
} 27 |
| sl@0 | 987 |
test if-8.2 {if cmd with computed command names: "if" command result} {
|
| sl@0 | 988 |
set z if |
| sl@0 | 989 |
set a {}
|
| sl@0 | 990 |
set a [$z 3>4 {set i 27}]
|
| sl@0 | 991 |
set a |
| sl@0 | 992 |
} {}
|
| sl@0 | 993 |
test if-8.3 {if cmd with computed command names: "if" command result} {
|
| sl@0 | 994 |
set z if |
| sl@0 | 995 |
set a {}
|
| sl@0 | 996 |
set a [$z 0 {set i 1} elseif 1 {set i 2}]
|
| sl@0 | 997 |
set a |
| sl@0 | 998 |
} 2 |
| sl@0 | 999 |
test if-8.4 {if cmd with computed command names: "if" command result} {
|
| sl@0 | 1000 |
set z if |
| sl@0 | 1001 |
set a {}
|
| sl@0 | 1002 |
set a [$z 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}]
|
| sl@0 | 1003 |
set a |
| sl@0 | 1004 |
} 4 |
| sl@0 | 1005 |
test if-8.5 {if cmd with computed command names: return value} {
|
| sl@0 | 1006 |
set z if |
| sl@0 | 1007 |
$z 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
|
| sl@0 | 1008 |
} def |
| sl@0 | 1009 |
|
| sl@0 | 1010 |
test if-9.1 {if cmd with namespace qualifiers} {
|
| sl@0 | 1011 |
::if {1} {set x 4}
|
| sl@0 | 1012 |
} 4 |
| sl@0 | 1013 |
|
| sl@0 | 1014 |
# Test for incorrect "double evaluation semantics" |
| sl@0 | 1015 |
|
| sl@0 | 1016 |
test if-10.1 {delayed substitution of then body} {
|
| sl@0 | 1017 |
set j 0 |
| sl@0 | 1018 |
set if if |
| sl@0 | 1019 |
# this is not compiled |
| sl@0 | 1020 |
$if {[incr j] == 1} "
|
| sl@0 | 1021 |
set result $j |
| sl@0 | 1022 |
" |
| sl@0 | 1023 |
# this will be compiled |
| sl@0 | 1024 |
proc p {} {
|
| sl@0 | 1025 |
set j 0 |
| sl@0 | 1026 |
if {[incr j]} "
|
| sl@0 | 1027 |
set result $j |
| sl@0 | 1028 |
" |
| sl@0 | 1029 |
set result |
| sl@0 | 1030 |
} |
| sl@0 | 1031 |
append result [p] |
| sl@0 | 1032 |
} {00}
|
| sl@0 | 1033 |
test if-10.2 {delayed substitution of elseif expression} {
|
| sl@0 | 1034 |
set j 0 |
| sl@0 | 1035 |
set if if |
| sl@0 | 1036 |
# this is not compiled |
| sl@0 | 1037 |
$if {[incr j] == 0} {
|
| sl@0 | 1038 |
set result badthen |
| sl@0 | 1039 |
} elseif "$j == 1" {
|
| sl@0 | 1040 |
set result badelseif |
| sl@0 | 1041 |
} else {
|
| sl@0 | 1042 |
set result 0 |
| sl@0 | 1043 |
} |
| sl@0 | 1044 |
# this will be compiled |
| sl@0 | 1045 |
proc p {} {
|
| sl@0 | 1046 |
set j 0 |
| sl@0 | 1047 |
if {[incr j] == 0} {
|
| sl@0 | 1048 |
set result badthen |
| sl@0 | 1049 |
} elseif "$j == 1" {
|
| sl@0 | 1050 |
set result badelseif |
| sl@0 | 1051 |
} else {
|
| sl@0 | 1052 |
set result 0 |
| sl@0 | 1053 |
} |
| sl@0 | 1054 |
set result |
| sl@0 | 1055 |
} |
| sl@0 | 1056 |
append result [p] |
| sl@0 | 1057 |
} {00}
|
| sl@0 | 1058 |
test if-10.3 {delayed substitution of elseif body} {
|
| sl@0 | 1059 |
set j 0 |
| sl@0 | 1060 |
set if if |
| sl@0 | 1061 |
# this is not compiled |
| sl@0 | 1062 |
$if {[incr j] == 0} {
|
| sl@0 | 1063 |
set result badthen |
| sl@0 | 1064 |
} elseif {1} "
|
| sl@0 | 1065 |
set result $j |
| sl@0 | 1066 |
" |
| sl@0 | 1067 |
# this will be compiled |
| sl@0 | 1068 |
proc p {} {
|
| sl@0 | 1069 |
set j 0 |
| sl@0 | 1070 |
if {[incr j] == 0} {
|
| sl@0 | 1071 |
set result badthen |
| sl@0 | 1072 |
} elseif {1} "
|
| sl@0 | 1073 |
set result $j |
| sl@0 | 1074 |
" |
| sl@0 | 1075 |
} |
| sl@0 | 1076 |
append result [p] |
| sl@0 | 1077 |
} {00}
|
| sl@0 | 1078 |
test if-10.4 {delayed substitution of else body} {
|
| sl@0 | 1079 |
set j 0 |
| sl@0 | 1080 |
if {[incr j] == 0} {
|
| sl@0 | 1081 |
set result badthen |
| sl@0 | 1082 |
} else " |
| sl@0 | 1083 |
set result $j |
| sl@0 | 1084 |
" |
| sl@0 | 1085 |
set result |
| sl@0 | 1086 |
} {0}
|
| sl@0 | 1087 |
test if-10.5 {substituted control words} {
|
| sl@0 | 1088 |
set then then; proc then {} {return badthen}
|
| sl@0 | 1089 |
set else else; proc else {} {return badelse}
|
| sl@0 | 1090 |
set elseif elseif; proc elseif {} {return badelseif}
|
| sl@0 | 1091 |
list [catch {if 1 $then {if 0 {} $elseif 1 {if 0 {} $else {list ok}}}} a] $a
|
| sl@0 | 1092 |
} {0 ok}
|
| sl@0 | 1093 |
test if-10.6 {double invocation of variable traces} {
|
| sl@0 | 1094 |
set iftracecounter 0 |
| sl@0 | 1095 |
proc iftraceproc {args} {
|
| sl@0 | 1096 |
upvar #0 iftracecounter counter |
| sl@0 | 1097 |
set argc [llength $args] |
| sl@0 | 1098 |
set extraargs [lrange $args 0 [expr {$argc - 4}]]
|
| sl@0 | 1099 |
set name [lindex $args [expr {$argc - 3}]]
|
| sl@0 | 1100 |
upvar 1 $name var |
| sl@0 | 1101 |
if {[incr counter] % 2 == 1} {
|
| sl@0 | 1102 |
set var "$counter oops [concat $extraargs]" |
| sl@0 | 1103 |
} else {
|
| sl@0 | 1104 |
set var "$counter + [concat $extraargs]" |
| sl@0 | 1105 |
} |
| sl@0 | 1106 |
} |
| sl@0 | 1107 |
trace variable iftracevar r [list iftraceproc 10] |
| sl@0 | 1108 |
list [catch {if "$iftracevar + 20" {}} a] $a \
|
| sl@0 | 1109 |
[catch {if "$iftracevar + 20" {}} b] $b \
|
| sl@0 | 1110 |
[unset iftracevar iftracecounter] |
| sl@0 | 1111 |
} {1 {syntax error in expression "1 oops 10 + 20": extra tokens at end of expression} 0 {} {}}
|
| sl@0 | 1112 |
|
| sl@0 | 1113 |
# cleanup |
| sl@0 | 1114 |
::tcltest::cleanupTests |
| sl@0 | 1115 |
return |