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

Subversion Repositories or1k

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# Commands covered:  set (plus basic command syntax).  Also tests
2
# the procedures in the file tclParse.c.
3
#
4
# This file contains a collection of tests for one or more of the Tcl
5
# built-in commands.  Sourcing this file into Tcl runs the tests and
6
# generates output for errors.  No output means no errors were found.
7
#
8
# Copyright (c) 1991-1993 The Regents of the University of California.
9
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
10
#
11
# See the file "license.terms" for information on usage and redistribution
12
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13
#
14
# RCS: @(#) $Id: parse.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
15
 
16
if {[string compare test [info procs test]] == 1} then {source defs}
17
 
18
proc fourArgs {a b c d} {
19
    global arg1 arg2 arg3 arg4
20
    set arg1 $a
21
    set arg2 $b
22
    set arg3 $c
23
    set arg4 $d
24
}
25
 
26
proc getArgs args {
27
    global argv
28
    set argv $args
29
}
30
 
31
# Basic argument parsing.
32
 
33
test parse-1.1 {basic argument parsing} {
34
    set arg1 {}
35
    fourArgs a b        c                d
36
    list $arg1 $arg2 $arg3 $arg4
37
} {a b c d}
38
test parse-1.2 {basic argument parsing} {
39
    set arg1 {}
40
    eval "fourArgs 123\v4\f56\r7890"
41
    list $arg1 $arg2 $arg3 $arg4
42
} {123 4 56 7890}
43
 
44
# Quotes.
45
 
46
test parse-2.1 {quotes and variable-substitution} {
47
    getArgs "a b c" d
48
    set argv
49
} {{a b c} d}
50
test parse-2.2 {quotes and variable-substitution} {
51
    set a 101
52
    getArgs "a$a b c"
53
    set argv
54
} {{a101 b c}}
55
test parse-2.3 {quotes and variable-substitution} {
56
    set argv "xy[format xabc]"
57
    set argv
58
} {xyxabc}
59
test parse-2.4 {quotes and variable-substitution} {
60
    set argv "xy\t"
61
    set argv
62
} xy\t
63
test parse-2.5 {quotes and variable-substitution} {
64
    set argv "a b       c
65
d e f"
66
    set argv
67
} a\ b\tc\nd\ e\ f
68
test parse-2.6 {quotes and variable-substitution} {
69
    set argv a"bcd"e
70
    set argv
71
} {a"bcd"e}
72
 
73
# Braces.
74
 
75
test parse-3.1 {braces} {
76
    getArgs {a b c} d
77
    set argv
78
} "{a b c} d"
79
test parse-3.2 {braces} {
80
    set a 101
81
    set argv {a$a b c}
82
    set b [string index $argv 1]
83
    set b
84
} {$}
85
test parse-3.3 {braces} {
86
    set argv {a[format xyz] b}
87
    string length $argv
88
} 15
89
test parse-3.4 {braces} {
90
    set argv {a\nb\}}
91
    string length $argv
92
} 6
93
test parse-3.5 {braces} {
94
    set argv {{{{}}}}
95
    set argv
96
} "{{{}}}"
97
test parse-3.6 {braces} {
98
    set argv a{{}}b
99
    set argv
100
} "a{{}}b"
101
test parse-3.7 {braces} {
102
    set a [format "last]"]
103
    set a
104
} {last]}
105
 
106
# Command substitution.
107
 
108
test parse-4.1 {command substitution} {
109
    set a [format xyz]
110
    set a
111
} xyz
112
test parse-4.2 {command substitution} {
113
    set a a[format xyz]b[format q]
114
    set a
115
} axyzbq
116
test parse-4.3 {command substitution} {
117
    set a a[
118
set b 22;
119
format %s $b
120
 
121
]b
122
    set a
123
} a22b
124
test parse-4.4 {command substitution} {
125
    set a 7.7
126
    if [catch {expr int($a)}] {set a foo}
127
    set a
128
} 7.7
129
 
130
# Variable substitution.
131
 
