# Commands covered: while # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: while.test,v 1.1.1.1 2007/07/10 15:04:24 duncan Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # Basic "while" operation. catch {unset i} catch {unset a} test while-1.1 {TclCompileWhileCmd: missing test expression} { catch {while } msg set msg } {wrong # args: should be "while test command"} test while-1.2 {TclCompileWhileCmd: error in test expression} { set i 0 catch {while {$i<} break} msg set errorInfo } {syntax error in expression "$i<": premature end of expression ("while" test expression) while compiling "while {$i<} break"} test while-1.3 {TclCompileWhileCmd: error in test expression} { set err [catch {while {"a"+"b"} {error "loop aborted"}} msg] list $err $msg } {1 {can't use non-numeric string as operand of "+"}} test while-1.4 {TclCompileWhileCmd: multiline test expr} { set value 1 while {($tcl_platform(platform) != "foobar1") && \ ($tcl_platform(platform) != "foobar2")} { incr value break } set value } {2} test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} { set value 1 while {"true"} { incr value; if {$value > 5} { break; } } set value } 6 test while-1.6 {TclCompileWhileCmd: test expr is enclosed in quotes} { set i 0 while "$i > 5" {} } {} test while-1.7 {TclCompileWhileCmd: missing command body} { set i 0 catch {while {$i < 5} } msg set msg } {wrong # args: should be "while test command"} test while-1.8 {TclCompileWhileCmd: error compiling command body} { set i 0 catch {while {$i < 5} {set}} msg set errorInfo } {wrong # args: should be "set varName ?newValue?" while compiling "set" ("while" body line 1) while compiling "while {$i < 5} {set}"} test while-1.9 {TclCompileWhileCmd: simple command body} { set a {} set i 1 while {$i<6} { if $i==4 break set a [concat $a $i] incr i } set a } {1 2 3} test while-1.10 {TclCompileWhileCmd: command body in quotes} { set a {} set i 1 while {$i<6} "append a x; incr i" set a } {xxxxx} test while-1.11 {TclCompileWhileCmd: computed command body} { catch {unset x1} catch {unset bb} catch {unset x2} set x1 {append a x1; } set bb {break} set x2 {; append a x2; incr i} set a {} set i 1 while {$i<6} $x1$bb$x2 set a } {x1} test while-1.12 {TclCompileWhileCmd: long command body} { set a {} set i 1 while {$i<6} { if $i==4 break if $i>5 continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] incr i } set a } {1 2 3} test while-1.13 {TclCompileWhileCmd: while command result} { set i 0 set a [while {$i < 5} {incr i}] set a } {} test while-1.14 {TclCompileWhileCmd: while command result} { set i 0 set a [while {$i < 5} {if $i==3 break; incr i}] set a } {} # Check "while" and "continue". test while-2.1 {continue tests} { set a {} set i 1 while {$i <= 4} { incr i if {$i == 3} continue set a [concat $a $i] } set a } {2 4 5} test while-2.2 {continue tests} { set a {} set i 1 while {$i <= 4} { incr i if {$i != 2} continue set a [concat $a $i] } set a } {2} test while-2.3 {continue tests, nested loops} { set msg {} set i 1 while {$i <= 4} { incr i set a 1 while {$a <= 2} { incr a if {$i>=3 && $a>=3} continue set msg [concat $msg "$i.$a"] } } set msg } {2.2 2.3 3.2 4.2 5.2} test while-2.4 {continue tests, long command body} { set a {} set i 1 while {$i<6} { if $i==2 {incr i; continue} if $i==4 break if $i>5 continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] incr i } set a } {1 3} # Check "while" and "break". test while-3.1 {break tests} { set a {} set i 1 while {$i <= 4} { if {$i == 3} break set a [concat $a $i] incr i } set a } {1 2} test while-3.2 {break tests, nested loops} { set msg {} set i 1 while {$i <= 4} { set a 1 while {$a <= 2} { if {$i>=2 && $a>=2} break set msg [concat $msg "$i.$a"] incr a } incr i } set msg } {1.1 1.2 2.1 3.1 4.1} test while-3.3 {break tests, long command body} { set a {} set i 1 while {$i<6} { if $i==2 {incr i; continue} if $i==5 break if $i>5 continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if $i==4 break if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] incr i } set a } {1 3} # Check "while" with computed command names. test while-4.1 {while and computed command names} { set i 0 set z while $z {$i < 10} { incr i } set i } 10 test while-4.2 {while (not compiled): missing test expression} { set z while catch {$z } msg set msg } {wrong # args: should be "while test command"} test while-4.3 {while (not compiled): error in test expression} { set i 0 set z while catch {$z {$i<} {set x 1}} msg set errorInfo } {syntax error in expression "$i<": premature end of expression while executing "$z {$i<} {set x 1}"} test while-4.4 {while (not compiled): error in test expression} { set z while set err [catch {$z {"a"+"b"} {error "loop aborted"}} msg] list $err $msg } {1 {can't use non-numeric string as operand of "+"}} test while-4.5 {while (not compiled): multiline test expr} { set value 1 set z while $z {($tcl_platform(platform) != "foobar1") && \ ($tcl_platform(platform) != "foobar2")} { incr value break } set value } {2} test while-4.6 {while (not compiled): non-numeric boolean test expr} { set value 1 set z while $z {"true"} { incr value; if {$value > 5} { break; } } set value } 6 test while-4.7 {while (not compiled): test expr is enclosed in quotes} { set i 0 set z while $z "$i > 5" {} } {} test while-4.8 {while (not compiled): missing command body} { set i 0 set z while catch {$z {$i < 5} } msg set msg } {wrong # args: should be "while test command"} test while-4.9 {while (not compiled): error compiling command body} { set i 0 set z while catch {$z {$i < 5} {set}} msg set errorInfo } {wrong # args: should be "set varName ?newValue?" while compiling "set" ("while" body line 1) invoked from within "$z {$i < 5} {set}"} test while-4.10 {while (not compiled): simple command body} { set a {} set i 1 set z while $z {$i<6} { if $i==4 break set a [concat $a $i] incr i } set a } {1 2 3} test while-4.11 {while (not compiled): command body in quotes} { set a {} set i 1 set z while $z {$i<6} "append a x; incr i" set a } {xxxxx} test while-4.12 {while (not compiled): computed command body} { set z while catch {unset x1} catch {unset bb} catch {unset x2} set x1 {append a x1; } set bb {break} set x2 {; append a x2; incr i} set a {} set i 1 $z {$i<6} $x1$bb$x2 set a } {x1} test while-4.13 {while (not compiled): long command body} { set a {} set z while set i 1 $z {$i<6} { if $i==4 break if $i>5 continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] incr i } set a } {1 2 3} test while-4.14 {while (not compiled): while command result} { set i 0 set z while set a [$z {$i < 5} {incr i}] set a } {} test while-4.15 {while (not compiled): while command result} { set i 0 set z while set a [$z {$i < 5} {if $i==3 break; incr i}] set a } {} # Check "break" with computed command names. test while-5.1 {break and computed command names} { set i 0 set z break while 1 { if {$i > 10} $z incr i } set i } 11 test while-5.2 {break tests with computed command names} { set a {} set i 1 set z break while {$i <= 4} { if {$i == 3} $z set a [concat $a $i] incr i } set a } {1 2} test while-5.3 {break tests, nested loops with computed command names} { set msg {} set i 1 set z break while {$i <= 4} { set a 1 while {$a <= 2} { if {$i>=2 && $a>=2} $z set msg [concat $msg "$i.$a"] incr a } incr i } set msg } {1.1 1.2 2.1 3.1 4.1} test while-5.4 {break tests, long command body with computed command names} { set a {} set i 1 set z break while {$i<6} { if $i==2 {incr i; continue} if $i==5 $z if $i>5 continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if $i==4 $z if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] incr i } set a } {1 3} # Check "continue" with computed command names. test while-6.1 {continue and computed command names} { set i 0 set z continue while 1 { incr i if {$i < 10} $z break } set i } 10 test while-6.2 {continue tests} { set a {} set i 1 set z continue while {$i <= 4} { incr i if {$i == 3} $z set a [concat $a $i] } set a } {2 4 5} test while-6.3 {continue tests with computed command names} { set a {} set i 1 set z continue while {$i <= 4} { incr i if {$i != 2} $z set a [concat $a $i] } set a } {2} test while-6.4 {continue tests, nested loops with computed command names} { set msg {} set i 1 set z continue while {$i <= 4} { incr i set a 1 while {$a <= 2} { incr a if {$i>=3 && $a>=3} $z set msg [concat $msg "$i.$a"] } } set msg } {2.2 2.3 3.2 4.2 5.2} test while-6.5 {continue tests, long command body with computed command names} { set a {} set i 1 set z continue while {$i<6} { if $i==2 {incr i; continue} if $i==4 break if $i>5 $z if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } set a [concat $a $i] incr i } set a } {1 3} # Test for incorrect "double evaluation" semantics test while-7.1 {delayed substitution of body} { set i 0 while {[incr i] < 10} " set result $i " proc p {} { set i 0 while {[incr i] < 10} " set result $i " set result } append result [p] } {00} # cleanup ::tcltest::cleanupTests return