OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [for.test] - Blame information for rev 578

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# 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.1.1.1 2002-01-16 10:25:36 markom Exp $
13
 
14
if {[string compare test [info procs test]] == 1} then {source defs}
15
 
16
# Basic "for" operation.
17
 
18
test for-1.1 {TclCompileForCmd: missing initial command} {
19
    list [catch {for} msg] $msg
20
} {1 {wrong # args: should be "for start test next command"}}
21
test for-1.2 {TclCompileForCmd: error in initial command} {
22
    list [catch {for {set}} msg] $msg $errorInfo
23
} {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command"
24
    while compiling
25
"for {set}"}}
26
catch {unset i}
27
test for-1.3 {TclCompileForCmd: missing test expression} {
28
    catch {for {set i 0}} msg
29
    set msg
30
} {wrong # args: should be "for start test next command"}
31
test for-1.4 {TclCompileForCmd: error in test expression} {
32
    catch {for {set i 0} {$i<}} msg
33
    set errorInfo
34
} {wrong # args: should be "for start test next command"
35
    while compiling
36
"for {set i 0} {$i<}"}
37
test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
38
    set i 0
39
    for {} "$i > 5" {incr i} {}
40
} {}
41
test for-1.6 {TclCompileForCmd: missing "next" command} {
42
    catch {for {set i 0} {$i < 5}} msg
43
    set msg
44
} {wrong # args: should be "for start test next command"}
45
test for-1.7 {TclCompileForCmd: missing command body} {
46
    catch {for {set i 0} {$i < 5} {incr i}} msg
47
    set msg
48
} {wrong # args: should be "for start test next command"}
49
test for-1.8 {TclCompileForCmd: error compiling command body} {
50
    catch {for {set i 0} {$i < 5} {incr i} {set}} msg
51
    set errorInfo
52
} {wrong # args: should be "set varName ?newValue?"
53
    while compiling
54
"set"
55
    ("for" body line 1)
56
    while compiling
57
"for {set i 0} {$i < 5} {incr i} {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} {
84
    catch {for {set i 0} {$i < 5} {set} {puts $i}} msg
85
    set errorInfo
86
} {wrong # args: should be "set varName ?newValue?"
87
    while compiling
88
"set"
89
    ("for" loop-end command)
90
    while compiling
91
"for {set i 0} {$i < 5} {set} {puts $i}"}
92
test for-1.13 {TclCompileForCmd: long command body} {
93
    set a {}
94
    for {set i 1} {$i<6} {set i [expr $i+1]} {
95
        if $i==4 break
96
        if $i>5 continue
97
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
98
            catch {set a $a} msg
99
            catch {incr i 5} msg
100
            catch {incr i -5} msg
101
        }
102
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
103
            catch {set a $a} msg
104
            catch {incr i 5} msg
105
            catch {incr i -5} msg
106
        }
107
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
108
            catch {set a $a} msg
109
            catch {incr i 5} msg
110
            catch {incr i -5} msg
111
        }
112
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
113
            catch {set a $a} msg
114
            catch {incr i 5} msg
115
            catch {incr i -5} msg
116
        }
117
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
118
            catch {set a $a} msg
119
            catch {incr i 5} msg
120
            catch {incr i -5} msg
121
        }
122
        set a [concat $a $i]
123
    }
124
    set a
125
} {1 2 3}
126
test for-1.14 {TclCompileForCmd: for command result} {
127
    set a [for {set i 0} {$i < 5} {incr i} {}]
128
    set a
129
} {}
130
test for-1.15 {TclCompileForCmd: for command result} {
131
    set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}]
132
    set a
133
} {}
134
 
135
# Check "for" and "continue".
136
 
137
test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
138
    catch {continue foo} msg
139
    set msg
