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 © 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
12if {"::tcltest" ni [namespace children]} {
13    package require tcltest 2.5
14    namespace import -force ::tcltest::*
15}
16
17# Used for constraining memory leak tests
18testConstraint memory [llength [info commands memory]]
19if {[testConstraint memory]} {
20    proc meminfo {} {lindex [split [memory info] "\n"] 3 3}
21}
22
23# Basic "for" operation.
24
25test for-1.1 {TclCompileForCmd: missing initial command} {
26    list [catch {for} msg] $msg
27} {1 {wrong # args: should be "for start test next command"}}
28test for-1.2 {TclCompileForCmd: error in initial command} -body {
29    list [catch {for {set}} msg] $msg $::errorInfo
30} -match glob -result {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command"
31    while *ing
32"for {set}"}}
33catch {unset i}
34test for-1.3 {TclCompileForCmd: missing test expression} {
35    catch {for {set i 0}} msg
36    set msg
37} {wrong # args: should be "for start test next command"}
38test for-1.4 {TclCompileForCmd: error in test expression} -body {
39    catch {for {set i 0} {$i<}} msg
40    set ::errorInfo
41} -match glob -result {wrong # args: should be "for start test next command"
42    while *ing
43"for {set i 0} {$i<}"}
44test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
45    set i 0
46    for {} "$i > 5" {incr i} {}
47} {}
48test for-1.6 {TclCompileForCmd: missing "next" command} {
49    catch {for {set i 0} {$i < 5}} msg
50    set msg
51} {wrong # args: should be "for start test next command"}
52test for-1.7 {TclCompileForCmd: missing command body} {
53    catch {for {set i 0} {$i < 5} {incr i}} msg
54    set msg
55} {wrong # args: should be "for start test next command"}
56test for-1.8 {TclCompileForCmd: error compiling command body} -body {
57    catch {for {set i 0} {$i < 5} {incr i} {set}} msg
58    set ::errorInfo
59} -match glob -result {wrong # args: should be "set varName ?newValue?"
60    while *ing
61"set"*}
62catch {unset a}
63test for-1.9 {TclCompileForCmd: simple command body} {
64    set a {}
65    for {set i 1} {$i<6} {incr i} {
66	if {$i==4} break
67	set a [concat $a $i]
68    }
69    set a
70} {1 2 3}
71test for-1.10 {TclCompileForCmd: command body in quotes} {
72    set a {}
73    for {set i 1} {$i<6} {incr i} "append a x"
74    set a
75} {xxxxx}
76test for-1.11 {TclCompileForCmd: computed command body} {
77    catch {unset x1}
78    catch {unset bb}
79    catch {unset x2}
80    set x1 {append a x1; }
81    set bb {break}
82    set x2 {; append a x2}
83    set a {}
84    for {set i 1} {$i<6} {incr i} $x1$bb$x2
85    set a
86} {x1}
87test for-1.12 {TclCompileForCmd: error in "next" command} -body {
88    catch {for {set i 0} {$i < 5} {set} {format $i}} msg
89    set ::errorInfo
90} -match glob -result {wrong # args: should be "set varName ?newValue?"
91    while *ing
92"set"*}
93test for-1.13 {TclCompileForCmd: long command body} {
94    set a {}
95    for {set i 1} {$i<6} {incr i} {
96	if {$i==4} break
97	if {$i>5} continue
98	if {$i>6 && $tcl_platform(machine)=="xxx"} {
99	    catch {set a $a} msg
100	    catch {incr i 5} msg
101	    catch {incr i -5} msg
102	}
103	if {$i>6 && $tcl_platform(machine)=="xxx"} {
104	    catch {set a $a} msg
105	    catch {incr i 5} msg
106	    catch {incr i -5} msg
107	}
108	if {$i>6 && $tcl_platform(machine)=="xxx"} {
109	    catch {set a $a} msg
110	    catch {incr i 5} msg
111	    catch {incr i -5} msg
112	}
113	if {$i>6 && $tcl_platform(machine)=="xxx"} {
114	    catch {set a $a} msg
115	    catch {incr i 5} msg
116	    catch {incr i -5} msg
117	}
118	if {$i>6 && $tcl_platform(machine)=="xxx"} {
119	    catch {set a $a} msg
120	    catch {incr i 5} msg
121	    catch {incr i -5} msg
122	}
123	set a [concat $a $i]
124    }
125    set a
126} {1 2 3}
127test for-1.14 {TclCompileForCmd: for command result} {
128    set a [for {set i 0} {$i < 5} {incr i} {}]
129    set a
130} {}
131test for-1.15 {TclCompileForCmd: for command result} {
132    set a [for {set i 0} {$i < 5} {incr i} {if {$i==3} break}]
133    set a
134} {}
135
136# Check "for" and "continue".
137
138test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
139    catch {continue foo} msg
140    set msg
141} {wrong # args: should be "continue"}
142test for-2.2 {TclCompileContinueCmd: continue result} {
143    catch continue
144} 4
145test for-2.3 {continue tests} {
146    set a {}
147    for {set i 1} {$i <= 4} {incr i} {
148	if {$i == 2} continue
149	set a [concat $a $i]
150    }
151    set a
152} {1 3 4}
153test for-2.4 {continue tests} {
154    set a {}
155    for {set i 1} {$i <= 4} {incr i} {
156	if {$i != 2} continue
157	set a [concat $a $i]
158    }
159    set a
160} {2}
161test for-2.5 {continue tests, nested loops} {
162    set msg {}
163    for {set i 1} {$i <= 4} {incr i} {
164	for {set a 1} {$a <= 2} {incr a} {
165            if {$i>=2 && $a>=2} continue
166            set msg [concat $msg "$i.$a"]
167        }
168    }
169    set msg
170} {1.1 1.2 2.1 3.1 4.1}
171test for-2.6 {continue tests, long command body} {
172    set a {}
173    for {set i 1} {$i<6} {incr i} {
174	if {$i==2} continue
175	if {$i==4} break
176	if {$i>5} continue
177	if {$i>6 && $tcl_platform(machine)=="xxx"} {
178	    catch {set a $a} msg
179	    catch {incr i 5} msg
180	    catch {incr i -5} msg
181	}
182	if {$i>6 && $tcl_platform(machine)=="xxx"} {
183	    catch {set a $a} msg
184	    catch {incr i 5} msg
185	    catch {incr i -5} msg
186	}
187	if {$i>6 && $tcl_platform(machine)=="xxx"} {
188	    catch {set a $a} msg
189	    catch {incr i 5} msg
190	    catch {incr i -5} msg
191	}
192	if {$i>6 && $tcl_platform(machine)=="xxx"} {
193	    catch {set a $a} msg
194	    catch {incr i 5} msg
195	    catch {incr i -5} msg
196	}
197	if {$i>6 && $tcl_platform(machine)=="xxx"} {
198	    catch {set a $a} msg
199	    catch {incr i 5} msg
200	    catch {incr i -5} msg
201	}
202	set a [concat $a $i]
203    }
204    set a
205} {1 3}
206test for-2.7 {continue tests, uncompiled [for]} -body {
207    set file [makeFile {
208    	set guard 0
209	for {set i 20} {$i > 0} {incr i -1} {
210	    if {[incr guard]>30} {return BAD}
211	    continue
212	}
213	return GOOD
214    } source.file]
215    source $file
216} -cleanup {
217    removeFile source.file
218} -result GOOD
219
220# Check "for" and "break".
221
222test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
223    catch {break foo} msg
224    set msg
225} {wrong # args: should be "break"}
226test for-3.2 {TclCompileBreakCmd: break result} {
227    catch break
228} 3
229test for-3.3 {break tests} {
230    set a {}
231    for {set i 1} {$i <= 4} {incr i} {
232	if {$i == 3} break
233	set a [concat $a $i]
234    }
235    set a
236} {1 2}
237test for-3.4 {break tests, nested loops} {
238    set msg {}
239    for {set i 1} {$i <= 4} {incr i} {
240	for {set a 1} {$a <= 2} {incr a} {
241            if {$i>=2 && $a>=2} break
242            set msg [concat $msg "$i.$a"]
243        }
244    }
245    set msg
246} {1.1 1.2 2.1 3.1 4.1}
247test for-3.5 {break tests, long command body} {
248    set a {}
249    for {set i 1} {$i<6} {incr i} {
250	if {$i==2} continue
251	if {$i==5} break
252	if {$i>5} continue
253	if {$i>6 && $tcl_platform(machine)=="xxx"} {
254	    catch {set a $a} msg
255	    catch {incr i 5} msg
256	    catch {incr i -5} msg
257	}
258	if {$i>6 && $tcl_platform(machine)=="xxx"} {
259	    catch {set a $a} msg
260	    catch {incr i 5} msg
261	    catch {incr i -5} msg
262	}
263	if {$i>6 && $tcl_platform(machine)=="xxx"} {
264	    catch {set a $a} msg
265	    catch {incr i 5} msg
266	    catch {incr i -5} msg
267	}
268	if {$i==4} break
269	if {$i>6 && $tcl_platform(machine)=="xxx"} {
270	    catch {set a $a} msg
271	    catch {incr i 5} msg
272	    catch {incr i -5} msg
273	}
274	if {$i>6 && $tcl_platform(machine)=="xxx"} {
275	    catch {set a $a} msg
276	    catch {incr i 5} msg
277	    catch {incr i -5} msg
278	}
279	set a [concat $a $i]
280    }
281    set a
282} {1 3}
283# A simplified version of exmh's mail formatting routine to stress "for",
284# "break", "while", and "if".
285proc formatMail {} {
286    array set lines {
287        0 {Return-path: george@tcl} \
288        1 {Return-path: <george@tcl>} \
289        2 {Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)} \
290        3 {	id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700} \
291        4 {Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>} \
292        5 {X-mailer: exmh version 1.6.9 8/22/96} \
293        6 {Mime-version: 1.0} \
294        7 {Content-type: text/plain; charset=iso-8859-1} \
295        8 {Content-transfer-encoding: quoted-printable} \
296        9 {Content-length: 2162} \
297        10 {To: fred} \
298        11 {Subject: tcl7.6} \
299        12 {Date: Wed, 11 Sep 1996 11:14:53 -0700} \
300        13 {From: George <george@tcl>} \
301        14 {The Tcl 7.6 and Tk 4.2 releases} \
302        15 {} \
303        16 {This page contains information about Tcl 7.6 and Tk4.2, which are the most recent} \
304        17 {releases of the Tcl scripting language and the Tk toolkit. The first beta versions of these} \
305        18 {releases were released on August 30, 1996. These releases contain only minor changes,} \
306        19 {so we hope to have only a single beta release and to go final in early October, 1996.} \
307        20 {} \
308        21 {} \
309        22 {What's new} \
310        23 {} \
311        24 {The most important changes in the releases are summarized below. See the README} \
312        25 {and changes files in the distributions for more complete information on what has} \
313        26 {changed, including both feature changes and bug fixes.} \
314        27 {} \
315        28 {     There are new options to the file command for copying files (file copy),} \
316        29 {     deleting files and directories (file delete), creating directories (file} \
317        30 {     mkdir), and renaming files (file rename).} \
318        31 {     The implementation of exec has been improved greatly for Windows 95 and} \
319        32 {     Windows NT.} \
320        33 {     There is a new memory allocator for the Macintosh version, which should be} \
321        34 {     more efficient than the old one.} \
322        35 {     Tk's grid geometry manager has been completely rewritten. The layout} \
323        36 {     algorithm produces much better layouts than before, especially where rows or} \
324        37 {     columns were stretchable.} \
325        38 {     There are new commands for creating common dialog boxes:} \
326        39 {     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and} \
327        40 {     tk_messageBox. These use native dialog boxes if they are available.} \
328        41 {     There is a new virtual event mechanism for handling events in a more portable} \
329        42 {     way. See the new command event. It also allows events (both physical and} \
330        43 {     virtual) to be generated dynamically.} \
331        44 {} \
332        45 {Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for} \
333        46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \
334        47 {should work on these new releases as well.} \
335        48 {} \
336        49 {Obtaining The Releases} \
337        50 {} \
338        51 {Binary Releases} \
339        52 {} \
340        53 {Pre-compiled releases are available for the following platforms: } \
341        54 {} \
342        55 {     Windows 3.1, Windows 95, and Windows NT: Fetch} \
343        56 {     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \
344        57 {     self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \
345        58 {     tclsh programs, and documentation.} \
346        59 {     Macintosh (both 68K and PowerPC): Fetch} \
347        60 {     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \
348        61 {     which is understood by Fetch, StuffIt, and many other Mac utilities. The} \
349        62 {     unpacked file is a self-installing executable: double-click on it and it will create a} \
350        63 {     folder containing all that you need to run Tcl and Tk. } \
351        64 {        UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \
352        65 {     binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \
353    }
354    set result ""
355    set NL "
356"
357    set tag {level= type=text/plain part=0 sel Charset}
358    set ix [lsearch -regexp $tag text/enriched]
359    if {$ix < 0} {
360	set ranges {}
361	set quote 0
362    }
363    set breakrange {6.42 78.0}
364    set F1 [lindex $breakrange 0]
365    set F2 [lindex $breakrange 1]
366    set breakrange [lrange $breakrange 2 end]
367    if {[string length $F1] == 0} {
368	set F1 -1
369	set break 0
370    } else {
371	set break 1
372    }
373    set xmailer 0
374    set inheaders 1
375    set last [array size lines]
376    set plen 2
377    for {set L 1} {$L < $last} {incr L} {
378	set line $lines($L)
379	if {$inheaders} {
380	    # Blank or empty line terminates headers
381	    # Leading --- terminates headers
382	    if {[regexp {^[ 	]*$} $line] || [regexp {^--+} $line]} {
383		set inheaders 0
384	    }
385	    if {[regexp -nocase {^x-mailer:} $line]} {
386		continue
387	    }
388	}
389	if {$inheaders} {
390	    set limit 55
391	} else {
392	    set limit 55
393	    # Decide whether or not to break the body line
394	    if {$plen > 0} {
395		if {[string first {> } $line] == 0} {
396		    # This is quoted text from previous message, don't reformat
397		    append result $line $NL
398		    if {$quote && !$inheaders} {
399			# Fix from <sarr@umich.edu> to handle text/enriched
400			if {$L > $L1 && $L < $L2 && $line != {}} {
401			    # enriched requires two newlines for each one.
402			    append result $NL
403			} elseif {$L > $L2} {
404			    set L1 [lindex $ranges 0]
405			    set L2 [lindex $ranges 1]
406			    set ranges [lrange $ranges 2 end]
407			    set quote [llength $L1]
408			}
409		    }
410		    continue
411		}
412	    }
413	    if {$F1 < 0} {
414		# Nothing left to format
415		append result $line $NL
416		continue
417	    } elseif {$L < $F1} {
418		# Not yet to formatted block
419		append result $line $NL
420		continue
421	    } elseif {$L > $F2} {
422		# Past formatted block
423		set F1 [lindex $breakrange 0]
424		set F2 [lindex $breakrange 1]
425		set breakrange [lrange $breakrange 2 end]
426		append result $line $NL
427		if {[string length $F1] == 0} {
428		    set F1 -1
429		}
430		continue
431	    }
432	}
433	set climit [expr {$limit-1}]
434	set cutoff 50
435	set continuation 0
436
437	while {[string length $line] > $limit} {
438	    for {set c [expr {$limit-1}]} {$c >= $cutoff} {incr c -1} {
439		set char [string index $line $c]
440		if {$char == " " || $char == "\t"} {
441		    break
442		}
443		if {$char == ">"} {	;# Hack for enriched formatting
444		    break
445		}
446	    }
447	    if {$c < $cutoff} {
448		if {! $inheaders} {
449		    set c [expr {$limit-1}]
450		} else {
451		    set c [string length $line]
452		}
453	    }
454	    set newline [string trimright [string range $line 0 $c]]
455	    if {! $continuation} {
456		append result $newline $NL
457	    } else {
458		append result \ $newline $NL
459	    }
460	    incr c
461	    set line [string trimright [string range $line $c end]]
462	    if {$inheaders} {
463		set continuation 1
464		set limit $climit
465	    }
466	}
467	if {$continuation} {
468	    if {[string length $line] != 0} {
469		append result \ $line $NL
470	    }
471	} else {
472	    append result $line $NL
473	    if {$quote && !$inheaders} {
474		if {$L > $L1 && $L < $L2 && $line != {}} {
475		    # enriched requires two newlines for each one.
476		    append result "" $NL
477		} elseif {$L > $L2} {
478		    set L1 [lindex $ranges 0]
479		    set L2 [lindex $ranges 1]
480		    set ranges [lrange $ranges 2 end]
481		    set quote [llength $L1]
482		}
483	    }
484	}
485    }
486    return $result
487}
488test for-3.6 {break tests} {
489    formatMail
490} {Return-path: <george@tcl>
491Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)
492	id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700
493Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>
494Mime-version: 1.0
495Content-type: text/plain; charset=iso-8859-1
496Content-transfer-encoding: quoted-printable
497Content-length: 2162
498To: fred
499Subject: tcl7.6
500Date: Wed, 11 Sep 1996 11:14:53 -0700
501From: George <george@tcl>
502The Tcl 7.6 and Tk 4.2 releases
503
504This page contains information about Tcl 7.6 and Tk4.2,
505 which are the most recent
506releases of the Tcl scripting language and the Tk toolk
507it. The first beta versions of these
508releases were released on August 30, 1996. These releas
509es contain only minor changes,
510so we hope to have only a single beta release and to
511go final in early October, 1996.
512
513
514What's new
515
516The most important changes in the releases are summariz
517ed below. See the README
518and changes files in the distributions for more complet
519e information on what has
520changed, including both feature changes and bug fixes.
521
522     There are new options to the file command for
523copying files (file copy),
524     deleting files and directories (file delete),
525creating directories (file
526     mkdir), and renaming files (file rename).
527     The implementation of exec has been improved great
528ly for Windows 95 and
529     Windows NT.
530     There is a new memory allocator for the Macintosh
531version, which should be
532     more efficient than the old one.
533     Tk's grid geometry manager has been completely
534rewritten. The layout
535     algorithm produces much better layouts than before
536, especially where rows or
537     columns were stretchable.
538     There are new commands for creating common dialog
539boxes:
540     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
541     tk_messageBox. These use native dialog boxes if
542they are available.
543     There is a new virtual event mechanism for handlin
544g events in a more portable
545     way. See the new command event. It also allows
546events (both physical and
547     virtual) to be generated dynamically.
548
549Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl
5507.5 and Tk 4.1 except for
551changes in the C APIs for custom channel drivers. Scrip
552ts written for earlier releases
553should work on these new releases as well.
554
555Obtaining The Releases
556
557Binary Releases
558
559Pre-compiled releases are available for the following
560platforms:
561
562     Windows 3.1, Windows 95, and Windows NT: Fetch
563     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
564execute it. The file is a
565     self-extracting executable. It will install the
566Tcl and Tk libraries, the wish and
567     tclsh programs, and documentation.
568     Macintosh (both 68K and PowerPC): Fetch
569     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx.
570The file is in binhex format,
571     which is understood by Fetch, StuffIt, and many
572other Mac utilities. The
573     unpacked file is a self-installing executable:
574double-click on it and it will create a
575     folder containing all that you need to run Tcl
576and Tk.
577        UNIX (Solaris 2.* and SunOS, other systems
578soon to follow). Easy to install
579     binary packages are now for sale at the Sun Labs
580Tcl/Tk Shop. Check it out!
581}
582
583# Check that "break" resets the interpreter's result
584
585test for-4.1 {break must reset the interp result} {
586    catch {
587        set z GLOBTESTDIR/dir2/file2.c
588        if {[string match GLOBTESTDIR/dir2/* $z]} {
589            break
590        }
591    } j
592    set j
593} {}
594
595# Test for incorrect "double evaluation" semantics
596
597test for-5.1 {possible delayed substitution of increment command} {
598    # Increment should be 5, and lappend should always append $a
599    catch {unset a}
600    catch {unset i}
601    set a 5
602    set i {}
603    for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
604    set i
605} {1 6 11}
606
607test for-5.2 {possible delayed substitution of increment command} {
608    # Increment should be 5, and lappend should always append $a
609    catch {rename p ""}
610    proc p {} {
611	set a 5
612	set i {}
613	for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
614	set i
615    }
616    p
617} {1 6 11}
618test for-5.3 {possible delayed substitution of body command} {
619    # Increment should be $a, and lappend should always append 5
620    set a 5
621    set i {}
622    for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
623    set i
624} {5 5 5 5}
625test for-5.4 {possible delayed substitution of body command} {
626    # Increment should be $a, and lappend should always append 5
627    catch {rename p ""}
628    proc p {} {
629	set a 5
630	set i {}
631	for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
632	set i
633    }
634    p
635} {5 5 5 5}
636
637# In the following tests we need to bypass the bytecode compiler by
638# substituting the command from a variable.  This ensures that command
639# procedure is invoked directly.
640
641test for-6.1 {Tcl_ForObjCmd: number of args} {
642    set z for
643    catch {$z} msg
644    set msg
645} {wrong # args: should be "for start test next command"}
646test for-6.2 {Tcl_ForObjCmd: number of args} {
647    set z for
648    catch {$z {set i 0}} msg
649    set msg
650} {wrong # args: should be "for start test next command"}
651test for-6.3 {Tcl_ForObjCmd: number of args} {
652    set z for
653    catch {$z {set i 0} {$i < 5}} msg
654    set msg
655} {wrong # args: should be "for start test next command"}
656test for-6.4 {Tcl_ForObjCmd: number of args} {
657    set z for
658    catch {$z {set i 0} {$i < 5} {incr i}} msg
659    set msg
660} {wrong # args: should be "for start test next command"}
661test for-6.5 {Tcl_ForObjCmd: number of args} {
662    set z for
663    catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg
664    set msg
665} {wrong # args: should be "for start test next command"}
666test for-6.6 {Tcl_ForObjCmd: error in initial command} -body {
667    set z for
668    list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $::errorInfo
669} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
670    while *ing
671"set"
672    ("for" initial command)
673    invoked from within
674"$z {set} {$i < 5} {incr i} {body}"}}
675test for-6.7 {Tcl_ForObjCmd: error in test expression} -body {
676    set z for
677    catch {$z {set i 0} {i < 5} {incr i} {body}}
678    set ::errorInfo
679} -match glob -result {*"$z {set i 0} {i < 5} {incr i} {body}"}
680test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
681    set z for
682    set i 0
683    $z {set i 6} "$i > 5" {incr i} {set y $i}
684    set i
685} 6
686test for-6.9 {Tcl_ForObjCmd: error executing command body} -body {
687    set z for
688    catch {$z {set i 0} {$i < 5} {incr i} {set}} msg
689    set ::errorInfo
690} -match glob -result {wrong # args: should be "set varName ?newValue?"
691    while *ing
692"set"
693    ("for" body line 1)
694    invoked from within
695"$z {set i 0} {$i < 5} {incr i} {set}"}
696test for-6.10 {Tcl_ForObjCmd: simple command body} {
697    set z for
698    set a {}
699    $z {set i 1} {$i<6} {incr i} {
700	if {$i==4} break
701	set a [concat $a $i]
702    }
703    set a
704} {1 2 3}
705test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
706    set z for
707    set a {}
708    $z {set i 1} {$i<6} {incr i} "append a x"
709    set a
710} {xxxxx}
711test for-6.12 {Tcl_ForObjCmd: computed command body} {
712    set z for
713    catch {unset x1}
714    catch {unset bb}
715    catch {unset x2}
716    set x1 {append a x1; }
717    set bb {break}
718    set x2 {; append a x2}
719    set a {}
720    $z {set i 1} {$i<6} {incr i} $x1$bb$x2
721    set a
722} {x1}
723test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body {
724    set z for
725    catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg
726    set ::errorInfo
727} -match glob -result {wrong # args: should be "set varName ?newValue?"
728    while *ing
729"set"
730    ("for" loop-end command)
731    invoked from within
732"$z {set i 0} {$i < 5} {set} {set j 4}"}
733test for-6.14 {Tcl_ForObjCmd: long command body} {
734    set z for
735    set a {}
736    $z {set i 1} {$i<6} {incr i} {
737	if {$i==4} break
738	if {$i>5} continue
739	if {$i>6 && $tcl_platform(machine)=="xxx"} {
740	    catch {set a $a} msg
741	    catch {incr i 5} msg
742	    catch {incr i -5} msg
743	}
744	if {$i>6 && $tcl_platform(machine)=="xxx"} {
745	    catch {set a $a} msg
746	    catch {incr i 5} msg
747	    catch {incr i -5} msg
748	}
749	if {$i>6 && $tcl_platform(machine)=="xxx"} {
750	    catch {set a $a} msg
751	    catch {incr i 5} msg
752	    catch {incr i -5} msg
753	}
754	if {$i>6 && $tcl_platform(machine)=="xxx"} {
755	    catch {set a $a} msg
756	    catch {incr i 5} msg
757	    catch {incr i -5} msg
758	}
759	if {$i>6 && $tcl_platform(machine)=="xxx"} {
760	    catch {set a $a} msg
761	    catch {incr i 5} msg
762	    catch {incr i -5} msg
763	}
764	set a [concat $a $i]
765    }
766    set a
767} {1 2 3}
768test for-6.15 {Tcl_ForObjCmd: for command result} {
769    set z for
770    set a [$z {set i 0} {$i < 5} {incr i} {}]
771    set a
772} {}
773test for-6.16 {Tcl_ForObjCmd: for command result} {
774    set z for
775    set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
776    set a
777} {}
778test for-6.17 {Tcl_ForObjCmd: for command result} {
779    list \
780        [catch {for {break} {1} {} {}} err] $err \
781        [catch {for {continue} {1} {} {}} err] $err \
782        [catch {for {} {[break]} {} {}} err] $err \
783        [catch {for {} {[continue]} {} {}} err] $err \
784        [catch {for {} {1} {break} {}} err] $err \
785        [catch {for {} {1} {continue} {}} err] $err \
786} [list \
787    3 {} \
788    4 {} \
789    3 {} \
790    4 {} \
791    0 {} \
792    4 {} \
793    ]
794test for-6.18 {Tcl_ForObjCmd: for command result} {
795    proc p6181 {} {
796        for {break} {1} {} {}
797    }
798    proc p6182 {} {
799        for {continue} {1} {} {}
800    }
801    proc p6183 {} {
802        for {} {[break]} {} {}
803    }
804    proc p6184 {} {
805        for {} {[continue]} {} {}
806    }
807    proc p6185 {} {
808        for {} {1} {break} {}
809    }
810    proc p6186 {} {
811        for {} {1} {continue} {}
812    }
813    list \
814        [catch {p6181} err] $err \
815        [catch {p6182} err] $err \
816        [catch {p6183} err] $err \
817        [catch {p6184} err] $err \
818        [catch {p6185} err] $err \
819        [catch {p6186} err] $err
820} [list \
821    1 {invoked "break" outside of a loop} \
822    1 {invoked "continue" outside of a loop} \
823    1 {invoked "break" outside of a loop} \
824    1 {invoked "continue" outside of a loop} \
825    0 {} \
826    1 {invoked "continue" outside of a loop} \
827    ]
828
829test for-7.1 {Bug 3614226: ensure that break cleans up the stack} memory {
830    apply {{} {
831	# Can't use [memtest]; must be careful when we change stack frames
832	set end [meminfo]
833	for {set i 0} {$i < 5} {incr i} {
834	    for {set x 0} {$x < 5} {incr x} {
835		list a b c [break] d e f
836	    }
837	    set tmp $end
838	    set end [meminfo]
839	}
840	expr {$end - $tmp}
841    }}
842} 0
843test for-7.2 {Bug 3614226: ensure that continue cleans up the stack} memory {
844    apply {{} {
845	# Can't use [memtest]; must be careful when we change stack frames
846	set end [meminfo]
847	for {set i 0} {$i < 5} {incr i} {
848	    for {set x 0} {$x < 5} {incr x} {
849		list a b c [continue] d e f
850	    }
851	    set tmp $end
852	    set end [meminfo]
853	}
854	expr {$end - $tmp}
855    }}
856} 0
857test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} memory {
858    apply {{} {
859	# Can't use [memtest]; must be careful when we change stack frames
860	set end [meminfo]
861	for {set i 0} {$i < 5} {incr i} {
862	    for {set x 0} {[incr x]<50} {} {
863		puts {*}[puts a b c {*}[break] d e f]
864	    }
865	    set tmp $end
866	    set end [meminfo]
867	}
868	expr {$end - $tmp}
869    }}
870} 0
871test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} memory {
872    apply {{} {
873	# Can't use [memtest]; must be careful when we change stack frames
874	set end [meminfo]
875	for {set i 0} {$i < 5} {incr i} {
876	    for {set x 0} {[incr x]<50} {} {
877		puts {*}[puts a b c {*}[continue] d e f]
878	    }
879	    set tmp $end
880	    set end [meminfo]
881	}
882	expr {$end - $tmp}
883    }}
884} 0
885test for-7.5 {Bug 3614226: ensure that break cleans up the combination of main and expansion stack} memory {
886    apply {{} {
887	set l [lrepeat 50 p q r]
888	# Can't use [memtest]; must be careful when we change stack frames
889	set end [meminfo]
890	for {set i 0} {$i < 5} {incr i} {
891	    for {set x 0} {[incr x]<50} {} {
892		puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]]
893	    }
894	    set tmp $end
895	    set end [meminfo]
896	}
897	expr {$end - $tmp}
898    }}
899} 0
900test for-7.6 {Bug 3614226: ensure that continue cleans up the combination of main and expansion stack} memory {
901    apply {{} {
902	set l [lrepeat 50 p q r]
903	# Can't use [memtest]; must be careful when we change stack frames
904	set end [meminfo]
905	for {set i 0} {$i < 5} {incr i} {
906	    for {set x 0} {[incr x]<50} {} {
907		puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]]
908	    }
909	    set tmp $end
910	    set end [meminfo]
911	}
912	expr {$end - $tmp}
913    }}
914} 0
915test for-7.7 {Bug 3614226: ensure that break only cleans up the right amount} memory {
916    apply {{} {
917	set l [lrepeat 50 p q r]
918	# Can't use [memtest]; must be careful when we change stack frames
919	set end [meminfo]
920	for {set i 0} {$i < 5} {incr i} {
921	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
922		puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]]
923	    }]
924	    set tmp $end
925	    set end [meminfo]
926	}
927	expr {$end - $tmp}
928    }}
929} 0
930test for-7.8 {Bug 3614226: ensure that continue only cleans up the right amount} memory {
931    apply {{} {
932	set l [lrepeat 50 p q r]
933	# Can't use [memtest]; must be careful when we change stack frames
934	set end [meminfo]
935	for {set i 0} {$i < 5} {incr i} {
936	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
937		puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]]
938	    }]
939	    set tmp $end
940	    set end [meminfo]
941	}
942	expr {$end - $tmp}
943    }}
944} 0
945test for-7.9 {Bug 3614226: ensure that break from invoked command cleans up the stack} memory {
946    apply {{} {
947	# Can't use [memtest]; must be careful when we change stack frames
948	set end [meminfo]
949	for {set i 0} {$i < 5} {incr i} {
950	    for {set x 0} {$x < 5} {incr x} {
951		list a b c [apply {{} {return -code break}}] d e f
952	    }
953	    set tmp $end
954	    set end [meminfo]
955	}
956	expr {$end - $tmp}
957    }}
958} 0
959test for-7.10 {Bug 3614226: ensure that continue from invoked command cleans up the stack} memory {
960    apply {{} {
961	# Can't use [memtest]; must be careful when we change stack frames
962	set end [meminfo]
963	for {set i 0} {$i < 5} {incr i} {
964	    for {set x 0} {$x < 5} {incr x} {
965		list a b c [apply {{} {return -code continue}}] d e f
966	    }
967	    set tmp $end
968	    set end [meminfo]
969	}
970	expr {$end - $tmp}
971    }}
972} 0
973test for-7.11 {Bug 3614226: ensure that break from invoked command cleans up the expansion stack} memory {
974    apply {{} {
975	# Can't use [memtest]; must be careful when we change stack frames
976	set end [meminfo]
977	for {set i 0} {$i < 5} {incr i} {
978	    for {set x 0} {[incr x]<50} {} {
979		puts {*}[puts a b c {*}[apply {{} {return -code break}}] d e f]
980	    }
981	    set tmp $end
982	    set end [meminfo]
983	}
984	expr {$end - $tmp}
985    }}
986} 0
987test for-7.12 {Bug 3614226: ensure that continue from invoked command cleans up the expansion stack} memory {
988    apply {{} {
989	# Can't use [memtest]; must be careful when we change stack frames
990	set end [meminfo]
991	for {set i 0} {$i < 5} {incr i} {
992	    for {set x 0} {[incr x]<50} {} {
993		puts {*}[puts a b c {*}[apply {{} {
994		    return -code continue
995		}}] d e f]
996	    }
997	    set tmp $end
998	    set end [meminfo]
999	}
1000	expr {$end - $tmp}
1001    }}
1002} 0
1003test for-7.13 {Bug 3614226: ensure that break from invoked command cleans up the combination of main and expansion stack} memory {
1004    apply {{} {
1005	set l [lrepeat 50 p q r]
1006	# Can't use [memtest]; must be careful when we change stack frames
1007	set end [meminfo]
1008	for {set i 0} {$i < 5} {incr i} {
1009	    for {set x 0} {[incr x]<50} {} {
1010		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
1011		    return -code break
1012		}}] d e f]]
1013	    }
1014	    set tmp $end
1015	    set end [meminfo]
1016	}
1017	expr {$end - $tmp}
1018    }}
1019} 0
1020test for-7.14 {Bug 3614226: ensure that continue from invoked command cleans up the combination of main and expansion stack} memory {
1021    apply {{} {
1022	set l [lrepeat 50 p q r]
1023	# Can't use [memtest]; must be careful when we change stack frames
1024	set end [meminfo]
1025	for {set i 0} {$i < 5} {incr i} {
1026	    for {set x 0} {[incr x]<50} {} {
1027		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
1028		    return -code continue
1029		}}] d e f]]
1030	    }
1031	    set tmp $end
1032	    set end [meminfo]
1033	}
1034	expr {$end - $tmp}
1035    }}
1036} 0
1037test for-7.15 {Bug 3614226: ensure that break from invoked command only cleans up the right amount} memory {
1038    apply {{} {
1039	set l [lrepeat 50 p q r]
1040	# Can't use [memtest]; must be careful when we change stack frames
1041	set end [meminfo]
1042	for {set i 0} {$i < 5} {incr i} {
1043	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
1044		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
1045		    return -code break
1046		}}] d e f]]
1047	    }]
1048	    set tmp $end
1049	    set end [meminfo]
1050	}
1051	expr {$end - $tmp}
1052    }}
1053} 0
1054test for-7.16 {Bug 3614226: ensure that continue from invoked command only cleans up the right amount} memory {
1055    apply {{} {
1056	set l [lrepeat 50 p q r]
1057	# Can't use [memtest]; must be careful when we change stack frames
1058	set end [meminfo]
1059	for {set i 0} {$i < 5} {incr i} {
1060	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
1061		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
1062		    return -code continue
1063		}}] d e f]]
1064	    }]
1065	    set tmp $end
1066	    set end [meminfo]
1067	}
1068	expr {$end - $tmp}
1069    }}
1070} 0
1071test for-7.17 {Bug 3614226: ensure that break from expanded command cleans up the stack} memory {
1072    apply {op {
1073	# Can't use [memtest]; must be careful when we change stack frames
1074	set end [meminfo]
1075	for {set i 0} {$i < 5} {incr i} {
1076	    for {set x 0} {$x < 5} {incr x} {
1077		list a b c [{*}$op] d e f
1078	    }
1079	    set tmp $end
1080	    set end [meminfo]
1081	}
1082	expr {$end - $tmp}
1083    }} {return -level 0 -code break}
1084} 0
1085test for-7.18 {Bug 3614226: ensure that continue from expanded command cleans up the stack} memory {
1086    apply {op {
1087	# Can't use [memtest]; must be careful when we change stack frames
1088	set end [meminfo]
1089	for {set i 0} {$i < 5} {incr i} {
1090	    for {set x 0} {$x < 5} {incr x} {
1091		list a b c [{*}$op] d e f
1092	    }
1093	    set tmp $end
1094	    set end [meminfo]
1095	}
1096	expr {$end - $tmp}
1097    }} {return -level 0 -code continue}
1098} 0
1099test for-7.19 {Bug 3614226: ensure that break from expanded command cleans up the expansion stack} memory {
1100    apply {op {
1101	# Can't use [memtest]; must be careful when we change stack frames
1102	set end [meminfo]
1103	for {set i 0} {$i < 5} {incr i} {
1104	    for {set x 0} {[incr x]<50} {} {
1105		puts {*}[puts a b c {*}[{*}$op] d e f]
1106	    }
1107	    set tmp $end
1108	    set end [meminfo]
1109	}
1110	expr {$end - $tmp}
1111    }} {return -level 0 -code break}
1112} 0
1113test for-7.20 {Bug 3614226: ensure that continue from expanded command cleans up the expansion stack} memory {
1114    apply {op {
1115	# Can't use [memtest]; must be careful when we change stack frames
1116	set end [meminfo]
1117	for {set i 0} {$i < 5} {incr i} {
1118	    for {set x 0} {[incr x]<50} {} {
1119		puts {*}[puts a b c {*}[{*}$op] d e f]
1120	    }
1121	    set tmp $end
1122	    set end [meminfo]
1123	}
1124	expr {$end - $tmp}
1125    }} {return -level 0 -code continue}
1126} 0
1127test for-7.21 {Bug 3614226: ensure that break from expanded command cleans up the combination of main and expansion stack} memory {
1128    apply {op {
1129	set l [lrepeat 50 p q r]
1130	# Can't use [memtest]; must be careful when we change stack frames
1131	set end [meminfo]
1132	for {set i 0} {$i < 5} {incr i} {
1133	    for {set x 0} {[incr x]<50} {} {
1134		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
1135	    }
1136	    set tmp $end
1137	    set end [meminfo]
1138	}
1139	expr {$end - $tmp}
1140    }} {return -level 0 -code break}
1141} 0
1142test for-7.22 {Bug 3614226: ensure that continue from expanded command cleans up the combination of main and expansion stack} memory {
1143    apply {op {
1144	set l [lrepeat 50 p q r]
1145	# Can't use [memtest]; must be careful when we change stack frames
1146	set end [meminfo]
1147	for {set i 0} {$i < 5} {incr i} {
1148	    for {set x 0} {[incr x]<50} {} {
1149		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
1150	    }
1151	    set tmp $end
1152	    set end [meminfo]
1153	}
1154	expr {$end - $tmp}
1155    }} {return -level 0 -code continue}
1156} 0
1157test for-7.23 {Bug 3614226: ensure that break from expanded command only cleans up the right amount} memory {
1158    apply {op {
1159	set l [lrepeat 50 p q r]
1160	# Can't use [memtest]; must be careful when we change stack frames
1161	set end [meminfo]
1162	for {set i 0} {$i < 5} {incr i} {
1163	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
1164		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
1165	    }]
1166	    set tmp $end
1167	    set end [meminfo]
1168	}
1169	expr {$end - $tmp}
1170    }} {return -level 0 -code break}
1171} 0
1172test for-7.24 {Bug 3614226: ensure that continue from expanded command only cleans up the right amount} memory {
1173    apply {op {
1174	set l [lrepeat 50 p q r]
1175	# Can't use [memtest]; must be careful when we change stack frames
1176	set end [meminfo]
1177	for {set i 0} {$i < 5} {incr i} {
1178	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
1179		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
1180	    }]
1181	    set tmp $end
1182	    set end [meminfo]
1183	}
1184	expr {$end - $tmp}
1185    }} {return -level 0 -code continue}
1186} 0
1187
1188test for-8.0 {Coverity CID 1251203: break vs continue in for-step clause} {
1189    apply {{} {
1190	for {set k 0} {$k < 3} {incr k} {
1191	    set j 0
1192	    list a [\
1193	    for {set i 0} {$i < 5} {incr i; list a [eval {}]} {
1194		incr j
1195	    }]
1196	    incr i
1197	}
1198	list $i $j $k
1199    }}
1200} {6 5 3}
1201test for-8.1 {Coverity CID 1251203: break vs continue in for-step clause} {
1202    apply {{} {
1203	for {set k 0} {$k < 3} {incr k} {
1204	    set j 0
1205	    list a [\
1206	    for {set i 0} {$i < 5} {incr i;list a [eval break]} {
1207		incr j
1208	    }]
1209	    incr i
1210	}
1211	list $i $j $k
1212    }}
1213} {2 1 3}
1214test for-8.2 {Coverity CID 1251203: break vs continue in for-step clause} {
1215    apply {{} {
1216	for {set k 0} {$k < 3} {incr k} {
1217	    set j 0
1218	    list a [\
1219	    for {set i 0} {$i < 5} {incr i;list a [eval continue]} {
1220		incr j
1221	    }]
1222	    incr i
1223	}
1224	list $i $j $k
1225    }}
1226} {1 1 3}
1227test for-8.3 {break in for-step clause} {
1228    apply {{} {
1229	for {set k 0} {$k < 3} {incr k} {
1230	    set j 0
1231	    list a [\
1232	    for {set i 0} {$i < 5} {incr i; break} {
1233		incr j
1234	    }]
1235	    incr i
1236	}
1237	list $i $j $k
1238    }}
1239} {2 1 3}
1240test for-8.4 {continue in for-step clause} {
1241    apply {{} {
1242	for {set k 0} {$k < 3} {incr k} {
1243	    set j 0
1244	    list a [\
1245	    for {set i 0} {$i < 5} {incr i; continue} {
1246		incr j
1247	    }]
1248	    incr i
1249	}
1250	list $i $j $k
1251    }}
1252} {1 1 3}
1253test for-8.5 {break in for-step clause} {
1254    apply {{} {
1255	for {set k 0} {$k < 3} {incr k} {
1256	    set j 0
1257	    list a [\
1258	    for {set i 0} {$i < 5} {incr i; list a [break]} {
1259		incr j
1260	    }]
1261	    incr i
1262	}
1263	list $i $j $k
1264    }}
1265} {2 1 3}
1266test for-8.6 {continue in for-step clause} {
1267    apply {{} {
1268	for {set k 0} {$k < 3} {incr k} {
1269	    set j 0
1270	    list a [\
1271	    for {set i 0} {$i < 5} {incr i; list a [continue]} {
1272		incr j
1273	    }]
1274	    incr i
1275	}
1276	list $i $j $k
1277    }}
1278} {1 1 3}
1279test for-8.7 {break in for-step clause} {
1280    apply {{} {
1281	for {set k 0} {$k < 3} {incr k} {
1282	    set j 0
1283	    list a [\
1284	    for {set i 0} {$i < 5} {incr i;eval break} {
1285		incr j
1286	    }]
1287	    incr i
1288	}
1289	list $i $j $k
1290    }}
1291} {2 1 3}
1292test for-8.8 {continue in for-step clause} {
1293    apply {{} {
1294	for {set k 0} {$k < 3} {incr k} {
1295	    set j 0
1296	    list a [\
1297	    for {set i 0} {$i < 5} {incr i;eval continue} {
1298		incr j
1299	    }]
1300	    incr i
1301	}
1302	list $i $j $k
1303    }}
1304} {1 1 3}
1305test for-8.9 {break in for-step clause} {
1306    apply {{} {
1307	for {set k 0} {$k < 3} {incr k} {
1308	    set j 0
1309	    for {set i 0} {$i < 5} {incr i;eval break} {
1310		incr j
1311	    }
1312	    incr i
1313	}
1314	list $i $j $k
1315    }}
1316} {2 1 3}
1317test for-8.10 {continue in for-step clause} {
1318    apply {{} {
1319	for {set k 0} {$k < 3} {incr k} {
1320	    set j 0
1321	    for {set i 0} {$i < 5} {incr i;eval continue} {
1322		incr j
1323	    }
1324	    incr i
1325	}
1326	list $i $j $k
1327    }}
1328} {1 1 3}
1329test for-8.11 {break in for-step clause} {
1330    apply {{} {
1331	for {set k 0} {$k < 3} {incr k} {
1332	    set j 0
1333	    for {set i 0} {$i < 5} {incr i;break} {
1334		incr j
1335	    }
1336	    incr i
1337	}
1338	list $i $j $k
1339    }}
1340} {2 1 3}
1341test for-8.12 {continue in for-step clause} {
1342    apply {{} {
1343	for {set k 0} {$k < 3} {incr k} {
1344	    set j 0
1345	    for {set i 0} {$i < 5} {incr i;continue} {
1346		incr j
1347	    }
1348	    incr i
1349	}
1350	list $i $j $k
1351    }}
1352} {1 1 3}
1353
1354# cleanup
1355::tcltest::cleanupTests
1356return
1357
1358# Local Variables:
1359# mode: tcl
1360# End:
1361