Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/tests/for.test @ 25

Last change on this file since 25 was 25, checked in by landauf, 16 years ago

added tcl to libs

File size: 24.5 KB
Line 
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
14if {[lsearch [namespace children] ::tcltest] == -1} {
15    package require tcltest 2
16    namespace import -force ::tcltest::*
17}
18
19# Basic "for" operation.
20
21test for-1.1 {TclCompileForCmd: missing initial command} {
22    list [catch {for} msg] $msg
23} {1 {wrong # args: should be "for start test next command"}}
24test 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}"}}
29catch {unset i}
30test 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"}
34test 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<}"}
40test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
41    set i 0
42    for {} "$i > 5" {incr i} {}
43} {}
44test 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"}
48test 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"}
52test 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"*}
58catch {unset a}
59test 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}
67test 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}
72test 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}
83test 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"*}
89test 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}
123test for-1.14 {TclCompileForCmd: for command result} {
124    set a [for {set i 0} {$i < 5} {incr i} {}]
125    set a
126} {}
127test 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
134test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
135    catch {continue foo} msg
136    set msg
137} {wrong # args: should be "continue"}
138test for-2.2 {TclCompileContinueCmd: continue result} {
139    catch continue
140} 4
141test 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}
149test 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}
157test 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}
167test 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
205test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
206    catch {break foo} msg
207    set msg
208} {wrong # args: should be "break"}
209test for-3.2 {TclCompileBreakCmd: break result} {
210    catch break
211} 3
212test 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}
220test 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}
230test 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".
268proc 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}
475test for-3.6 {break tests} {
476    formatMail
477} {Return-path: <george@tcl>
478Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)
479        id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700
480Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>
481Mime-version: 1.0
482Content-type: text/plain; charset=iso-8859-1
483Content-transfer-encoding: quoted-printable
484Content-length: 2162
485To: fred
486Subject: tcl7.6
487Date: Wed, 11 Sep 1996 11:14:53 -0700
488From: George <george@tcl>
489The Tcl 7.6 and Tk 4.2 releases
490
491This page contains information about Tcl 7.6 and Tk4.2,
492 which are the most recent
493releases of the Tcl scripting language and the Tk toolk
494it. The first beta versions of these
495releases were released on August 30, 1996. These releas
496es contain only minor changes,
497so we hope to have only a single beta release and to
498go final in early October, 1996.
499
500
501What's new
502
503The most important changes in the releases are summariz
504ed below. See the README
505and changes files in the distributions for more complet
506e information on what has
507changed, including both feature changes and bug fixes.
508
509     There are new options to the file command for
510copying files (file copy),
511     deleting files and directories (file delete),
512creating directories (file
513     mkdir), and renaming files (file rename).
514     The implementation of exec has been improved great
515ly for Windows 95 and
516     Windows NT.
517     There is a new memory allocator for the Macintosh
518version, which should be
519     more efficient than the old one.
520     Tk's grid geometry manager has been completely
521rewritten. 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
526boxes:
527     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
528     tk_messageBox. These use native dialog boxes if
529they are available.
530     There is a new virtual event mechanism for handlin
531g events in a more portable
532     way. See the new command event. It also allows
533events (both physical and
534     virtual) to be generated dynamically.
535
536Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl
5377.5 and Tk 4.1 except for
538changes in the C APIs for custom channel drivers. Scrip
539ts written for earlier releases
540should work on these new releases as well.
541
542Obtaining The Releases
543
544Binary Releases
545
546Pre-compiled releases are available for the following
547platforms:
548
549     Windows 3.1, Windows 95, and Windows NT: Fetch
550     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
551execute it. The file is a
552     self-extracting executable. It will install the
553Tcl 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.
557The file is in binhex format,
558     which is understood by Fetch, StuffIt, and many
559other Mac utilities. The
560     unpacked file is a self-installing executable:
561double-click on it and it will create a
562     folder containing all that you need to run Tcl
563and Tk.
564        UNIX (Solaris 2.* and SunOS, other systems
565soon to follow). Easy to install
566     binary packages are now for sale at the Sun Labs
567Tcl/Tk Shop. Check it out!
568}
569
570# Check that "break" resets the interpreter's result
571
572test 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
584test 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
594test 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}
605test 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}
612test 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
628test 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"}
633test 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"}
638test 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"}
643test 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"}
648test 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"}
653test 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}"}}
662test 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}"}
667test 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
673test 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}"}
683test 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}
692test 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}
698test 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}
710test 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}"}
720test 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}
755test 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} {}
760test 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} {}
765test 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    ]
781test 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
819return
Note: See TracBrowser for help on using the repository browser.