140
} {wrong # args: should be "continue"}
141
test for-2.2 {TclCompileContinueCmd: continue result} {
142
    catch continue
143
} 4
144
test for-2.3 {continue tests} {
145
    set a {}
146
    for {set i 1} {$i <= 4} {set i [expr $i+1]} {
147
        if {$i == 2} continue
148
        set a [concat $a $i]
149
    }
150
    set a
151
} {1 3 4}
152
test for-2.4 {continue tests} {
153
    set a {}
154
    for {set i 1} {$i <= 4} {set i [expr $i+1]} {
155
        if {$i != 2} continue
156
        set a [concat $a $i]
157
    }
158
    set a
159
} {2}
160
test for-2.5 {continue tests, nested loops} {
161
    set msg {}
162
    for {set i 1} {$i <= 4} {incr i} {
163
        for {set a 1} {$a <= 2} {incr a} {
164
            if {$i>=2 && $a>=2} continue
165
            set msg [concat $msg "$i.$a"]
166
        }
167
    }
168
    set msg
169
} {1.1 1.2 2.1 3.1 4.1}
170
test for-2.6 {continue tests, long command body} {
171
    set a {}
172
    for {set i 1} {$i<6} {set i [expr $i+1]} {
173
        if $i==2 continue
174
        if $i==4 break
175
        if $i>5 continue
176
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
177
            catch {set a $a} msg
178
            catch {incr i 5} msg
179
            catch {incr i -5} msg
180
        }
181
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
182
            catch {set a $a} msg
183
            catch {incr i 5} msg
184
            catch {incr i -5} msg
185
        }
186
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
187
            catch {set a $a} msg
188
            catch {incr i 5} msg
189
            catch {incr i -5} msg
190
        }
191
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
192
            catch {set a $a} msg
193
            catch {incr i 5} msg
194
            catch {incr i -5} msg
195
        }
196
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
197
            catch {set a $a} msg
198
            catch {incr i 5} msg
199
            catch {incr i -5} msg
200
        }
201
        set a [concat $a $i]
202
    }
203
    set a
204
} {1 3}
205
 
206
# Check "for" and "break".
207
 
208
test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
209
    catch {break foo} msg
210
    set msg
211
} {wrong # args: should be "break"}
212
test for-3.2 {TclCompileBreakCmd: break result} {
213
    catch break
214
} 3
215
test for-3.3 {break tests} {
216
    set a {}
217
    for {set i 1} {$i <= 4} {incr i} {
218
        if {$i == 3} break
219
        set a [concat $a $i]
220
    }
221
    set a
222
} {1 2}
223
test for-3.4 {break tests, nested loops} {
224
    set msg {}
225
    for {set i 1} {$i <= 4} {incr i} {
226
        for {set a 1} {$a <= 2} {incr a} {
227
            if {$i>=2 && $a>=2} break
228
            set msg [concat $msg "$i.$a"]
229
        }
230
    }
231
    set msg
232
} {1.1 1.2 2.1 3.1 4.1}
233
test for-3.5 {break tests, long command body} {
234
    set a {}
235
    for {set i 1} {$i<6} {set i [expr $i+1]} {
236
        if $i==2 continue
237
        if $i==5 break
238
        if $i>5 continue
239
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
240
            catch {set a $a} msg
241
            catch {incr i 5} msg
242
            catch {incr i -5} msg
243
        }
244
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
245
            catch {set a $a} msg
246
            catch {incr i 5} msg
247
            catch {incr i -5} msg
248
        }
249
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
250
            catch {set a $a} msg
251
            catch {incr i 5} msg
252
            catch {incr i -5} msg
253
        }
254
        if $i==4 break
255
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
256
            catch {set a $a} msg
257
            catch {incr i 5} msg
258
            catch {incr i -5} msg
259
        }
260
        if {$i>6 && $tcl_platform(machine)=="xxx"} {
261
            catch {set a $a} msg
262
            catch {incr i 5} msg
263
            catch {incr i -5} msg
264
        }
265
        set a [concat $a $i]
266
    }
