| [25] | 1 | # Commands covered:  for, continue, break | 
|---|
 | 2 | # | 
|---|
 | 3 | # This file contains a collection of tests for one or more of the Tcl | 
|---|
 | 4 | # built-in commands.  Sourcing this file into Tcl runs the tests and | 
|---|
 | 5 | # generates output for errors.  No output means no errors were found. | 
|---|
 | 6 | # | 
|---|
 | 7 | # Copyright (c) 1996 Sun Microsystems, Inc. | 
|---|
 | 8 | # | 
|---|
 | 9 | # See the file "license.terms" for information on usage and redistribution | 
|---|
 | 10 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. | 
|---|
 | 11 | # | 
|---|
 | 12 | # RCS: @(#) $Id: for.test,v 1.16 2006/10/09 19:15:44 msofer Exp $ | 
|---|
 | 13 |  | 
|---|
 | 14 | if {[lsearch [namespace children] ::tcltest] == -1} { | 
|---|
 | 15 |     package require tcltest 2 | 
|---|
 | 16 |     namespace import -force ::tcltest::* | 
|---|
 | 17 | } | 
|---|
 | 18 |  | 
|---|
 | 19 | # Basic "for" operation. | 
|---|
 | 20 |  | 
|---|
 | 21 | test for-1.1 {TclCompileForCmd: missing initial command} { | 
|---|
 | 22 |     list [catch {for} msg] $msg | 
|---|
 | 23 | } {1 {wrong # args: should be "for start test next command"}} | 
|---|
 | 24 | test for-1.2 {TclCompileForCmd: error in initial command} -body { | 
|---|
 | 25 |     list [catch {for {set}} msg] $msg $::errorInfo | 
|---|
 | 26 | } -match glob -result {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command" | 
|---|
 | 27 |     while *ing | 
|---|
 | 28 | "for {set}"}} | 
|---|
 | 29 | catch {unset i} | 
|---|
 | 30 | test for-1.3 {TclCompileForCmd: missing test expression} { | 
|---|
 | 31 |     catch {for {set i 0}} msg | 
|---|
 | 32 |     set msg | 
|---|
 | 33 | } {wrong # args: should be "for start test next command"} | 
|---|
 | 34 | test for-1.4 {TclCompileForCmd: error in test expression} -body { | 
|---|
 | 35 |     catch {for {set i 0} {$i<}} msg | 
|---|
 | 36 |     set ::errorInfo | 
|---|
 | 37 | } -match glob -result {wrong # args: should be "for start test next command" | 
|---|
 | 38 |     while *ing | 
|---|
 | 39 | "for {set i 0} {$i<}"} | 
|---|
 | 40 | test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} { | 
|---|
 | 41 |     set i 0 | 
|---|
 | 42 |     for {} "$i > 5" {incr i} {} | 
|---|
 | 43 | } {} | 
|---|
 | 44 | test for-1.6 {TclCompileForCmd: missing "next" command} { | 
|---|
 | 45 |     catch {for {set i 0} {$i < 5}} msg | 
|---|
 | 46 |     set msg | 
|---|
 | 47 | } {wrong # args: should be "for start test next command"} | 
|---|
 | 48 | test for-1.7 {TclCompileForCmd: missing command body} { | 
|---|
 | 49 |     catch {for {set i 0} {$i < 5} {incr i}} msg | 
|---|
 | 50 |     set msg | 
|---|
 | 51 | } {wrong # args: should be "for start test next command"} | 
|---|
 | 52 | test for-1.8 {TclCompileForCmd: error compiling command body} -body { | 
|---|
 | 53 |     catch {for {set i 0} {$i < 5} {incr i} {set}} msg | 
|---|
 | 54 |     set ::errorInfo | 
|---|
 | 55 | } -match glob -result {wrong # args: should be "set varName ?newValue?" | 
|---|
 | 56 |     while *ing | 
|---|
 | 57 | "set"*} | 
|---|
 | 58 | catch {unset a} | 
|---|
 | 59 | test for-1.9 {TclCompileForCmd: simple command body} { | 
|---|
 | 60 |     set a {} | 
|---|
 | 61 |     for {set i 1} {$i<6} {set i [expr $i+1]} { | 
|---|
 | 62 |         if $i==4 break | 
|---|
 | 63 |         set a [concat $a $i] | 
|---|
 | 64 |     } | 
|---|
 | 65 |     set a | 
|---|
 | 66 | } {1 2 3} | 
|---|
 | 67 | test for-1.10 {TclCompileForCmd: command body in quotes} { | 
|---|
 | 68 |     set a {} | 
|---|
 | 69 |     for {set i 1} {$i<6} {set i [expr $i+1]} "append a x" | 
|---|
 | 70 |     set a | 
|---|
 | 71 | } {xxxxx} | 
|---|
 | 72 | test for-1.11 {TclCompileForCmd: computed command body} { | 
|---|
 | 73 |     catch {unset x1} | 
|---|
 | 74 |     catch {unset bb} | 
|---|
 | 75 |     catch {unset x2} | 
|---|
 | 76 |     set x1 {append a x1; } | 
|---|
 | 77 |     set bb {break} | 
|---|
 | 78 |     set x2 {; append a x2} | 
|---|
 | 79 |     set a {} | 
|---|
 | 80 |     for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2 | 
|---|
 | 81 |     set a | 
|---|
 | 82 | } {x1} | 
|---|
 | 83 | test for-1.12 {TclCompileForCmd: error in "next" command} -body { | 
|---|
 | 84 |     catch {for {set i 0} {$i < 5} {set} {format $i}} msg | 
|---|
 | 85 |     set ::errorInfo | 
|---|
 | 86 | } -match glob -result {wrong # args: should be "set varName ?newValue?" | 
|---|
 | 87 |     while *ing | 
|---|
 | 88 | "set"*} | 
|---|
 | 89 | test for-1.13 {TclCompileForCmd: long command body} { | 
|---|
 | 90 |     set a {} | 
|---|
 | 91 |     for {set i 1} {$i<6} {set i [expr $i+1]} { | 
|---|
 | 92 |         if $i==4 break | 
|---|
 | 93 |         if $i>5 continue | 
|---|
 | 94 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 95 |             catch {set a $a} msg | 
|---|
 | 96 |             catch {incr i 5} msg | 
|---|
 | 97 |             catch {incr i -5} msg | 
|---|
 | 98 |         } | 
|---|
 | 99 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 100 |             catch {set a $a} msg | 
|---|
 | 101 |             catch {incr i 5} msg | 
|---|
 | 102 |             catch {incr i -5} msg | 
|---|
 | 103 |         } | 
|---|
 | 104 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 105 |             catch {set a $a} msg | 
|---|
 | 106 |             catch {incr i 5} msg | 
|---|
 | 107 |             catch {incr i -5} msg | 
|---|
 | 108 |         } | 
|---|
 | 109 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 110 |             catch {set a $a} msg | 
|---|
 | 111 |             catch {incr i 5} msg | 
|---|
 | 112 |             catch {incr i -5} msg | 
|---|
 | 113 |         } | 
|---|
 | 114 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 115 |             catch {set a $a} msg | 
|---|
 | 116 |             catch {incr i 5} msg | 
|---|
 | 117 |             catch {incr i -5} msg | 
|---|
 | 118 |         } | 
