![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to parse.test CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / worm / scsi / tcl / tests|
Return to parse.test CVS log | Up to [Research Unix] / researchv10no / cmd / worm / scsi / tcl / tests |
1.1 root 1: # This file contains contains a collection of tests for the basic
2: # command-parsing mechanisms of Tcl (such as how braces and brackets
3: # and variable substitutions are handled).. If everything is OK
4: # then it finishes silently. If a problem is detected then it
5: # generates a Tcl error with a cryptic message. To trace the error
6: # you'll have to read through the commands in this file.
7: #
8: # $Header: /sprite/src/lib/tcl/tests/RCS/parse.test,v 1.1 90/03/21 13:27:48 ouster Exp $ (Berkeley)
9:
10: proc check {a b num} {
11: if {[string compare $a $b] != 0} {
12: error [format {Parse error %s: wanted "%s", got "%s"} $num $b $a]}
13: }
14:
15: proc fourArgs {a b c d} {
16: global arg1 arg2 arg3 arg4
17: set arg1 $a
18: set arg2 $b
19: set arg3 $c
20: set arg4 $d
21: }
22:
23: proc getArgs args {
24: global argv
25: set argv $args
26: }
27:
28: # Basic argument parsing.
29:
30: fourArgs a b c d
31: check $arg1 a 1.1
32: check $arg2 b 1.2
33: check $arg3 c 1.3
34: check $arg4 d 1.4
35:
36: # Quotes.
37:
38: getArgs "a b c" d
39: check $argv {{a b c} d} 2.1
40: set a 101
41: getArgs "a$a b c"
42: check $argv {{a101 b c}} 2.2
43: set argv "xy[format xabc]"
44: check $argv {xyxabc} 2.3
45: set argv "xy\t"
46: check $argv xy\t 2.4
47: set argv "a b c
48: d e f"
49: check $argv a\ b\tc\nd\ e\ f 2.5
50: set argv a"bcd"e
51: check $argv {a"bcd"e} 2.6
52:
53: # Braces.
54:
55: getArgs {a b c} d
56: check $argv "{a b c} d" 3.1
57: set a 101
58: set argv {a$a b c}
59: set b [index $argv 1 chars]
60: check $b {$} 3.2
61: set argv {a[format xyz] b}
62: check [length $argv chars] 15 3.3
63: set argv {a\nb\}}
64: check [length $argv chars] 6 3.4
65: set argv {{{{}}}}
66: check $argv "{{{}}}" 3.5
67: set argv a{{}}b
68: check $argv "a{{}}b" 3.6
69:
70: # Command substitution.
71:
72: set a [format xyz]
73: check $a xyz 4.1
74: set a a[format xyz]b[format q]
75: check $a axyzbq 4.2
76: set a a[
77: format
78: xyz
79: ]b
80: check $a axyzb 4.3
81:
82: # Variable substitution.
83:
84: set a 123
85: set _123z xx
86: check $a 123 5.1
87: check x$a.b x123.b 5.2
88: check $_123z^ xx^ 5.3
89: check a${a}b a123b 5.4
90: check [catch {$_non_existent_} msg] 1 5.5
91: check $msg {couldn't find variable "_non_existent_"} 5.6
92:
93: # Backslash substitution.
94:
95: proc bsCheck {char num errNum} {
96: scan $char %c value
97: if {$value != $num} {
98: error [format {History error %s: wanted "%s", got "%s"}
99: $errNum $num $value]
100: }
101: }
102:
103: bsCheck \b 0x8 6.1
104: bsCheck \e 0x1b 6.2
105: bsCheck \n 0xa 6.3
106: bsCheck \r 0xd 6.4
107: bsCheck \t 0x9 6.5
108: bsCheck \{ 0x7b 6.6
109: bsCheck \} 0x7d 6.7
110: bsCheck \[ 0x5b 6.8
111: bsCheck \] 0x5d 6.9
112: bsCheck \$ 0x24 6.10
113: bsCheck \ 0x20 6.11
114: bsCheck \; 0x3b 6.12
115: bsCheck \\ 0x5c 6.13
116: bsCheck \Ca 0x1 6.14
117: bsCheck \Ma 0xe1 6.15
118: bsCheck \CMa 0x81 6.16
119: bsCheck \14 0xc 6.17
120: bsCheck \x 0x5c 6.18
121: set a "\a\c\n\]\}"
122: check [length $a chars] 7 6.19
123: set a {\a\c\n\]\}}
124: check [length $a chars] 10 6.20
125:
126: # Semi-colon.
127:
128: set b 0
129: getArgs a;set b 2
130: check $argv a 7.1
131: check $b 2 7.2
132: getArgs a b ; set b 1
133: check $argv {a b} 7.3
134: check $b 1 7.4
135:
136: # The following checks are to ensure that the interpreter's result
137: # gets re-initialized by Tcl_Eval in all the right places.
138:
139: check [concat abc] abc 8.1
140: check [concat abc; set a 2] {} 8.2
141: check [concat abc; set a $a] {} 8.3
142: check [set a [concat abc]] {} 8.4
143:
144: # Syntax errors.
145:
146: check [catch "set a {bcd" msg] 1 9.1
147: check $msg "unmatched brace: 'set a => {bcd'" 9.2
148: check [catch {set a "bcd} msg] 1 9.3
149: check $msg {unmatched quote: 'set a => "bcd'} 9.4
150: check [catch {set a "bcd"xy} msg] 1 9.5
151: check $msg {extra characters after close-quote: 'set a "bcd => "xy'} 9.6
152: check [catch "set a {bcd}xy" msg] 1 9.7
153: check $msg "extra characters after close-brace: 'set a {bcd => }xy'" 9.8
154: check [catch {set a [format abc} msg] 1 9.9
155: check $msg "missing close-bracket: ' => format abc'" 9.10
156: check [catch gorp-a-lot msg] 1 9.11
157: check $msg {"gorp-a-lot" is an invalid command name or ambiguous abbreviation} 9.12
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.