267
    set a
268
} {1 3}
269
# A simplified version of exmh's mail formatting routine to stress "for",
270
# "break", "while", and "if".
271
proc formatMail {} {
272
    array set lines {
273
 
274
        1 {Return-path: } \
275
        2 {Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)} \
276
        3 {     id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700} \
277
        4 {Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>} \
278
        5 {X-mailer: exmh version 1.6.9 8/22/96} \
279
        6 {Mime-version: 1.0} \
280
        7 {Content-type: text/plain; charset=iso-8859-1} \
281
        8 {Content-transfer-encoding: quoted-printable} \
282
        9 {Content-length: 2162} \
283
        10 {To: fred} \
284
        11 {Subject: tcl7.6} \
285
        12 {Date: Wed, 11 Sep 1996 11:14:53 -0700} \
286
        13 {From: George } \
287
        14 {The Tcl 7.6 and Tk 4.2 releases} \
288
        15 {} \
289
        16 {This page contains information about Tcl 7.6 and Tk4.2, which are the most recent} \
290
        17 {releases of the Tcl scripting language and the Tk toolkit. The first beta versions of these} \
291
        18 {releases were released on August 30, 1996. These releases contain only minor changes,} \
292
        19 {so we hope to have only a single beta release and to go final in early October, 1996. } \
293
        20 {} \
294
        21 {} \
295
        22 {What's new } \
296
        23 {} \
297
        24 {The most important changes in the releases are summarized below. See the README} \
298
        25 {and changes files in the distributions for more complete information on what has} \
299
        26 {changed, including both feature changes and bug fixes. } \
300
        27 {} \
301
        28 {     There are new options to the file command for copying files (file copy),} \
302
        29 {     deleting files and directories (file delete), creating directories (file} \
303
        30 {     mkdir), and renaming files (file rename). } \
304
        31 {     The implementation of exec has been improved greatly for Windows 95 and} \
305
        32 {     Windows NT. } \
306
        33 {     There is a new memory allocator for the Macintosh version, which should be} \
307
        34 {     more efficient than the old one. } \
308
        35 {     Tk's grid geometry manager has been completely rewritten. The layout} \
309
        36 {     algorithm produces much better layouts than before, especially where rows or} \
310
        37 {     columns were stretchable. } \
311
        38 {     There are new commands for creating common dialog boxes:} \
312
        39 {     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and} \
313
        40 {     tk_messageBox. These use native dialog boxes if they are available. } \
314
        41 {     There is a new virtual event mechanism for handling events in a more portable} \
315
        42 {     way. See the new command event. It also allows events (both physical and} \
316
        43 {     virtual) to be generated dynamically. } \
317
        44 {} \
318
        45 {Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for} \
319
        46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \
320
        47 {should work on these new releases as well. } \
321
        48 {} \
322
        49 {Obtaining The Releases} \
323
        50 {} \
324
        51 {Binary Releases} \
325
        52 {} \
326
        53 {Pre-compiled releases are available for the following platforms: } \
327
        54 {} \
328
        55 {     Windows 3.1, Windows 95, and Windows NT: Fetch} \
329
        56 {     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \
330
        57 {     self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \
331
        58 {     tclsh programs, and documentation. } \
332
        59 {     Macintosh (both 68K and PowerPC): Fetch} \
333
        60 {     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \
334
        61 {     which is understood by Fetch, StuffIt, and many other Mac utilities. The} \
335
        62 {     unpacked file is a self-installing executable: double-click on it and it will create a} \
336
        63 {     folder containing all that you need to run Tcl and Tk. } \
337
        64 {        UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \
338
        65 {     binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \
339
    }
340
 
341
    set result ""
342
    set NL "
343
"
344
    set tag {level= type=text/plain part=0 sel Charset}
345
    set ix [lsearch -regexp $tag text/enriched]
346
    if {$ix < 0} {
347
        set ranges {}
348
        set quote 0
349
    }
350
    set breakrange {6.42 78.0}
351
    set F1 [lindex $breakrange 0]
352
    set F2 [lindex $breakrange 1]
353
    set breakrange [lrange $breakrange 2 end]
354
    if {[string length $F1] == 0} {
355
        set F1 -1
356
        set break 0
357
    } else {
358
        set break 1
359
    }
360
 
361
    set xmailer 0
362
    set inheaders 1
363
    set last [array size lines]
364
    set plen 2
365
    for {set L 1} {$L < $last} {incr L} {
366
        set line $lines($L)
367
        if {$inheaders} {
368
            # Blank or empty line terminates headers
369
            # Leading --- terminates headers
370
            if {[regexp {^[     ]*$} $line] || [regexp {^--+} $line]} {
371
                set inheaders 0
372
            }
373
            if {[regexp -nocase {^x-mailer:} $line]} {
374
                continue
375
            }
376
        }
377
        if $inheaders {
378
            set limit 55
379
        } else {
380
            set limit 55
381
 
382
            # Decide whether or not to break the body line
383
 
384
            if {$plen > 0} {
385
                if {[string first {> } $line] == 0} {
386
                    # This is quoted text from previous message, don't reformat
387
                    append result $line $NL
388
                    if {$quote && !$inheaders} {
389
                        # Fix from  to handle text/enriched
390
                        if {$L > $L1 && $L < $L2 && $line != {}} {
391
                            # enriched requires two newlines for each one.
392
                            append result $NL
393
                        } elseif {$L > $L2} {
394
                            set L1 [lindex $ranges 0]
395
                            set L2 [lindex $ranges 1]
396
                            set ranges [lrange $ranges 2 end]
397
                            set quote [llength $L1]
398
                        }
399
                    }
400
                    continue
401
                }
402
            }
403
            if {$F1 < 0} {
404
                # Nothing left to format
405
                append result $line $NL
406
                continue
407
            } elseif {$L < $F1} {
408
                # Not yet to formatted block
409
                append result $line $NL
410
                continue
411
            } elseif {$L > $F2} {
412
                # Past formatted block
413
                set F1 [lindex $breakrange 0]
414
                set F2 [lindex $breakrange 1]
415
                set breakrange [lrange $breakrange 2 end]
416
                append result $line $NL
417
                if {[string length $F1] == 0} {
418
                    set F1 -1
419
                }
420
                continue
421
            }
422
        }
423
        set climit [expr $limit-1]
424
        set cutoff 50
425
        set continuation 0
426
 
427
        while {[string length $line] > $limit} {
428
            for {set c [expr $limit-1]} {$c >= $cutoff} {incr c -1} {
429
                set char [string index $line $c]
430
                if {$char == " " || $char == "\t"} {
431
                    break
432
                }
433
                if {$char == ">"} {     ;# Hack for enriched formatting
434
                    break
435
                }
436
            }
437
            if {$c < $cutoff} {
438
                if {! $inheaders} {
439
                    set c [expr $limit-1]
440
                } else {
441
                    set c [string length $line]
442
                }
443
            }
444
            set newline [string range $line 0 $c]
445
            if {! $continuation} {
446
                append result $newline $NL
447
            } else {
448
                append result \ $newline $NL
449
            }
450
            incr c
451
            set line [string trimright [string range $line $c end]]
452
            if {$inheaders} {
453
                set continuation 1
454
                set limit $climit
455
            }
456
        }
457
        if {$continuation} {
458
            if {[string length $line] != 0} {
459
                append result \ $line $NL
460
            }
461
        } else {
462
            append result $line $NL
463
            if {$quote && !$inheaders} {
464
                if {$L > $L1 && $L < $L2 && $line != {}} {
465
                    # enriched requires two newlines for each one.
466
                    append result "" $NL
467
                } elseif {$L > $L2} {
468
                    set L1 [lindex $ranges 0]
469
                    set L2 [lindex $ranges 1]
470
                    set ranges [lrange $ranges 2 end]
471
                    set quote [llength $L1]
472
                }
473
            }
474
        }
475
    }
476
    return $result
477
}
478
test for-3.6 {break tests} {
479
    formatMail
480
} {Return-path: 
481
Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)
482
        id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700
483
Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>
484
Mime-version: 1.0
485
Content-type: text/plain; charset=iso-8859-1
486
Content-transfer-encoding: quoted-printable
487
Content-length: 2162
488
To: fred
489
Subject: tcl7.6
490
Date: Wed, 11 Sep 1996 11:14:53 -0700
491
From: George 
492
The Tcl 7.6 and Tk 4.2 releases
493
 
494
This page contains information about Tcl 7.6 and Tk4.2,
495
 which are the most recent
496
releases of the Tcl scripting language and the Tk toolk
497
it. The first beta versions of these
498
releases were released on August 30, 1996. These releas
499
es contain only minor changes,
500
so we hope to have only a single beta release and to
501
go final in early October, 1996.
502
 
503
 
504
What's new
505
 
506
The most important changes in the releases are summariz
507
ed below. See the README
508
and changes files in the distributions for more complet
509
e information on what has
510
changed, including both feature changes and bug fixes.
511
 
512
     There are new options to the file command for
513
copying files (file copy),
514
     deleting files and directories (file delete),
515
creating directories (file
516
     mkdir), and renaming files (file rename).
517
     The implementation of exec has been improved great
518
ly for Windows 95 and
519
     Windows NT.
520
     There is a new memory allocator for the Macintosh
521
version, which should be
522
     more efficient than the old one.
523
     Tk's grid geometry manager has been completely
524
rewritten. The layout
525
     algorithm produces much better layouts than before
526
, especially where rows or
527
     columns were stretchable.
528
     There are new commands for creating common dialog
529
boxes:
530
     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
531
     tk_messageBox. These use native dialog boxes if
532
they are available.
533
     There is a new virtual event mechanism for handlin
534
g events in a more portable
535
     way. See the new command event. It also allows
536
events (both physical and
537
     virtual) to be generated dynamically.
538
 
539
Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl
540
7.5 and Tk 4.1 except for
541
changes in the C APIs for custom channel drivers. Scrip
542
ts written for earlier releases
543
should work on these new releases as well.
544
 
545
Obtaining The Releases
546
 
547
Binary Releases
548
 
549
Pre-compiled releases are available for the following
550
platforms:
551
 
552
     Windows 3.1, Windows 95, and Windows NT: Fetch
553
     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
554
execute it. The file is a
555
     self-extracting executable. It will install the
556
Tcl and Tk libraries, the wish and
557
     tclsh programs, and documentation.
558
     Macintosh (both 68K and PowerPC): Fetch
559
     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx.
560
The file is in binhex format,
561
     which is understood by Fetch, StuffIt, and many
562
other Mac utilities. The
563
     unpacked file is a self-installing executable:
564
double-click on it and it will create a
565
     folder containing all that you need to run Tcl
566
and Tk.
567
        UNIX (Solaris 2.* and SunOS, other systems
568
soon to follow). Easy to install
569
     binary packages are now for sale at the Sun Labs
570
Tcl/Tk Shop. Check it out!
571
}
572
 
573
# Check that "break" resets the interpreter's result
574
 
575
test for-4.1 {break must reset the interp result} {
576
    catch {
577
        set z GLOBTESTDIR/dir2/file2.c
578
        if [string match GLOBTESTDIR/dir2/* $z] {
579
            break
580
        }
581
    } j
582
    set j
583
} {}
584
 
585
# Check "for" and computed command names.
586
 
587
test for-5.1 {for and computed command names} {
588
    set j 0
589
    set z for
590
    $z {set i 0} {$i<10} {incr i} {set j $i}
591
    set j
592
} 9

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.