summaryrefslogtreecommitdiffstats
path: root/tests/for.test
diff options
context:
space:
mode:
authorrjohnson <rjohnson>1998-03-26 14:56:55 (GMT)
committerrjohnson <rjohnson>1998-03-26 14:56:55 (GMT)
commit72d823b9193f9ee2b0318563b49363cd08c11f24 (patch)
treec168cc164a71f320db9dcdfe7518ba7bd0d2c8d9 /tests/for.test
parent2b5738da524e944cda39e24c0a87b745a43bd8c3 (diff)
downloadtcl-72d823b9193f9ee2b0318563b49363cd08c11f24.zip
tcl-72d823b9193f9ee2b0318563b49363cd08c11f24.tar.gz
tcl-72d823b9193f9ee2b0318563b49363cd08c11f24.tar.bz2
Initial revision
Diffstat (limited to 'tests/for.test')
-rw-r--r--tests/for.test592
1 files changed, 592 insertions, 0 deletions
diff --git a/tests/for.test b/tests/for.test
new file mode 100644
index 0000000..aa918ec
--- /dev/null
+++ b/tests/for.test
@@ -0,0 +1,592 @@
+# Commands covered: for, continue, break
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) for.test 1.10 97/07/02 16:40:59
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# Basic "for" operation.
+
+test for-1.1 {TclCompileForCmd: missing initial command} {
+ list [catch {for} msg] $msg
+} {1 {wrong # args: should be "for start test next command"}}
+test for-1.2 {TclCompileForCmd: error in initial command} {
+ list [catch {for {set}} msg] $msg $errorInfo
+} {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command"
+ while compiling
+"for {set}"}}
+catch {unset i}
+test for-1.3 {TclCompileForCmd: missing test expression} {
+ catch {for {set i 0}} msg
+ set msg
+} {wrong # args: should be "for start test next command"}
+test for-1.4 {TclCompileForCmd: error in test expression} {
+ catch {for {set i 0} {$i<}} msg
+ set errorInfo
+} {wrong # args: should be "for start test next command"
+ while compiling
+"for {set i 0} {$i<}"}
+test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
+ set i 0
+ for {} "$i > 5" {incr i} {}
+} {}
+test for-1.6 {TclCompileForCmd: missing "next" command} {
+ catch {for {set i 0} {$i < 5}} msg
+ set msg
+} {wrong # args: should be "for start test next command"}
+test for-1.7 {TclCompileForCmd: missing command body} {
+ catch {for {set i 0} {$i < 5} {incr i}} msg
+ set msg
+} {wrong # args: should be "for start test next command"}
+test for-1.8 {TclCompileForCmd: error compiling command body} {
+ catch {for {set i 0} {$i < 5} {incr i} {set}} msg
+ set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+ while compiling
+"set"
+ ("for" body line 1)
+ while compiling
+"for {set i 0} {$i < 5} {incr i} {set}"}
+catch {unset a}
+test for-1.9 {TclCompileForCmd: simple command body} {
+ set a {}
+ for {set i 1} {$i<6} {set i [expr $i+1]} {
+ if $i==4 break
+ set a [concat $a $i]
+ }
+ set a
+} {1 2 3}
+test for-1.10 {TclCompileForCmd: command body in quotes} {
+ set a {}
+ for {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
+ set a
+} {xxxxx}
+test for-1.11 {TclCompileForCmd: 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}
+ set a {}
+ for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
+ set a
+} {x1}
+test for-1.12 {TclCompileForCmd: error in "next" command} {
+ catch {for {set i 0} {$i < 5} {set} {puts $i}} msg
+ set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+ while compiling
+"set"
+ ("for" loop-end command)
+ while compiling
+"for {set i 0} {$i < 5} {set} {puts $i}"}
+test for-1.13 {TclCompileForCmd: long command body} {
+ set a {}
+ for {set i 1} {$i<6} {set i [expr $i+1]} {
+ 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]
+ }
+ set a
+} {1 2 3}
+test for-1.14 {TclCompileForCmd: for command result} {
+ set a [for {set i 0} {$i < 5} {incr i} {}]
+ set a
+} {}
+test for-1.15 {TclCompileForCmd: for command result} {
+ set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}]
+ set a
+} {}
+
+# Check "for" and "continue".
+
+test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
+ catch {continue foo} msg
+ set msg
+} {wrong # args: should be "continue"}
+test for-2.2 {TclCompileContinueCmd: continue result} {
+ catch continue
+} 4
+test for-2.3 {continue tests} {
+ set a {}
+ for {set i 1} {$i <= 4} {set i [expr $i+1]} {
+ if {$i == 2} continue
+ set a [concat $a $i]
+ }
+ set a
+} {1 3 4}
+test for-2.4 {continue tests} {
+ set a {}
+ for {set i 1} {$i <= 4} {set i [expr $i+1]} {
+ if {$i != 2} continue
+ set a [concat $a $i]
+ }
+ set a
+} {2}
+test for-2.5 {continue tests, nested loops} {
+ set msg {}
+ for {set i 1} {$i <= 4} {incr i} {
+ for {set a 1} {$a <= 2} {incr a} {
+ if {$i>=2 && $a>=2} continue
+ set msg [concat $msg "$i.$a"]
+ }
+ }
+ set msg
+} {1.1 1.2 2.1 3.1 4.1}
+test for-2.6 {continue tests, long command body} {
+ set a {}
+ for {set i 1} {$i<6} {set i [expr $i+1]} {
+ if $i==2 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]
+ }
+ set a
+} {1 3}
+
+# Check "for" and "break".
+
+test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
+ catch {break foo} msg
+ set msg
+} {wrong # args: should be "break"}
+test for-3.2 {TclCompileBreakCmd: break result} {
+ catch break
+} 3
+test for-3.3 {break tests} {
+ set a {}
+ for {set i 1} {$i <= 4} {incr i} {
+ if {$i == 3} break
+ set a [concat $a $i]
+ }
+ set a
+} {1 2}
+test for-3.4 {break tests, nested loops} {
+ set msg {}
+ for {set i 1} {$i <= 4} {incr i} {
+ for {set a 1} {$a <= 2} {incr a} {
+ if {$i>=2 && $a>=2} break
+ set msg [concat $msg "$i.$a"]
+ }
+ }
+ set msg
+} {1.1 1.2 2.1 3.1 4.1}
+test for-3.5 {break tests, long command body} {
+ set a {}
+ for {set i 1} {$i<6} {set i [expr $i+1]} {
+ if $i==2 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]
+ }
+ set a
+} {1 3}
+# A simplified version of exmh's mail formatting routine to stress "for",
+# "break", "while", and "if".
+proc formatMail {} {
+ array set lines {
+ 0 {Return-path: george@tcl} \
+ 1 {Return-path: <george@tcl>} \
+ 2 {Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)} \
+ 3 { id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700} \
+ 4 {Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>} \
+ 5 {X-mailer: exmh version 1.6.9 8/22/96} \
+ 6 {Mime-version: 1.0} \
+ 7 {Content-type: text/plain; charset=iso-8859-1} \
+ 8 {Content-transfer-encoding: quoted-printable} \
+ 9 {Content-length: 2162} \
+ 10 {To: fred} \
+ 11 {Subject: tcl7.6} \
+ 12 {Date: Wed, 11 Sep 1996 11:14:53 -0700} \
+ 13 {From: George <george@tcl>} \
+ 14 {The Tcl 7.6 and Tk 4.2 releases} \
+ 15 {} \
+ 16 {This page contains information about Tcl 7.6 and Tk4.2, which are the most recent} \
+ 17 {releases of the Tcl scripting language and the Tk toolkit. The first beta versions of these} \
+ 18 {releases were released on August 30, 1996. These releases contain only minor changes,} \
+ 19 {so we hope to have only a single beta release and to go final in early October, 1996. } \
+ 20 {} \
+ 21 {} \
+ 22 {What's new } \
+ 23 {} \
+ 24 {The most important changes in the releases are summarized below. See the README} \
+ 25 {and changes files in the distributions for more complete information on what has} \
+ 26 {changed, including both feature changes and bug fixes. } \
+ 27 {} \
+ 28 { There are new options to the file command for copying files (file copy),} \
+ 29 { deleting files and directories (file delete), creating directories (file} \
+ 30 { mkdir), and renaming files (file rename). } \
+ 31 { The implementation of exec has been improved greatly for Windows 95 and} \
+ 32 { Windows NT. } \
+ 33 { There is a new memory allocator for the Macintosh version, which should be} \
+ 34 { more efficient than the old one. } \
+ 35 { Tk's grid geometry manager has been completely rewritten. The layout} \
+ 36 { algorithm produces much better layouts than before, especially where rows or} \
+ 37 { columns were stretchable. } \
+ 38 { There are new commands for creating common dialog boxes:} \
+ 39 { tk_chooseColor, tk_getOpenFile, tk_getSaveFile and} \
+ 40 { tk_messageBox. These use native dialog boxes if they are available. } \
+ 41 { There is a new virtual event mechanism for handling events in a more portable} \
+ 42 { way. See the new command event. It also allows events (both physical and} \
+ 43 { virtual) to be generated dynamically. } \
+ 44 {} \
+ 45 {Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for} \
+ 46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \
+ 47 {should work on these new releases as well. } \
+ 48 {} \
+ 49 {Obtaining The Releases} \
+ 50 {} \
+ 51 {Binary Releases} \
+ 52 {} \
+ 53 {Pre-compiled releases are available for the following platforms: } \
+ 54 {} \
+ 55 { Windows 3.1, Windows 95, and Windows NT: Fetch} \
+ 56 { ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \
+ 57 { self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \
+ 58 { tclsh programs, and documentation. } \
+ 59 { Macintosh (both 68K and PowerPC): Fetch} \
+ 60 { ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \
+ 61 { which is understood by Fetch, StuffIt, and many other Mac utilities. The} \
+ 62 { unpacked file is a self-installing executable: double-click on it and it will create a} \
+ 63 { folder containing all that you need to run Tcl and Tk. } \
+ 64 { UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \
+ 65 { binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \
+ }
+
+ set result ""
+ set NL "
+"
+ set tag {level= type=text/plain part=0 sel Charset}
+ set ix [lsearch -regexp $tag text/enriched]
+ if {$ix < 0} {
+ set ranges {}
+ set quote 0
+ }
+ set breakrange {6.42 78.0}
+ set F1 [lindex $breakrange 0]
+ set F2 [lindex $breakrange 1]
+ set breakrange [lrange $breakrange 2 end]
+ if {[string length $F1] == 0} {
+ set F1 -1
+ set break 0
+ } else {
+ set break 1
+ }
+
+ set xmailer 0
+ set inheaders 1
+ set last [array size lines]
+ set plen 2
+ for {set L 1} {$L < $last} {incr L} {
+ set line $lines($L)
+ if {$inheaders} {
+ # Blank or empty line terminates headers
+ # Leading --- terminates headers
+ if {[regexp {^[ ]*$} $line] || [regexp {^--+} $line]} {
+ set inheaders 0
+ }
+ if {[regexp -nocase {^x-mailer:} $line]} {
+ continue
+ }
+ }
+ if $inheaders {
+ set limit 55
+ } else {
+ set limit 55
+
+ # Decide whether or not to break the body line
+
+ if {$plen > 0} {
+ if {[string first {> } $line] == 0} {
+ # This is quoted text from previous message, don't reformat
+ append result $line $NL
+ if {$quote && !$inheaders} {
+ # Fix from <sarr@umich.edu> to handle text/enriched
+ if {$L > $L1 && $L < $L2 && $line != {}} {
+ # enriched requires two newlines for each one.
+ append result $NL
+ } elseif {$L > $L2} {
+ set L1 [lindex $ranges 0]
+ set L2 [lindex $ranges 1]
+ set ranges [lrange $ranges 2 end]
+ set quote [llength $L1]
+ }
+ }
+ continue
+ }
+ }
+ if {$F1 < 0} {
+ # Nothing left to format
+ append result $line $NL
+ continue
+ } elseif {$L < $F1} {
+ # Not yet to formatted block
+ append result $line $NL
+ continue
+ } elseif {$L > $F2} {
+ # Past formatted block
+ set F1 [lindex $breakrange 0]
+ set F2 [lindex $breakrange 1]
+ set breakrange [lrange $breakrange 2 end]
+ append result $line $NL
+ if {[string length $F1] == 0} {
+ set F1 -1
+ }
+ continue
+ }
+ }
+ set climit [expr $limit-1]
+ set cutoff 50
+ set continuation 0
+
+ while {[string length $line] > $limit} {
+ for {set c [expr $limit-1]} {$c >= $cutoff} {incr c -1} {
+ set char [string index $line $c]
+ if {$char == " " || $char == "\t"} {
+ break
+ }
+ if {$char == ">"} { ;# Hack for enriched formatting
+ break
+ }
+ }
+ if {$c < $cutoff} {
+ if {! $inheaders} {
+ set c [expr $limit-1]
+ } else {
+ set c [string length $line]
+ }
+ }
+ set newline [string range $line 0 $c]
+ if {! $continuation} {
+ append result $newline $NL
+ } else {
+ append result \ $newline $NL
+ }
+ incr c
+ set line [string trimright [string range $line $c end]]
+ if {$inheaders} {
+ set continuation 1
+ set limit $climit
+ }
+ }
+ if {$continuation} {
+ if {[string length $line] != 0} {
+ append result \ $line $NL
+ }
+ } else {
+ append result $line $NL
+ if {$quote && !$inheaders} {
+ if {$L > $L1 && $L < $L2 && $line != {}} {
+ # enriched requires two newlines for each one.
+ append result "" $NL
+ } elseif {$L > $L2} {
+ set L1 [lindex $ranges 0]
+ set L2 [lindex $ranges 1]
+ set ranges [lrange $ranges 2 end]
+ set quote [llength $L1]
+ }
+ }
+ }
+ }
+ return $result
+}
+test for-3.6 {break tests} {
+ formatMail
+} {Return-path: <george@tcl>
+Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)
+ id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700
+Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>
+Mime-version: 1.0
+Content-type: text/plain; charset=iso-8859-1
+Content-transfer-encoding: quoted-printable
+Content-length: 2162
+To: fred
+Subject: tcl7.6
+Date: Wed, 11 Sep 1996 11:14:53 -0700
+From: George <george@tcl>
+The Tcl 7.6 and Tk 4.2 releases
+
+This page contains information about Tcl 7.6 and Tk4.2,
+ which are the most recent
+releases of the Tcl scripting language and the Tk toolk
+it. The first beta versions of these
+releases were released on August 30, 1996. These releas
+es contain only minor changes,
+so we hope to have only a single beta release and to
+go final in early October, 1996.
+
+
+What's new
+
+The most important changes in the releases are summariz
+ed below. See the README
+and changes files in the distributions for more complet
+e information on what has
+changed, including both feature changes and bug fixes.
+
+ There are new options to the file command for
+copying files (file copy),
+ deleting files and directories (file delete),
+creating directories (file
+ mkdir), and renaming files (file rename).
+ The implementation of exec has been improved great
+ly for Windows 95 and
+ Windows NT.
+ There is a new memory allocator for the Macintosh
+version, which should be
+ more efficient than the old one.
+ Tk's grid geometry manager has been completely
+rewritten. The layout
+ algorithm produces much better layouts than before
+, especially where rows or
+ columns were stretchable.
+ There are new commands for creating common dialog
+boxes:
+ tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
+ tk_messageBox. These use native dialog boxes if
+they are available.
+ There is a new virtual event mechanism for handlin
+g events in a more portable
+ way. See the new command event. It also allows
+events (both physical and
+ virtual) to be generated dynamically.
+
+Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl
+7.5 and Tk 4.1 except for
+changes in the C APIs for custom channel drivers. Scrip
+ts written for earlier releases
+should work on these new releases as well.
+
+Obtaining The Releases
+
+Binary Releases
+
+Pre-compiled releases are available for the following
+platforms:
+
+ Windows 3.1, Windows 95, and Windows NT: Fetch
+ ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
+execute it. The file is a
+ self-extracting executable. It will install the
+Tcl and Tk libraries, the wish and
+ tclsh programs, and documentation.
+ Macintosh (both 68K and PowerPC): Fetch
+ ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx.
+The file is in binhex format,
+ which is understood by Fetch, StuffIt, and many
+other Mac utilities. The
+ unpacked file is a self-installing executable:
+double-click on it and it will create a
+ folder containing all that you need to run Tcl
+and Tk.
+ UNIX (Solaris 2.* and SunOS, other systems
+soon to follow). Easy to install
+ binary packages are now for sale at the Sun Labs
+Tcl/Tk Shop. Check it out!
+}
+
+# Check that "break" resets the interpreter's result
+
+test for-4.1 {break must reset the interp result} {
+ catch {
+ set z GLOBTESTDIR/dir2/file2.c
+ if [string match GLOBTESTDIR/dir2/* $z] {
+ break
+ }
+ } j
+ set j
+} {}
+
+# Check "for" and computed command names.
+
+test for-5.1 {for and computed command names} {
+ set j 0
+ set z for
+ $z {set i 0} {$i<10} {incr i} {set j $i}
+ set j
+} 9