132
test parse-5.1 {variable substitution} {
133
    set a 123
134
    set b $a
135
    set b
136
} 123
137
test parse-5.2 {variable substitution} {
138
    set a 345
139
    set b x$a.b
140
    set b
141
} x345.b
142
test parse-5.3 {variable substitution} {
143
    set _123z xx
144
    set b $_123z^
145
    set b
146
} xx^
147
test parse-5.4 {variable substitution} {
148
    set a 78
149
    set b a${a}b
150
    set b
151
} a78b
152
test parse-5.5 {variable substitution} {catch {$_non_existent_} msg} 1
153
test parse-5.6 {variable substitution} {
154
    catch {$_non_existent_} msg
155
    set msg
156
} {can't read "_non_existent_": no such variable}
157
test parse-5.7 {array variable substitution} {
158
    catch {unset a}
159
    set a(xyz) 123
160
    set b $a(xyz)foo
161
    set b
162
} 123foo
163
test parse-5.8 {array variable substitution} {
164
    catch {unset a}
165
    set "a(x y z)" 123
166
    set b $a(x y z)foo
167
    set b
168
} 123foo
169
test parse-5.9 {array variable substitution} {
170
    catch {unset a}; catch {unset qqq}
171
    set "a(x y z)" qqq
172
    set $a([format x]\ y [format z]) foo
173
    set qqq
174
} foo
175
test parse-5.10 {array variable substitution} {
176
    catch {unset a}
177
    list [catch {set b $a(22)} msg] $msg
178
} {1 {can't read "a(22)": no such variable}}
179
test parse-5.11 {array variable substitution} {
180
    set b a$!
181
    set b
182
} {a$!}
183
test parse-5.12 {array variable substitution} {
184
    set b a$()
185
    set b
186
} {a$()}
187
catch {unset a}
188
test parse-5.13 {array variable substitution} {
189
    catch {unset a}
190
    set long {This is a very long variable, long enough to cause storage \
191
        allocation to occur in Tcl_ParseVar.  If that storage isn't getting \
192
        freed up correctly, then a core leak will occur when this test is \
193
        run.  This text is probably beginning to sound like drivel, but I've \
194
        run out of things to say and I need more characters still.}
195
    set a($long) 777
196
    set b $a($long)
197
    list $b [array names a]
198
} {777 {{This is a very long variable, long enough to cause storage \
199
        allocation to occur in Tcl_ParseVar.  If that storage isn't getting \
200
        freed up correctly, then a core leak will occur when this test is \
201
        run.  This text is probably beginning to sound like drivel, but I've \
202
        run out of things to say and I need more characters still.}}}
203
test parse-5.14 {array variable substitution} {
204
    catch {unset a}; catch {unset b}; catch {unset a1}
205
    set a1(22) foo
206
    set a(foo) bar
207
    set b $a($a1(22))
208
    set b
209
} bar
210
catch {unset a}; catch {unset a1}
211
 
212
# Backslash substitution.
213
 
214
set errNum 1
215
proc bsCheck {char num} {
216
    global errNum
217
;   test parse-6.$errNum {backslash substitution} {
218
        scan $char %c value
219
        set value
220
    } $num
221
    set errNum [expr $errNum+1]
222
}
223
 
224
bsCheck \b      8
225
bsCheck \e      101
226
bsCheck \f      12
227
bsCheck \n      10
228
bsCheck \r      13
229
bsCheck \t      9
230
bsCheck \v      11
231
bsCheck \{      123
232
bsCheck \}      125
233
bsCheck \[      91
234
bsCheck \]      93
235
bsCheck \$      36
236
bsCheck \       32
237
bsCheck \;      59
238
bsCheck \\      92
239
bsCheck \Ca     67
240
bsCheck \Ma     77
241
bsCheck \CMa    67
242
bsCheck \8a     8
243
bsCheck \14     12
244
bsCheck \141    97
245
bsCheck \340    224
246
bsCheck b\0     98
247
bsCheck \x      120
248
bsCheck \xa     10
249
bsCheck \x41    65
250
bsCheck \x541   65
251
 
252
test parse-6.1 {backslash substitution} {
253
    set a "\a\c\n\]\}"
254
    string length $a
255
} 5
256
test parse-6.2 {backslash substitution} {
257
    set a {\a\c\n\]\}}
258
    string length $a
259
} 10
260
test parse-6.3 {backslash substitution} {
261
    set a "abc\
262
def"
263
    set a
264
} {abc def}
265
test parse-6.4 {backslash substitution} {
266
    set a {abc\
267
def}
268
    set a
269
} {abc def}
270
test parse-6.5 {backslash substitution} {
271
    set msg {}
272
    set a xxx
273
    set error [catch {if {24 < \
274
        35} {set a 22} {set \
275
            a 33}} msg]
276
    list $error $msg $a
277
} {0 22 22}
278
test parse-6.6 {backslash substitution} {
279
    eval "concat abc\\"
280
} "abc\\"
281
test parse-6.7 {backslash substitution} {
282
    eval "concat \\\na"
283
} "a"
284
test parse-6.8 {backslash substitution} {
285
    eval "concat x\\\n          a"
286
} "x a"
287
test parse-6.9 {backslash substitution} {
288
    eval "concat \\x"
289
} "x"
290
test parse-6.10 {backslash substitution} {
291
    eval "list a b\\\nc d"
292
} {a b c d}
293
test parse-6.11 {backslash substitution} {
294
    eval "list a \"b c\"\\\nd e"
295
} {a {b c} d e}
296
 
297
# Semi-colon.
298
 
299
test parse-7.1 {semi-colons} {
300
    set b 0
301
    getArgs a;set b 2
302
    set argv
303
} a
304
test parse-7.2 {semi-colons} {
305
    set b 0
306
    getArgs a;set b 2
307
    set b
308
} 2
309
test parse-7.3 {semi-colons} {
310
    getArgs a b ; set b 1
311
    set argv
312
} {a b}
313
test parse-7.4 {semi-colons} {
314
    getArgs a b ; set b 1
315
    set b
316
} 1
317
 
318
# The following checks are to ensure that the interpreter's result
319
# gets re-initialized by Tcl_Eval in all the right places.
320
 
321
test parse-8.1 {result initialization} {concat abc} abc
322
test parse-8.2 {result initialization} {concat abc; proc foo {} {}} {}
323
test parse-8.3 {result initialization} {concat abc; proc foo {} $a} {}
324
test parse-8.4 {result initialization} {proc foo {} [concat abc]} {}
325
test parse-8.5 {result initialization} {concat abc; } abc
326
test parse-8.6 {result initialization} {
327
    eval {
328
    concat abc
329
}} abc
330
test parse-8.7 {result initialization} {} {}
331
test parse-8.8 {result initialization} {concat abc; ; ;} abc
332
 
333
# Syntax errors.
334
 
335
test parse-9.1 {syntax errors} {catch "set a \{bcd" msg} 1
336
test parse-9.2 {syntax errors} {
337
        catch "set a \{bcd" msg
338
        set msg
339
} {missing close-brace}
340
test parse-9.3 {syntax errors} {catch {set a "bcd} msg} 1
341
test parse-9.4 {syntax errors} {
342
        catch {set a "bcd} msg
343
        set msg
344
} {quoted string doesn't terminate properly}
345
test parse-9.5 {syntax errors} {catch {set a "bcd"xy} msg} 1
346
test parse-9.6 {syntax errors} {
347
        catch {set a "bcd"xy} msg
348
        set msg
349
} {quoted string doesn't terminate properly}
350
test parse-9.7 {syntax errors} {catch "set a {bcd}xy" msg} 1
351
test parse-9.8 {syntax errors} {
352
        catch "set a {bcd}xy" msg
353
        set msg
354
} {argument word in braces doesn't terminate properly}
355
test parse-9.9 {syntax errors} {catch {set a [format abc} msg} 1
356
test parse-9.10 {syntax errors} {
357
        catch {set a [format abc} msg
358
        set msg
359
} {missing close-bracket or close-brace}
360
test parse-9.11 {syntax errors} {catch gorp-a-lot msg} 1
361
test parse-9.12 {syntax errors} {
362
        catch gorp-a-lot msg
363
        set msg
364
} {invalid command name "gorp-a-lot"}
365
test parse-9.13 {syntax errors} {
366
    set a [concat {a}\
367
 {b}]
368
    set a
369
} {a b}
370
test parse-9.14 {syntax errors} {
371
    list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo
372
} {1 {missing )} {missing )
373
    (parsing index for array "x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000")
374
    while compiling
375
"$x0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ..."
376
    ("eval" body line 1)
377
    invoked from within
378
"eval \$x[format "%01000d" 0]("}}
379
test parse-9.15 {syntax errors, missplaced braces} {
380
    catch {
381
        proc misplaced_end_brace {} {
382
            set what foo
383
            set when [expr ${what}size - [set off$what]}]
384
    } msg
385
    set msg
386
} {wrong # args: should be "proc name args body"}
387
test parse-9.16 {syntax errors, missplaced braces} {
388
    catch {
389
        set a {
390
            set what foo
391
            set when [expr ${what}size - [set off$what]}]
392
    } msg
393
    set msg
394
} {argument word in braces doesn't terminate properly}
395
 
396
# Long values (stressing storage management)
397
 
398
set a {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH}
399
 
400
test parse-10.1 {long values} {
401
    string length $a
402
} 214
403
test parse-10.2 {long values} {
404
    llength $a
405
} 43
406
test parse-10.3 {long values} {
407
    set b "1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH"
408
    set b
409
} $a
410
test parse-10.4 {long values} {
411
    set b "$a"
412
    set b
413
} $a
414
test parse-10.5 {long values} {
415
    set b [set a]
416
    set b
417
} $a
418
test parse-10.6 {long values} {
419
    set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]
420
    string length $b
421
} 214
422
test parse-10.7 {long values} {
423
    set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]
424
    llength $b
425
} 43
426
test parse-10.8 {long values} {
427
    set b
428
} $a
429
test parse-10.9 {long values} {
430
    set a [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ]
431
    llength $a
432
} 62
433
set i 0
434
foreach j [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ] {
435
    set test [string index 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ $i]
436
    set test $test$test$test$test
437
    set i [expr $i+1]
438
    test parse-10.10 {long values} {
439
        set j
440
    } $test
441
}
442
test parse-10.11 {test buffer overflow in backslashes in braces} {
443
    expr {"a" == {xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101}}
444
} 0
445
 
446
test parse-11.1 {comments} {
447
    set a old
448
    eval {  # set a new}
449
    set a
450
} {old}
451
test parse-11.2 {comments} {
452
    set a old
453
    eval "  # set a new\nset a new"
454
    set a
455
} {new}
456
test parse-11.3 {comments} {
457
    set a old
458
    eval "  # set a new\\\nset a new"
459
    set a
460
} {old}
461
test parse-11.4 {comments} {
462
    set a old
463
    eval "  # set a new\\\\\nset a new"
464
    set a
465
} {new}
466
 
467
test parse-12.1 {comments at the end of a bracketed script} {
468
    set x "[
469
expr 1+1
470
# skip this!
471
]"
472
} {2}
473
 
474
if {[info command testwordend] == "testwordend"} {
475
    test parse-13.1 {TclWordEnd procedure} {
476
        testwordend "   \n abc"
477
    } {c}
478
    test parse-13.2 {TclWordEnd procedure} {
479
        testwordend "   \\\n"
480
    } {}
481
    test parse-13.3 {TclWordEnd procedure} {
482
        testwordend "   \\\n "
483
    } { }
484
    test parse-13.4 {TclWordEnd procedure} {
485
        testwordend {"abc"}
486
    } {"}
487
    test parse-13.5 {TclWordEnd procedure} {
488
        testwordend {{xyz}}
489
    } \}
490
    test parse-13.6 {TclWordEnd procedure} {
491
        testwordend {{a{}b{}\}} xyz}
492
    } "\} xyz"
493
    test parse-13.7 {TclWordEnd procedure} {
494
        testwordend {abc[this is a]def ghi}
495
    } {f ghi}
496
    test parse-13.8 {TclWordEnd procedure} {
497
        testwordend "puts\\\n\n  "
498
    } "s\\\n\n  "
499
    test parse-13.9 {TclWordEnd procedure} {
500
        testwordend "puts\\\n           "
501
    } "s\\\n    "
502
    test parse-13.10 {TclWordEnd procedure} {
503
        testwordend "puts\\\n           xyz"
504
    } "s\\\n    xyz"
505
    test parse-13.11 {TclWordEnd procedure} {
506
        testwordend {a$x.$y(a long index) foo}
507
    } ") foo"
508
    test parse-13.12 {TclWordEnd procedure} {
509
        testwordend {abc; def}
510
    } {; def}
511
    test parse-13.13 {TclWordEnd procedure} {
512
        testwordend {abc def}
513
    } {c def}
514
    test parse-13.14 {TclWordEnd procedure} {
515
        testwordend {abc        def}
516
    } {c        def}
517
    test parse-13.15 {TclWordEnd procedure} {
518
        testwordend "abc\ndef"
519
    } "c\ndef"
520
    test parse-13.16 {TclWordEnd procedure} {
521
        testwordend "abc"
522
    } {c}
523
    test parse-13.17 {TclWordEnd procedure} {
524
        testwordend "a\000bc"
525
    } {c}
526
    test parse-13.18 {TclWordEnd procedure} {
527
        testwordend \[a\000\]
528
    } {]}
529
    test parse-13.19 {TclWordEnd procedure} {
530
        testwordend \"a\000\"
531
    } {"}
532
    test parse-13.20 {TclWordEnd procedure} {
533
        testwordend a{\000}b
534
    } {b}
535
    test parse-13.21 {TclWordEnd procedure} {
536
        testwordend "   \000b"
537
    } {b}
538
}
539
 
540
test parse-14.1 {TclScriptEnd procedure} {
541
    info complete {puts [
542
        expr 1+1
543
        #this is a comment ]}
544
} {0}
545
test parse-14.2 {TclScriptEnd procedure} {
546
    info complete "abc\\\n"
547
} {0}
548
test parse-14.3 {TclScriptEnd procedure} {
549
    info complete "abc\\\\\n"
550
} {1}
551
test parse-14.4 {TclScriptEnd procedure} {
552
    info complete "xyz \[abc \{abc\]"
553
} {0}
554
test parse-14.5 {TclScriptEnd procedure} {
555
    info complete "xyz \[abc"
556
} {0}

powered by: WebSVN 2.1.0

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