|---|
 | 119 |         set a [concat $a $i] | 
|---|
 | 120 |     } | 
|---|
 | 121 |     set a | 
|---|
 | 122 | } {1 2 3} | 
|---|
 | 123 | test for-1.14 {TclCompileForCmd: for command result} { | 
|---|
 | 124 |     set a [for {set i 0} {$i < 5} {incr i} {}] | 
|---|
 | 125 |     set a | 
|---|
 | 126 | } {} | 
|---|
 | 127 | test for-1.15 {TclCompileForCmd: for command result} { | 
|---|
 | 128 |     set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}] | 
|---|
 | 129 |     set a | 
|---|
 | 130 | } {} | 
|---|
 | 131 |  | 
|---|
 | 132 | # Check "for" and "continue". | 
|---|
 | 133 |  | 
|---|
 | 134 | test for-2.1 {TclCompileContinueCmd: arguments after "continue"} { | 
|---|
 | 135 |     catch {continue foo} msg | 
|---|
 | 136 |     set msg | 
|---|
 | 137 | } {wrong # args: should be "continue"} | 
|---|
 | 138 | test for-2.2 {TclCompileContinueCmd: continue result} { | 
|---|
 | 139 |     catch continue | 
|---|
 | 140 | } 4 | 
|---|
 | 141 | test for-2.3 {continue tests} { | 
|---|
 | 142 |     set a {} | 
|---|
 | 143 |     for {set i 1} {$i <= 4} {set i [expr $i+1]} { | 
|---|
 | 144 |         if {$i == 2} continue | 
|---|
 | 145 |         set a [concat $a $i] | 
|---|
 | 146 |     } | 
|---|
 | 147 |     set a | 
|---|
 | 148 | } {1 3 4} | 
|---|
 | 149 | test for-2.4 {continue tests} { | 
|---|
 | 150 |     set a {} | 
|---|
 | 151 |     for {set i 1} {$i <= 4} {set i [expr $i+1]} { | 
|---|
 | 152 |         if {$i != 2} continue | 
|---|
 | 153 |         set a [concat $a $i] | 
|---|
 | 154 |     } | 
|---|
 | 155 |     set a | 
|---|
 | 156 | } {2} | 
|---|
 | 157 | test for-2.5 {continue tests, nested loops} { | 
|---|
 | 158 |     set msg {} | 
|---|
 | 159 |     for {set i 1} {$i <= 4} {incr i} { | 
|---|
 | 160 |         for {set a 1} {$a <= 2} {incr a} { | 
|---|
 | 161 |             if {$i>=2 && $a>=2} continue | 
|---|
 | 162 |             set msg [concat $msg "$i.$a"] | 
|---|
 | 163 |         } | 
|---|
 | 164 |     } | 
|---|
 | 165 |     set msg | 
|---|
 | 166 | } {1.1 1.2 2.1 3.1 4.1} | 
|---|
 | 167 | test for-2.6 {continue tests, long command body} { | 
|---|
 | 168 |     set a {} | 
|---|
 | 169 |     for {set i 1} {$i<6} {set i [expr $i+1]} { | 
|---|
 | 170 |         if $i==2 continue | 
|---|
 | 171 |         if $i==4 break | 
|---|
 | 172 |         if $i>5 continue | 
|---|
 | 173 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 174 |             catch {set a $a} msg | 
|---|
 | 175 |             catch {incr i 5} msg | 
|---|
 | 176 |             catch {incr i -5} msg | 
|---|
 | 177 |         } | 
|---|
 | 178 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 179 |             catch {set a $a} msg | 
|---|
 | 180 |             catch {incr i 5} msg | 
|---|
 | 181 |             catch {incr i -5} msg | 
|---|
 | 182 |         } | 
|---|
 | 183 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 184 |             catch {set a $a} msg | 
|---|
 | 185 |             catch {incr i 5} msg | 
|---|
 | 186 |             catch {incr i -5} msg | 
|---|
 | 187 |         } | 
|---|
 | 188 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 189 |             catch {set a $a} msg | 
|---|
 | 190 |             catch {incr i 5} msg | 
|---|
 | 191 |             catch {incr i -5} msg | 
|---|
 | 192 |         } | 
|---|
 | 193 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 194 |             catch {set a $a} msg | 
|---|
 | 195 |             catch {incr i 5} msg | 
|---|
 | 196 |             catch {incr i -5} msg | 
|---|
 | 197 |         } | 
|---|
 | 198 |         set a [concat $a $i] | 
|---|
 | 199 |     } | 
|---|
 | 200 |     set a | 
|---|
 | 201 | } {1 3} | 
|---|
 | 202 |  | 
|---|
 | 203 | # Check "for" and "break". | 
|---|
 | 204 |  | 
