[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 |
---|