os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/while.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/while.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,629 @@
1.4 +# Commands covered: while
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: while.test,v 1.8 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 "while" operation.
1.24 +
1.25 +catch {unset i}
1.26 +catch {unset a}
1.27 +
1.28 +test while-1.1 {TclCompileWhileCmd: missing test expression} {
1.29 + catch {while } msg
1.30 + set msg
1.31 +} {wrong # args: should be "while test command"}
1.32 +test while-1.2 {TclCompileWhileCmd: error in test expression} {
1.33 + set i 0
1.34 + catch {while {$i<} break} msg
1.35 + set errorInfo
1.36 +} {syntax error in expression "$i<": premature end of expression
1.37 + ("while" test expression)
1.38 + while compiling
1.39 +"while {$i<} break"}
1.40 +test while-1.3 {TclCompileWhileCmd: error in test expression} {
1.41 + set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
1.42 + list $err $msg
1.43 +} {1 {can't use non-numeric string as operand of "+"}}
1.44 +test while-1.4 {TclCompileWhileCmd: multiline test expr} {
1.45 + set value 1
1.46 + while {($tcl_platform(platform) != "foobar1") && \
1.47 + ($tcl_platform(platform) != "foobar2")} {
1.48 + incr value
1.49 + break
1.50 + }
1.51 + set value
1.52 +} {2}
1.53 +test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} {
1.54 + set value 1
1.55 + while {"true"} {
1.56 + incr value;
1.57 + if {$value > 5} {
1.58 + break;
1.59 + }
1.60 + }
1.61 + set value
1.62 +} 6
1.63 +test while-1.6 {TclCompileWhileCmd: test expr is enclosed in quotes} {
1.64 + set i 0
1.65 + while "$i > 5" {}
1.66 +} {}
1.67 +test while-1.7 {TclCompileWhileCmd: missing command body} {
1.68 + set i 0
1.69 + catch {while {$i < 5} } msg
1.70 + set msg
1.71 +} {wrong # args: should be "while test command"}
1.72 +test while-1.8 {TclCompileWhileCmd: error compiling command body} {
1.73 + set i 0
1.74 + catch {while {$i < 5} {set}} msg
1.75 + set errorInfo
1.76 +} {wrong # args: should be "set varName ?newValue?"
1.77 + while compiling
1.78 +"set"
1.79 + ("while" body line 1)
1.80 + while compiling
1.81 +"while {$i < 5} {set}"}
1.82 +test while-1.9 {TclCompileWhileCmd: simple command body} {
1.83 + set a {}
1.84 + set i 1
1.85 + while {$i<6} {
1.86 + if $i==4 break
1.87 + set a [concat $a $i]
1.88 + incr i
1.89 + }
1.90 + set a
1.91 +} {1 2 3}
1.92 +test while-1.10 {TclCompileWhileCmd: command body in quotes} {
1.93 + set a {}
1.94 + set i 1
1.95 + while {$i<6} "append a x; incr i"
1.96 + set a
1.97 +} {xxxxx}
1.98 +test while-1.11 {TclCompileWhileCmd: computed command body} {
1.99 + catch {unset x1}
1.100 + catch {unset bb}
1.101 + catch {unset x2}
1.102 + set x1 {append a x1; }
1.103 + set bb {break}
1.104 + set x2 {; append a x2; incr i}
1.105 + set a {}
1.106 + set i 1
1.107 + while {$i<6} $x1$bb$x2
1.108 + set a
1.109 +} {x1}
1.110 +test while-1.12 {TclCompileWhileCmd: long command body} {
1.111 + set a {}
1.112 + set i 1
1.113 + while {$i<6} {
1.114 + if $i==4 break
1.115 + if $i>5 continue
1.116 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.117 + catch {set a $a} msg
1.118 + catch {incr i 5} msg
1.119 + catch {incr i -5} msg
1.120 + }
1.121 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.122 + catch {set a $a} msg
1.123 + catch {incr i 5} msg
1.124 + catch {incr i -5} msg
1.125 + }
1.126 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.127 + catch {set a $a} msg
1.128 + catch {incr i 5} msg
1.129 + catch {incr i -5} msg
1.130 + }
1.131 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.132 + catch {set a $a} msg
1.133 + catch {incr i 5} msg
1.134 + catch {incr i -5} msg
1.135 + }
1.136 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.137 + catch {set a $a} msg
1.138 + catch {incr i 5} msg
1.139 + catch {incr i -5} msg
1.140 + }
1.141 + set a [concat $a $i]
1.142 + incr i
1.143 + }
1.144 + set a
1.145 +} {1 2 3}
1.146 +test while-1.13 {TclCompileWhileCmd: while command result} {
1.147 + set i 0
1.148 + set a [while {$i < 5} {incr i}]
1.149 + set a
1.150 +} {}
1.151 +test while-1.14 {TclCompileWhileCmd: while command result} {
1.152 + set i 0
1.153 + set a [while {$i < 5} {if $i==3 break; incr i}]
1.154 + set a
1.155 +} {}
1.156 +
1.157 +# Check "while" and "continue".
1.158 +
1.159 +test while-2.1 {continue tests} {
1.160 + set a {}
1.161 + set i 1
1.162 + while {$i <= 4} {
1.163 + incr i
1.164 + if {$i == 3} continue
1.165 + set a [concat $a $i]
1.166 + }
1.167 + set a
1.168 +} {2 4 5}
1.169 +test while-2.2 {continue tests} {
1.170 + set a {}
1.171 + set i 1
1.172 + while {$i <= 4} {
1.173 + incr i
1.174 + if {$i != 2} continue
1.175 + set a [concat $a $i]
1.176 + }
1.177 + set a
1.178 +} {2}
1.179 +test while-2.3 {continue tests, nested loops} {
1.180 + set msg {}
1.181 + set i 1
1.182 + while {$i <= 4} {
1.183 + incr i
1.184 + set a 1
1.185 + while {$a <= 2} {
1.186 + incr a
1.187 + if {$i>=3 && $a>=3} continue
1.188 + set msg [concat $msg "$i.$a"]
1.189 + }
1.190 + }
1.191 + set msg
1.192 +} {2.2 2.3 3.2 4.2 5.2}
1.193 +test while-2.4 {continue tests, long command body} {
1.194 + set a {}
1.195 + set i 1
1.196 + while {$i<6} {
1.197 + if $i==2 {incr i; continue}
1.198 + if $i==4 break
1.199 + if $i>5 continue
1.200 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.201 + catch {set a $a} msg
1.202 + catch {incr i 5} msg
1.203 + catch {incr i -5} msg
1.204 + }
1.205 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.206 + catch {set a $a} msg
1.207 + catch {incr i 5} msg
1.208 + catch {incr i -5} msg
1.209 + }
1.210 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.211 + catch {set a $a} msg
1.212 + catch {incr i 5} msg
1.213 + catch {incr i -5} msg
1.214 + }
1.215 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.216 + catch {set a $a} msg
1.217 + catch {incr i 5} msg
1.218 + catch {incr i -5} msg
1.219 + }
1.220 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.221 + catch {set a $a} msg
1.222 + catch {incr i 5} msg
1.223 + catch {incr i -5} msg
1.224 + }
1.225 + set a [concat $a $i]
1.226 + incr i
1.227 + }
1.228 + set a
1.229 +} {1 3}
1.230 +
1.231 +# Check "while" and "break".
1.232 +
1.233 +test while-3.1 {break tests} {
1.234 + set a {}
1.235 + set i 1
1.236 + while {$i <= 4} {
1.237 + if {$i == 3} break
1.238 + set a [concat $a $i]
1.239 + incr i
1.240 + }
1.241 + set a
1.242 +} {1 2}
1.243 +test while-3.2 {break tests, nested loops} {
1.244 + set msg {}
1.245 + set i 1
1.246 + while {$i <= 4} {
1.247 + set a 1
1.248 + while {$a <= 2} {
1.249 + if {$i>=2 && $a>=2} break
1.250 + set msg [concat $msg "$i.$a"]
1.251 + incr a
1.252 + }
1.253 + incr i
1.254 + }
1.255 + set msg
1.256 +} {1.1 1.2 2.1 3.1 4.1}
1.257 +test while-3.3 {break tests, long command body} {
1.258 + set a {}
1.259 + set i 1
1.260 + while {$i<6} {
1.261 + if $i==2 {incr i; continue}
1.262 + if $i==5 break
1.263 + if $i>5 continue
1.264 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.265 + catch {set a $a} msg
1.266 + catch {incr i 5} msg
1.267 + catch {incr i -5} msg
1.268 + }
1.269 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.270 + catch {set a $a} msg
1.271 + catch {incr i 5} msg
1.272 + catch {incr i -5} msg
1.273 + }
1.274 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.275 + catch {set a $a} msg
1.276 + catch {incr i 5} msg
1.277 + catch {incr i -5} msg
1.278 + }
1.279 + if $i==4 break
1.280 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.281 + catch {set a $a} msg
1.282 + catch {incr i 5} msg
1.283 + catch {incr i -5} msg
1.284 + }
1.285 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.286 + catch {set a $a} msg
1.287 + catch {incr i 5} msg
1.288 + catch {incr i -5} msg
1.289 + }
1.290 + set a [concat $a $i]
1.291 + incr i
1.292 + }
1.293 + set a
1.294 +} {1 3}
1.295 +
1.296 +# Check "while" with computed command names.
1.297 +
1.298 +test while-4.1 {while and computed command names} {
1.299 + set i 0
1.300 + set z while
1.301 + $z {$i < 10} {
1.302 + incr i
1.303 + }
1.304 + set i
1.305 +} 10
1.306 +test while-4.2 {while (not compiled): missing test expression} {
1.307 + set z while
1.308 + catch {$z } msg
1.309 + set msg
1.310 +} {wrong # args: should be "while test command"}
1.311 +test while-4.3 {while (not compiled): error in test expression} {
1.312 + set i 0
1.313 + set z while
1.314 + catch {$z {$i<} {set x 1}} msg
1.315 + set errorInfo
1.316 +} {syntax error in expression "$i<": premature end of expression
1.317 + while executing
1.318 +"$z {$i<} {set x 1}"}
1.319 +test while-4.4 {while (not compiled): error in test expression} {
1.320 + set z while
1.321 + set err [catch {$z {"a"+"b"} {error "loop aborted"}} msg]
1.322 + list $err $msg
1.323 +} {1 {can't use non-numeric string as operand of "+"}}
1.324 +test while-4.5 {while (not compiled): multiline test expr} {
1.325 + set value 1
1.326 + set z while
1.327 + $z {($tcl_platform(platform) != "foobar1") && \
1.328 + ($tcl_platform(platform) != "foobar2")} {
1.329 + incr value
1.330 + break
1.331 + }
1.332 + set value
1.333 +} {2}
1.334 +test while-4.6 {while (not compiled): non-numeric boolean test expr} {
1.335 + set value 1
1.336 + set z while
1.337 + $z {"true"} {
1.338 + incr value;
1.339 + if {$value > 5} {
1.340 + break;
1.341 + }
1.342 + }
1.343 + set value
1.344 +} 6
1.345 +test while-4.7 {while (not compiled): test expr is enclosed in quotes} {
1.346 + set i 0
1.347 + set z while
1.348 + $z "$i > 5" {}
1.349 +} {}
1.350 +test while-4.8 {while (not compiled): missing command body} {
1.351 + set i 0
1.352 + set z while
1.353 + catch {$z {$i < 5} } msg
1.354 + set msg
1.355 +} {wrong # args: should be "while test command"}
1.356 +test while-4.9 {while (not compiled): error compiling command body} {
1.357 + set i 0
1.358 + set z while
1.359 + catch {$z {$i < 5} {set}} msg
1.360 + set errorInfo
1.361 +} {wrong # args: should be "set varName ?newValue?"
1.362 + while compiling
1.363 +"set"
1.364 + ("while" body line 1)
1.365 + invoked from within
1.366 +"$z {$i < 5} {set}"}
1.367 +test while-4.10 {while (not compiled): simple command body} {
1.368 + set a {}
1.369 + set i 1
1.370 + set z while
1.371 + $z {$i<6} {
1.372 + if $i==4 break
1.373 + set a [concat $a $i]
1.374 + incr i
1.375 + }
1.376 + set a
1.377 +} {1 2 3}
1.378 +test while-4.11 {while (not compiled): command body in quotes} {
1.379 + set a {}
1.380 + set i 1
1.381 + set z while
1.382 + $z {$i<6} "append a x; incr i"
1.383 + set a
1.384 +} {xxxxx}
1.385 +test while-4.12 {while (not compiled): computed command body} {
1.386 + set z while
1.387 + catch {unset x1}
1.388 + catch {unset bb}
1.389 + catch {unset x2}
1.390 + set x1 {append a x1; }
1.391 + set bb {break}
1.392 + set x2 {; append a x2; incr i}
1.393 + set a {}
1.394 + set i 1
1.395 + $z {$i<6} $x1$bb$x2
1.396 + set a
1.397 +} {x1}
1.398 +test while-4.13 {while (not compiled): long command body} {
1.399 + set a {}
1.400 + set z while
1.401 + set i 1
1.402 + $z {$i<6} {
1.403 + if $i==4 break
1.404 + if $i>5 continue
1.405 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.406 + catch {set a $a} msg
1.407 + catch {incr i 5} msg
1.408 + catch {incr i -5} msg
1.409 + }
1.410 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.411 + catch {set a $a} msg
1.412 + catch {incr i 5} msg
1.413 + catch {incr i -5} msg
1.414 + }
1.415 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.416 + catch {set a $a} msg
1.417 + catch {incr i 5} msg
1.418 + catch {incr i -5} msg
1.419 + }
1.420 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.421 + catch {set a $a} msg
1.422 + catch {incr i 5} msg
1.423 + catch {incr i -5} msg
1.424 + }
1.425 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.426 + catch {set a $a} msg
1.427 + catch {incr i 5} msg
1.428 + catch {incr i -5} msg
1.429 + }
1.430 + set a [concat $a $i]
1.431 + incr i
1.432 + }
1.433 + set a
1.434 +} {1 2 3}
1.435 +test while-4.14 {while (not compiled): while command result} {
1.436 + set i 0
1.437 + set z while
1.438 + set a [$z {$i < 5} {incr i}]
1.439 + set a
1.440 +} {}
1.441 +test while-4.15 {while (not compiled): while command result} {
1.442 + set i 0
1.443 + set z while
1.444 + set a [$z {$i < 5} {if $i==3 break; incr i}]
1.445 + set a
1.446 +} {}
1.447 +
1.448 +# Check "break" with computed command names.
1.449 +
1.450 +test while-5.1 {break and computed command names} {
1.451 + set i 0
1.452 + set z break
1.453 + while 1 {
1.454 + if {$i > 10} $z
1.455 + incr i
1.456 + }
1.457 + set i
1.458 +} 11
1.459 +test while-5.2 {break tests with computed command names} {
1.460 + set a {}
1.461 + set i 1
1.462 + set z break
1.463 + while {$i <= 4} {
1.464 + if {$i == 3} $z
1.465 + set a [concat $a $i]
1.466 + incr i
1.467 + }
1.468 + set a
1.469 +} {1 2}
1.470 +test while-5.3 {break tests, nested loops with computed command names} {
1.471 + set msg {}
1.472 + set i 1
1.473 + set z break
1.474 + while {$i <= 4} {
1.475 + set a 1
1.476 + while {$a <= 2} {
1.477 + if {$i>=2 && $a>=2} $z
1.478 + set msg [concat $msg "$i.$a"]
1.479 + incr a
1.480 + }
1.481 + incr i
1.482 + }
1.483 + set msg
1.484 +} {1.1 1.2 2.1 3.1 4.1}
1.485 +test while-5.4 {break tests, long command body with computed command names} {
1.486 + set a {}
1.487 + set i 1
1.488 + set z break
1.489 + while {$i<6} {
1.490 + if $i==2 {incr i; continue}
1.491 + if $i==5 $z
1.492 + if $i>5 continue
1.493 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.494 + catch {set a $a} msg
1.495 + catch {incr i 5} msg
1.496 + catch {incr i -5} msg
1.497 + }
1.498 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.499 + catch {set a $a} msg
1.500 + catch {incr i 5} msg
1.501 + catch {incr i -5} msg
1.502 + }
1.503 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.504 + catch {set a $a} msg
1.505 + catch {incr i 5} msg
1.506 + catch {incr i -5} msg
1.507 + }
1.508 + if $i==4 $z
1.509 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.510 + catch {set a $a} msg
1.511 + catch {incr i 5} msg
1.512 + catch {incr i -5} msg
1.513 + }
1.514 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.515 + catch {set a $a} msg
1.516 + catch {incr i 5} msg
1.517 + catch {incr i -5} msg
1.518 + }
1.519 + set a [concat $a $i]
1.520 + incr i
1.521 + }
1.522 + set a
1.523 +} {1 3}
1.524 +
1.525 +# Check "continue" with computed command names.
1.526 +
1.527 +test while-6.1 {continue and computed command names} {
1.528 + set i 0
1.529 + set z continue
1.530 + while 1 {
1.531 + incr i
1.532 + if {$i < 10} $z
1.533 + break
1.534 + }
1.535 + set i
1.536 +} 10
1.537 +test while-6.2 {continue tests} {
1.538 + set a {}
1.539 + set i 1
1.540 + set z continue
1.541 + while {$i <= 4} {
1.542 + incr i
1.543 + if {$i == 3} $z
1.544 + set a [concat $a $i]
1.545 + }
1.546 + set a
1.547 +} {2 4 5}
1.548 +test while-6.3 {continue tests with computed command names} {
1.549 + set a {}
1.550 + set i 1
1.551 + set z continue
1.552 + while {$i <= 4} {
1.553 + incr i
1.554 + if {$i != 2} $z
1.555 + set a [concat $a $i]
1.556 + }
1.557 + set a
1.558 +} {2}
1.559 +test while-6.4 {continue tests, nested loops with computed command names} {
1.560 + set msg {}
1.561 + set i 1
1.562 + set z continue
1.563 + while {$i <= 4} {
1.564 + incr i
1.565 + set a 1
1.566 + while {$a <= 2} {
1.567 + incr a
1.568 + if {$i>=3 && $a>=3} $z
1.569 + set msg [concat $msg "$i.$a"]
1.570 + }
1.571 + }
1.572 + set msg
1.573 +} {2.2 2.3 3.2 4.2 5.2}
1.574 +test while-6.5 {continue tests, long command body with computed command names} {
1.575 + set a {}
1.576 + set i 1
1.577 + set z continue
1.578 + while {$i<6} {
1.579 + if $i==2 {incr i; continue}
1.580 + if $i==4 break
1.581 + if $i>5 $z
1.582 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.583 + catch {set a $a} msg
1.584 + catch {incr i 5} msg
1.585 + catch {incr i -5} msg
1.586 + }
1.587 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.588 + catch {set a $a} msg
1.589 + catch {incr i 5} msg
1.590 + catch {incr i -5} msg
1.591 + }
1.592 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.593 + catch {set a $a} msg
1.594 + catch {incr i 5} msg
1.595 + catch {incr i -5} msg
1.596 + }
1.597 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.598 + catch {set a $a} msg
1.599 + catch {incr i 5} msg
1.600 + catch {incr i -5} msg
1.601 + }
1.602 + if {$i>6 && $tcl_platform(machine)=="xxx"} {
1.603 + catch {set a $a} msg
1.604 + catch {incr i 5} msg
1.605 + catch {incr i -5} msg
1.606 + }
1.607 + set a [concat $a $i]
1.608 + incr i
1.609 + }
1.610 + set a
1.611 +} {1 3}
1.612 +
1.613 +# Test for incorrect "double evaluation" semantics
1.614 +
1.615 +test while-7.1 {delayed substitution of body} {
1.616 + set i 0
1.617 + while {[incr i] < 10} "
1.618 + set result $i
1.619 + "
1.620 + proc p {} {
1.621 + set i 0
1.622 + while {[incr i] < 10} "
1.623 + set result $i
1.624 + "
1.625 + set result
1.626 + }
1.627 + append result [p]
1.628 +} {00}
1.629 +
1.630 +# cleanup
1.631 +::tcltest::cleanupTests
1.632 +return