|---|
 | 205 | test for-3.1 {TclCompileBreakCmd: arguments after "break"} { | 
|---|
 | 206 |     catch {break foo} msg | 
|---|
 | 207 |     set msg | 
|---|
 | 208 | } {wrong # args: should be "break"} | 
|---|
 | 209 | test for-3.2 {TclCompileBreakCmd: break result} { | 
|---|
 | 210 |     catch break | 
|---|
 | 211 | } 3 | 
|---|
 | 212 | test for-3.3 {break tests} { | 
|---|
 | 213 |     set a {} | 
|---|
 | 214 |     for {set i 1} {$i <= 4} {incr i} { | 
|---|
 | 215 |         if {$i == 3} break | 
|---|
 | 216 |         set a [concat $a $i] | 
|---|
 | 217 |     } | 
|---|
 | 218 |     set a | 
|---|
 | 219 | } {1 2} | 
|---|
 | 220 | test for-3.4 {break tests, nested loops} { | 
|---|
 | 221 |     set msg {} | 
|---|
 | 222 |     for {set i 1} {$i <= 4} {incr i} { | 
|---|
 | 223 |         for {set a 1} {$a <= 2} {incr a} { | 
|---|
 | 224 |             if {$i>=2 && $a>=2} break | 
|---|
 | 225 |             set msg [concat $msg "$i.$a"] | 
|---|
 | 226 |         } | 
|---|
 | 227 |     } | 
|---|
 | 228 |     set msg | 
|---|
 | 229 | } {1.1 1.2 2.1 3.1 4.1} | 
|---|
 | 230 | test for-3.5 {break tests, long command body} { | 
|---|
 | 231 |     set a {} | 
|---|
 | 232 |     for {set i 1} {$i<6} {set i [expr $i+1]} { | 
|---|
 | 233 |         if $i==2 continue | 
|---|
 | 234 |         if $i==5 break | 
|---|
 | 235 |         if $i>5 continue | 
|---|
 | 236 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 237 |             catch {set a $a} msg | 
|---|
 | 238 |             catch {incr i 5} msg | 
|---|
 | 239 |             catch {incr i -5} msg | 
|---|
 | 240 |         } | 
|---|
 | 241 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 242 |             catch {set a $a} msg | 
|---|
 | 243 |             catch {incr i 5} msg | 
|---|
 | 244 |             catch {incr i -5} msg | 
|---|
 | 245 |         } | 
|---|
 | 246 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 247 |             catch {set a $a} msg | 
|---|
 | 248 |             catch {incr i 5} msg | 
|---|
 | 249 |             catch {incr i -5} msg | 
|---|
 | 250 |         } | 
|---|
 | 251 |         if $i==4 break | 
|---|
 | 252 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 253 |             catch {set a $a} msg | 
|---|
 | 254 |             catch {incr i 5} msg | 
|---|
 | 255 |             catch {incr i -5} msg | 
|---|
 | 256 |         } | 
|---|
 | 257 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 258 |             catch {set a $a} msg | 
|---|
 | 259 |             catch {incr i 5} msg | 
|---|
 | 260 |             catch {incr i -5} msg | 
|---|
 | 261 |         } | 
|---|
 | 262 |         set a [concat $a $i] | 
|---|
 | 263 |     } | 
|---|
 | 264 |     set a | 
|---|
 | 265 | } {1 3} | 
|---|
 | 266 | # A simplified version of exmh's mail formatting routine to stress "for", | 
|---|
 | 267 | # "break", "while", and "if". | 
|---|
 | 268 | proc formatMail {} { | 
|---|
 | 269 |     array set lines { | 
|---|
 | 270 |         0 {Return-path: george@tcl} \ | 
|---|
 | 271 |         1 {Return-path: <george@tcl>} \ | 
|---|
 | 272 |         2 {Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)} \ | 
|---|
 | 273 |         3 {     id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700} \ | 
|---|
 | 274 |         4 {Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>} \ | 
|---|
 | 275 |         5 {X-mailer: exmh version 1.6.9 8/22/96} \ | 
|---|
 | 276 |         6 {Mime-version: 1.0} \ | 
|---|
 | 277 |         7 {Content-type: text/plain; charset=iso-8859-1} \ | 
|---|
 | 278 |         8 {Content-transfer-encoding: quoted-printable} \ | 
|---|
 | 279 |         9 {Content-length: 2162} \ | 
|---|
 | 280 |         10 {To: fred} \ | 
|---|
 | 281 |         11 {Subject: tcl7.6} \ | 
|---|
 | 282 |         12 {Date: Wed, 11 Sep 1996 11:14:53 -0700} \ | 
|---|
 | 283 |         13 {From: George <george@tcl>} \ | 
|---|
 | 284 |         14 {The Tcl 7.6 and Tk 4.2 releases} \ | 
|---|
 | 285 |         15 {} \ | 
|---|
 | 286 |         16 {This page contains information about Tcl 7.6 and Tk4.2, which are the most recent} \ | 
|---|
 | 287 |         17 {releases of the Tcl scripting language and the Tk toolkit. The first beta versions of these} \ | 
|---|
 | 288 |         18 {releases were released on August 30, 1996. These releases contain only minor changes,} \ | 
|---|
 | 289 |         19 {so we hope to have only a single beta release and to go final in early October, 1996. } \ | 
|---|
 | 290 |         20 {} \ | 
|---|
 | 291 |         21 {} \ | 
|---|
 | 292 |         22 {What's new } \ | 
|---|
 | 293 |         23 {} \ | 
|---|
 | 294 |         24 {The most important changes in the releases are summarized below. See the README} \ | 
|---|
 | 295 |         25 {and changes files in the distributions for more complete information on what has} \ | 
|---|
 | 296 |         26 {changed, including both feature changes and bug fixes. } \ | 
|---|
 | 297 |         27 {} \ | 
|---|
 | 298 |         28 {     There are new options to the file command for copying files (file copy),} \ | 
|---|
 | 299 |         29 {     deleting files and directories (file delete), creating directories (file} \ | 
|---|
 | 300 |         30 {     mkdir), and renaming files (file rename). } \ | 
|---|
 | 301 |         31 {     The implementation of exec has been improved greatly for Windows 95 and} \ | 
|---|
 | 302 |         32 {     Windows NT. } \ | 
|---|
 | 303 |         33 {     There is a new memory allocator for the Macintosh version, which should be} \ | 
|---|
 | 304 |         34 {     more efficient than the old one. } \ | 
|---|
 | 305 |         35 {     Tk's grid geometry manager has been completely rewritten. The layout} \ | 
|---|
 | 306 |         36 {     algorithm produces much better layouts than before, especially where rows or} \ | 
|---|
 | 307 |         37 {     columns were stretchable. } \ | 
|---|
 | 308 |         38 {     There are new commands for creating common dialog boxes:} \ | 
|---|
 | 309 |         39 {     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and} \ | 
|---|
 | 310 |         40 {     tk_messageBox. These use native dialog boxes if they are available. } \ | 
|---|
 | 311 |         41 {     There is a new virtual event mechanism for handling events in a more portable} \ | 
|---|
 | 312 |         42 {     way. See the new command event. It also allows events (both physical and} \ | 
|---|
 | 313 |         43 {     virtual) to be generated dynamically. } \ | 
|---|
 | 314 |         44 {} \ | 
|---|
 | 315 |         45 {Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for} \ | 
|---|
 | 316 |         46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \ | 
|---|
 | 317 |         47 {should work on these new releases as well. } \ | 
|---|
 | 318 |         48 {} \ | 
|---|
 | 319 |         49 {Obtaining The Releases} \ | 
|---|
 | 320 |         50 {} \ | 
|---|
 | 321 |         51 {Binary Releases} \ | 
|---|
 | 322 |         52 {} \ | 
|---|
 | 323 |         53 {Pre-compiled releases are available for the following platforms: } \ | 
|---|
 | 324 |         54 {} \ | 
|---|
 | 325 |         55 {     Windows 3.1, Windows 95, and Windows NT: Fetch} \ | 
|---|
 | 326 |         56 {     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \ | 
|---|
 | 327 |         57 {     self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \ | 
|---|
 | 328 |         58 {     tclsh programs, and documentation. } \ | 
|---|
 | 329 |         59 {     Macintosh (both 68K and PowerPC): Fetch} \ | 
|---|
 | 330 |         60 {     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \ | 
|---|
 | 331 |         61 {     which is understood by Fetch, StuffIt, and many other Mac utilities. The} \ | 
|---|
 | 332 |         62 {     unpacked file is a self-installing executable: double-click on it and it will create a} \ | 
|---|
 | 333 |         63 {     folder containing all that you need to run Tcl and Tk. } \ | 
|---|
 | 334 |         64 {        UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \ | 
|---|
 | 335 |         65 {     binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \ | 
|---|
 | 336 |     } | 
|---|
 | 337 |  | 
|---|
 | 338 |     set result "" | 
|---|
 | 339 |     set NL " | 
|---|
 | 340 | " | 
|---|
 | 341 |     set tag {level= type=text/plain part=0 sel Charset} | 
|---|
 | 342 |     set ix [lsearch -regexp $tag text/enriched] | 
|---|
 | 343 |     if {$ix < 0} { | 
|---|
 | 344 |         set ranges {} | 
|---|
 | 345 |         set quote 0 | 
|---|
 | 346 |     } | 
|---|
 | 347 |     set breakrange {6.42 78.0} | 
|---|
 | 348 |     set F1 [lindex $breakrange 0] | 
|---|
 | 349 |     set F2 [lindex $breakrange 1] | 
|---|
 | 350 |     set breakrange [lrange $breakrange 2 end] | 
|---|
 | 351 |     if {[string length $F1] == 0} { | 
|---|
 | 352 |         set F1 -1 | 
|---|
 | 353 |         set break 0 | 
|---|
 | 354 |     } else { | 
|---|
 | 355 |         set break 1 | 
|---|
 | 356 |     } | 
|---|
 | 357 |  | 
|---|
 | 358 |     set xmailer 0 | 
|---|
 | 359 |     set inheaders 1 | 
|---|
 | 360 |     set last [array size lines] | 
|---|
 | 361 |     set plen 2 | 
|---|
 | 362 |     for {set L 1} {$L < $last} {incr L} { | 
|---|
 | 363 |         set line $lines($L) | 
|---|
 | 364 |         if {$inheaders} { | 
|---|
 | 365 |             # Blank or empty line terminates headers | 
|---|
 | 366 |             # Leading --- terminates headers | 
|---|
 | 367 |             if {[regexp {^[     ]*$} $line] || [regexp {^--+} $line]} { | 
|---|
 | 368 |                 set inheaders 0 | 
|---|
 | 369 |             } | 
|---|
 | 370 |             if {[regexp -nocase {^x-mailer:} $line]} { | 
|---|
 | 371 |                 continue | 
|---|
 | 372 |             } | 
|---|
 | 373 |         } | 
|---|
 | 374 |         if $inheaders { | 
|---|
 | 375 |             set limit 55 | 
|---|
 | 376 |         } else { | 
|---|
 | 377 |             set limit 55 | 
|---|
 | 378 |  | 
|---|
 | 379 |             # Decide whether or not to break the body line | 
|---|
 | 380 |  | 
|---|
 | 381 |             if {$plen > 0} { | 
|---|
 | 382 |                 if {[string first {> } $line] == 0} { | 
|---|
 | 383 |                     # This is quoted text from previous message, don't reformat | 
|---|
 | 384 |                     append result $line $NL | 
|---|
 | 385 |                     if {$quote && !$inheaders} { | 
|---|
 | 386 |                         # Fix from <sarr@umich.edu> to handle text/enriched | 
|---|
 | 387 |                         if {$L > $L1 && $L < $L2 && $line != {}} { | 
|---|
 | 388 |                             # enriched requires two newlines for each one. | 
|---|
 | 389 |                             append result $NL | 
|---|
 | 390 |                         } elseif {$L > $L2} { | 
|---|
 | 391 |                             set L1 [lindex $ranges 0] | 
|---|
 | 392 |                             set L2 [lindex $ranges 1] | 
|---|
 | 393 |                             set ranges [lrange $ranges 2 end] | 
|---|
 | 394 |                             set quote [llength $L1] | 
|---|
 | 395 |                         } | 
|---|
 | 396 |                     } | 
|---|
 | 397 |                     continue | 
|---|
 | 398 |                 } | 
|---|
 | 399 |             } | 
|---|
 | 400 |             if {$F1 < 0} { | 
|---|
 | 401 |                 # Nothing left to format | 
|---|
 | 402 |                 append result $line $NL | 
|---|
 | 403 |                 continue | 
|---|
 | 404 |             } elseif {$L < $F1} { | 
|---|
 | 405 |                 # Not yet to formatted block | 
|---|
 | 406 |                 append result $line $NL | 
|---|
 | 407 |                 continue | 
|---|
 | 408 |             } elseif {$L > $F2} { | 
|---|
 | 409 |                 # Past formatted block | 
|---|
 | 410 |                 set F1 [lindex $breakrange 0] | 
|---|
 | 411 |                 set F2 [lindex $breakrange 1] | 
|---|
 | 412 |                 set breakrange [lrange $breakrange 2 end] | 
|---|
 | 413 |                 append result $line $NL | 
|---|
 | 414 |                 if {[string length $F1] == 0} { | 
|---|
 | 415 |                     set F1 -1 | 
|---|
 | 416 |                 } | 
|---|
 | 417 |                 continue | 
|---|
 | 418 |             } | 
|---|
 | 419 |         } | 
|---|
 | 420 |         set climit [expr $limit-1] | 
|---|
 | 421 |         set cutoff 50 | 
|---|
 | 422 |         set continuation 0 | 
|---|
 | 423 |          | 
|---|
 | 424 |         while {[string length $line] > $limit} { | 
|---|
 | 425 |             for {set c [expr $limit-1]} {$c >= $cutoff} {incr c -1} { | 
|---|
 | 426 |                 set char [string index $line $c] | 
|---|
 | 427 |                 if {$char == " " || $char == "\t"} { | 
|---|
 | 428 |                     break | 
|---|
 | 429 |                 } | 
|---|
 | 430 |                 if {$char == ">"} {     ;# Hack for enriched formatting | 
|---|
 | 431 |                     break | 
|---|
 | 432 |                 } | 
|---|
 | 433 |             } | 
|---|
 | 434 |             if {$c < $cutoff} { | 
|---|
 | 435 |                 if {! $inheaders} { | 
|---|
 | 436 |                     set c [expr $limit-1] | 
|---|
 | 437 |                 } else { | 
|---|
 | 438 |                     set c [string length $line] | 
|---|
 | 439 |                 } | 
|---|
 | 440 |             } | 
|---|
 | 441 |             set newline [string range $line 0 $c] | 
|---|
 | 442 |             if {! $continuation} { | 
|---|
 | 443 |                 append result $newline $NL | 
|---|
 | 444 |             } else { | 
|---|
 | 445 |                 append result \ $newline $NL | 
|---|
 | 446 |             } | 
|---|
 | 447 |             incr c | 
|---|
 | 448 |             set line [string trimright [string range $line $c end]] | 
|---|
 | 449 |             if {$inheaders} { | 
|---|
 | 450 |                 set continuation 1 | 
|---|
 | 451 |                 set limit $climit | 
|---|
 | 452 |             } | 
|---|
 | 453 |         } | 
|---|
 | 454 |         if {$continuation} { | 
|---|
 | 455 |             if {[string length $line] != 0} { | 
|---|
 | 456 |                 append result \ $line $NL | 
|---|
 | 457 |             } | 
|---|
 | 458 |         } else { | 
|---|
 | 459 |             append result $line $NL | 
|---|
 | 460 |             if {$quote && !$inheaders} { | 
|---|
 | 461 |                 if {$L > $L1 && $L < $L2 && $line != {}} { | 
|---|
 | 462 |                     # enriched requires two newlines for each one. | 
|---|
 | 463 |                     append result "" $NL | 
|---|
 | 464 |                 } elseif {$L > $L2} { | 
|---|
 | 465 |                     set L1 [lindex $ranges 0] | 
|---|
 | 466 |                     set L2 [lindex $ranges 1] | 
|---|
 | 467 |                     set ranges [lrange $ranges 2 end] | 
|---|
 | 468 |                     set quote [llength $L1] | 
|---|
 | 469 |                 } | 
|---|
 | 470 |             } | 
|---|
 | 471 |         } | 
|---|
 | 472 |     } | 
|---|
 | 473 |     return $result | 
|---|
 | 474 | } | 
|---|
 | 475 | test for-3.6 {break tests} { | 
|---|
 | 476 |     formatMail | 
|---|
 | 477 | } {Return-path: <george@tcl> | 
|---|
 | 478 | Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4) | 
|---|
 | 479 |         id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700 | 
|---|
 | 480 | Message-id: <199609111814.LAA10027@tcl.Somewhere.COM> | 
|---|
 | 481 | Mime-version: 1.0 | 
|---|
 | 482 | Content-type: text/plain; charset=iso-8859-1 | 
|---|
 | 483 | Content-transfer-encoding: quoted-printable | 
|---|
 | 484 | Content-length: 2162 | 
|---|
 | 485 | To: fred | 
|---|
 | 486 | Subject: tcl7.6 | 
|---|
 | 487 | Date: Wed, 11 Sep 1996 11:14:53 -0700 | 
|---|
 | 488 | From: George <george@tcl> | 
|---|
 | 489 | The Tcl 7.6 and Tk 4.2 releases | 
|---|
 | 490 |  | 
|---|
 | 491 | This page contains information about Tcl 7.6 and Tk4.2, | 
|---|
 | 492 |  which are the most recent | 
|---|
 | 493 | releases of the Tcl scripting language and the Tk toolk | 
|---|
 | 494 | it. The first beta versions of these | 
|---|
 | 495 | releases were released on August 30, 1996. These releas | 
|---|
 | 496 | es contain only minor changes, | 
|---|
 | 497 | so we hope to have only a single beta release and to  | 
|---|
 | 498 | go final in early October, 1996. | 
|---|
 | 499 |  | 
|---|
 | 500 |  | 
|---|
 | 501 | What's new  | 
|---|
 | 502 |  | 
|---|
 | 503 | The most important changes in the releases are summariz | 
|---|
 | 504 | ed below. See the README | 
|---|
 | 505 | and changes files in the distributions for more complet | 
|---|
 | 506 | e information on what has | 
|---|
 | 507 | changed, including both feature changes and bug fixes.  | 
|---|
 | 508 |  | 
|---|
 | 509 |      There are new options to the file command for  | 
|---|
 | 510 | copying files (file copy), | 
|---|
 | 511 |      deleting files and directories (file delete),  | 
|---|
 | 512 | creating directories (file | 
|---|
 | 513 |      mkdir), and renaming files (file rename).  | 
|---|
 | 514 |      The implementation of exec has been improved great | 
|---|
 | 515 | ly for Windows 95 and | 
|---|
 | 516 |      Windows NT.  | 
|---|
 | 517 |      There is a new memory allocator for the Macintosh  | 
|---|
 | 518 | version, which should be | 
|---|
 | 519 |      more efficient than the old one.  | 
|---|
 | 520 |      Tk's grid geometry manager has been completely  | 
|---|
 | 521 | rewritten. The layout | 
|---|
 | 522 |      algorithm produces much better layouts than before | 
|---|
 | 523 | , especially where rows or | 
|---|
 | 524 |      columns were stretchable.  | 
|---|
 | 525 |      There are new commands for creating common dialog  | 
|---|
 | 526 | boxes: | 
|---|
 | 527 |      tk_chooseColor, tk_getOpenFile, tk_getSaveFile and | 
|---|
 | 528 |      tk_messageBox. These use native dialog boxes if  | 
|---|
 | 529 | they are available. | 
|---|
 | 530 |      There is a new virtual event mechanism for handlin | 
|---|
 | 531 | g events in a more portable | 
|---|
 | 532 |      way. See the new command event. It also allows  | 
|---|
 | 533 | events (both physical and | 
|---|
 | 534 |      virtual) to be generated dynamically.  | 
|---|
 | 535 |  | 
|---|
 | 536 | Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl  | 
|---|
 | 537 | 7.5 and Tk 4.1 except for | 
|---|
 | 538 | changes in the C APIs for custom channel drivers. Scrip | 
|---|
 | 539 | ts written for earlier releases | 
|---|
 | 540 | should work on these new releases as well.  | 
|---|
 | 541 |  | 
|---|
 | 542 | Obtaining The Releases | 
|---|
 | 543 |  | 
|---|
 | 544 | Binary Releases | 
|---|
 | 545 |  | 
|---|
 | 546 | Pre-compiled releases are available for the following  | 
|---|
 | 547 | platforms: | 
|---|
 | 548 |  | 
|---|
 | 549 |      Windows 3.1, Windows 95, and Windows NT: Fetch | 
|---|
 | 550 |      ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then  | 
|---|
 | 551 | execute it. The file is a | 
|---|
 | 552 |      self-extracting executable. It will install the  | 
|---|
 | 553 | Tcl and Tk libraries, the wish and | 
|---|
 | 554 |      tclsh programs, and documentation.  | 
|---|
 | 555 |      Macintosh (both 68K and PowerPC): Fetch | 
|---|
 | 556 |      ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx.  | 
|---|
 | 557 | The file is in binhex format, | 
|---|
 | 558 |      which is understood by Fetch, StuffIt, and many  | 
|---|
 | 559 | other Mac utilities. The | 
|---|
 | 560 |      unpacked file is a self-installing executable:  | 
|---|
 | 561 | double-click on it and it will create a | 
|---|
 | 562 |      folder containing all that you need to run Tcl  | 
|---|
 | 563 | and Tk. | 
|---|
 | 564 |         UNIX (Solaris 2.* and SunOS, other systems  | 
|---|
 | 565 | soon to follow). Easy to install | 
|---|
 | 566 |      binary packages are now for sale at the Sun Labs  | 
|---|
 | 567 | Tcl/Tk Shop. Check it out! | 
|---|
 | 568 | } | 
|---|
 | 569 |  | 
|---|
 | 570 | # Check that "break" resets the interpreter's result | 
|---|
 | 571 |  | 
|---|
 | 572 | test for-4.1 {break must reset the interp result} { | 
|---|
 | 573 |     catch { | 
|---|
 | 574 |         set z GLOBTESTDIR/dir2/file2.c | 
|---|
 | 575 |         if [string match GLOBTESTDIR/dir2/* $z] { | 
|---|
 | 576 |             break | 
|---|
 | 577 |         } | 
|---|
 | 578 |     } j | 
|---|
 | 579 |     set j | 
|---|
 | 580 | } {} | 
|---|
 | 581 |  | 
|---|
 | 582 | # Test for incorrect "double evaluation" semantics | 
|---|
 | 583 |  | 
|---|
 | 584 | test for-5.1 {possible delayed substitution of increment command} { | 
|---|
 | 585 |     # Increment should be 5, and lappend should always append $a | 
|---|
 | 586 |     catch {unset a} | 
|---|
 | 587 |     catch {unset i} | 
|---|
 | 588 |     set a 5 | 
|---|
 | 589 |     set i {} | 
|---|
 | 590 |     for {set a 1} {$a < 12} "incr a $a" {lappend i $a} | 
|---|
 | 591 |     set i | 
|---|
 | 592 | } {1 6 11} | 
|---|
 | 593 |  | 
|---|
 | 594 | test for-5.2 {possible delayed substitution of increment command} { | 
|---|
 | 595 |     # Increment should be 5, and lappend should always append $a | 
|---|
 | 596 |     catch {rename p ""} | 
|---|
 | 597 |     proc p {} { | 
|---|
 | 598 |         set a 5 | 
|---|
 | 599 |         set i {} | 
|---|
 | 600 |         for {set a 1} {$a < 12} "incr a $a" {lappend i $a} | 
|---|
 | 601 |         set i | 
|---|
 | 602 |     } | 
|---|
 | 603 |     p | 
|---|
 | 604 | } {1 6 11} | 
|---|
 | 605 | test for-5.3 {possible delayed substitution of body command} { | 
|---|
 | 606 |     # Increment should be $a, and lappend should always append 5 | 
|---|
 | 607 |     set a 5 | 
|---|
 | 608 |     set i {} | 
|---|
 | 609 |     for {set a 1} {$a < 12} {incr a $a} "lappend i $a" | 
|---|
 | 610 |     set i | 
|---|
 | 611 | } {5 5 5 5} | 
|---|
 | 612 | test for-5.4 {possible delayed substitution of body command} { | 
|---|
 | 613 |     # Increment should be $a, and lappend should always append 5 | 
|---|
 | 614 |     catch {rename p ""} | 
|---|
 | 615 |     proc p {} { | 
|---|
 | 616 |         set a 5 | 
|---|
 | 617 |         set i {} | 
|---|
 | 618 |         for {set a 1} {$a < 12} {incr a $a} "lappend i $a" | 
|---|
 | 619 |         set i | 
|---|
 | 620 |     } | 
|---|
 | 621 |     p | 
|---|
 | 622 | } {5 5 5 5} | 
|---|
 | 623 |  | 
|---|
 | 624 | # In the following tests we need to bypass the bytecode compiler by | 
|---|
 | 625 | # substituting the command from a variable.  This ensures that command | 
|---|
 | 626 | # procedure is invoked directly. | 
|---|
 | 627 |  | 
|---|
 | 628 | test for-6.1 {Tcl_ForObjCmd: number of args} { | 
|---|
 | 629 |     set z for | 
|---|
 | 630 |     catch {$z} msg | 
|---|
 | 631 |     set msg | 
|---|
 | 632 | } {wrong # args: should be "for start test next command"} | 
|---|
 | 633 | test for-6.2 {Tcl_ForObjCmd: number of args} { | 
|---|
 | 634 |     set z for | 
|---|
 | 635 |     catch {$z {set i 0}} msg | 
|---|
 | 636 |     set msg | 
|---|
 | 637 | } {wrong # args: should be "for start test next command"} | 
|---|
 | 638 | test for-6.3 {Tcl_ForObjCmd: number of args} { | 
|---|
 | 639 |     set z for | 
|---|
 | 640 |     catch {$z {set i 0} {$i < 5}} msg | 
|---|
 | 641 |     set msg | 
|---|
 | 642 | } {wrong # args: should be "for start test next command"} | 
|---|
 | 643 | test for-6.4 {Tcl_ForObjCmd: number of args} { | 
|---|
 | 644 |     set z for | 
|---|
 | 645 |     catch {$z {set i 0} {$i < 5} {incr i}} msg | 
|---|
 | 646 |     set msg | 
|---|
 | 647 | } {wrong # args: should be "for start test next command"} | 
|---|
 | 648 | test for-6.5 {Tcl_ForObjCmd: number of args} { | 
|---|
 | 649 |     set z for | 
|---|
 | 650 |     catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg | 
|---|
 | 651 |     set msg | 
|---|
 | 652 | } {wrong # args: should be "for start test next command"} | 
|---|
 | 653 | test for-6.6 {Tcl_ForObjCmd: error in initial command} -body { | 
|---|
 | 654 |     set z for | 
|---|
 | 655 |     list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $::errorInfo | 
|---|
 | 656 | } -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" | 
|---|
 | 657 |     while *ing | 
|---|
 | 658 | "set" | 
|---|
 | 659 |     ("for" initial command) | 
|---|
 | 660 |     invoked from within | 
|---|
 | 661 | "$z {set} {$i < 5} {incr i} {body}"}} | 
|---|
 | 662 | test for-6.7 {Tcl_ForObjCmd: error in test expression} -body { | 
|---|
 | 663 |     set z for | 
|---|
 | 664 |     catch {$z {set i 0} {i < 5} {incr i} {body}} | 
|---|
 | 665 |     set ::errorInfo | 
|---|
 | 666 | } -match glob -result {*"$z {set i 0} {i < 5} {incr i} {body}"} | 
|---|
 | 667 | test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} { | 
|---|
 | 668 |     set z for | 
|---|
 | 669 |     set i 0 | 
|---|
 | 670 |     $z {set i 6} "$i > 5" {incr i} {set y $i} | 
|---|
 | 671 |     set i | 
|---|
 | 672 | } 6 | 
|---|
 | 673 | test for-6.9 {Tcl_ForObjCmd: error executing command body} -body { | 
|---|
 | 674 |     set z for | 
|---|
 | 675 |     catch {$z {set i 0} {$i < 5} {incr i} {set}} msg | 
|---|
 | 676 |     set ::errorInfo | 
|---|
 | 677 | } -match glob -result {wrong # args: should be "set varName ?newValue?" | 
|---|
 | 678 |     while *ing | 
|---|
 | 679 | "set" | 
|---|
 | 680 |     ("for" body line 1) | 
|---|
 | 681 |     invoked from within | 
|---|
 | 682 | "$z {set i 0} {$i < 5} {incr i} {set}"} | 
|---|
 | 683 | test for-6.10 {Tcl_ForObjCmd: simple command body} { | 
|---|
 | 684 |     set z for | 
|---|
 | 685 |     set a {} | 
|---|
 | 686 |     $z {set i 1} {$i<6} {set i [expr $i+1]} { | 
|---|
 | 687 |         if $i==4 break | 
|---|
 | 688 |         set a [concat $a $i] | 
|---|
 | 689 |     } | 
|---|
 | 690 |     set a | 
|---|
 | 691 | } {1 2 3} | 
|---|
 | 692 | test for-6.11 {Tcl_ForObjCmd: command body in quotes} { | 
|---|
 | 693 |     set z for | 
|---|
 | 694 |     set a {} | 
|---|
 | 695 |     $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x" | 
|---|
 | 696 |     set a | 
|---|
 | 697 | } {xxxxx} | 
|---|
 | 698 | test for-6.12 {Tcl_ForObjCmd: computed command body} { | 
|---|
 | 699 |     set z for | 
|---|
 | 700 |     catch {unset x1} | 
|---|
 | 701 |     catch {unset bb} | 
|---|
 | 702 |     catch {unset x2} | 
|---|
 | 703 |     set x1 {append a x1; } | 
|---|
 | 704 |     set bb {break} | 
|---|
 | 705 |     set x2 {; append a x2} | 
|---|
 | 706 |     set a {} | 
|---|
 | 707 |     $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2 | 
|---|
 | 708 |     set a | 
|---|
 | 709 | } {x1} | 
|---|
 | 710 | test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body { | 
|---|
 | 711 |     set z for | 
|---|
 | 712 |     catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg | 
|---|
 | 713 |     set ::errorInfo | 
|---|
 | 714 | } -match glob -result {wrong # args: should be "set varName ?newValue?" | 
|---|
 | 715 |     while *ing | 
|---|
 | 716 | "set" | 
|---|
 | 717 |     ("for" loop-end command) | 
|---|
 | 718 |     invoked from within | 
|---|
 | 719 | "$z {set i 0} {$i < 5} {set} {set j 4}"} | 
|---|
 | 720 | test for-6.14 {Tcl_ForObjCmd: long command body} { | 
|---|
 | 721 |     set z for | 
|---|
 | 722 |     set a {} | 
|---|
 | 723 |     $z {set i 1} {$i<6} {set i [expr $i+1]} { | 
|---|
 | 724 |         if $i==4 break | 
|---|
 | 725 |         if $i>5 continue | 
|---|
 | 726 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 727 |             catch {set a $a} msg | 
|---|
 | 728 |             catch {incr i 5} msg | 
|---|
 | 729 |             catch {incr i -5} msg | 
|---|
 | 730 |         } | 
|---|
 | 731 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 732 |             catch {set a $a} msg | 
|---|
 | 733 |             catch {incr i 5} msg | 
|---|
 | 734 |             catch {incr i -5} msg | 
|---|
 | 735 |         } | 
|---|
 | 736 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 737 |             catch {set a $a} msg | 
|---|
 | 738 |             catch {incr i 5} msg | 
|---|
 | 739 |             catch {incr i -5} msg | 
|---|
 | 740 |         } | 
|---|
 | 741 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 742 |             catch {set a $a} msg | 
|---|
 | 743 |             catch {incr i 5} msg | 
|---|
 | 744 |             catch {incr i -5} msg | 
|---|
 | 745 |         } | 
|---|
 | 746 |         if {$i>6 && $tcl_platform(machine)=="xxx"} { | 
|---|
 | 747 |             catch {set a $a} msg | 
|---|
 | 748 |             catch {incr i 5} msg | 
|---|
 | 749 |             catch {incr i -5} msg | 
|---|
 | 750 |         } | 
|---|
 | 751 |         set a [concat $a $i] | 
|---|
 | 752 |     } | 
|---|
 | 753 |     set a | 
|---|
 | 754 | } {1 2 3} | 
|---|
 | 755 | test for-6.15 {Tcl_ForObjCmd: for command result} { | 
|---|
 | 756 |     set z for | 
|---|
 | 757 |     set a [$z {set i 0} {$i < 5} {incr i} {}] | 
|---|
 | 758 |     set a | 
|---|
 | 759 | } {} | 
|---|
 | 760 | test for-6.16 {Tcl_ForObjCmd: for command result} { | 
|---|
 | 761 |     set z for | 
|---|
 | 762 |     set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}] | 
|---|
 | 763 |     set a | 
|---|
 | 764 | } {} | 
|---|
 | 765 | test for-6.17 {Tcl_ForObjCmd: for command result} { | 
|---|
 | 766 |     list \ | 
|---|
 | 767 |         [catch {for {break} {1} {} {}} err] $err \ | 
|---|
 | 768 |         [catch {for {continue} {1} {} {}} err] $err \ | 
|---|
 | 769 |         [catch {for {} {[break]} {} {}} err] $err \ | 
|---|
 | 770 |         [catch {for {} {[continue]} {} {}} err] $err \ | 
|---|
 | 771 |         [catch {for {} {1} {break} {}} err] $err \ | 
|---|
 | 772 |         [catch {for {} {1} {continue} {}} err] $err \ | 
|---|
 | 773 | } [list \ | 
|---|
 | 774 |     3 {} \ | 
|---|
 | 775 |     4 {} \ | 
|---|
 | 776 |     3 {} \ | 
|---|
 | 777 |     4 {} \ | 
|---|
 | 778 |     0 {} \ | 
|---|
 | 779 |     4 {} \ | 
|---|
 | 780 |     ] | 
|---|
 | 781 | test for-6.18 {Tcl_ForObjCmd: for command result} { | 
|---|
 | 782 |     proc p6181 {} { | 
|---|
 | 783 |         for {break} {1} {} {} | 
|---|
 | 784 |     } | 
|---|
 | 785 |     proc p6182 {} { | 
|---|
 | 786 |         for {continue} {1} {} {} | 
|---|
 | 787 |     } | 
|---|
 | 788 |     proc p6183 {} { | 
|---|
 | 789 |         for {} {[break]} {} {} | 
|---|
 | 790 |     } | 
|---|
 | 791 |     proc p6184 {} { | 
|---|
 | 792 |         for {} {[continue]} {} {} | 
|---|
 | 793 |     } | 
|---|
 | 794 |     proc p6185 {} { | 
|---|
 | 795 |         for {} {1} {break} {} | 
|---|
 | 796 |     } | 
|---|
 | 797 |     proc p6186 {} { | 
|---|
 | 798 |         for {} {1} {continue} {} | 
|---|
 | 799 |     } | 
|---|
 | 800 |     list \ | 
|---|
 | 801 |         [catch {p6181} err] $err \ | 
|---|
 | 802 |         [catch {p6182} err] $err \ | 
|---|
 | 803 |         [catch {p6183} err] $err \ | 
|---|
 | 804 |         [catch {p6184} err] $err \ | 
|---|
 | 805 |         [catch {p6185} err] $err \ | 
|---|
 | 806 |         [catch {p6186} err] $err | 
|---|
 | 807 | } [list \ | 
|---|
 | 808 |     1 {invoked "break" outside of a loop} \ | 
|---|
 | 809 |     1 {invoked "continue" outside of a loop} \ | 
|---|
 | 810 |     1 {invoked "break" outside of a loop} \ | 
|---|
 | 811 |     1 {invoked "continue" outside of a loop} \ | 
|---|
 | 812 |     0 {} \ | 
|---|
 | 813 |     1 {invoked "continue" outside of a loop} \ | 
|---|
 | 814 |     ] | 
|---|
 | 815 |  | 
|---|
 | 816 |  | 
|---|
 | 817 | # cleanup | 
|---|
 | 818 | ::tcltest::cleanupTests | 
|---|
 | 819 | return | 
|---|