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

Subversion Repositories or1k

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

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


# Commands covered:  set (plus basic command syntax).  Also tests
# the procedures in the file tclParse.c.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: parse.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
 
if {[string compare test [info procs test]] == 1} then {source defs}
 
proc fourArgs {a b c d} {
    global arg1 arg2 arg3 arg4
    set arg1 $a
    set arg2 $b
    set arg3 $c
    set arg4 $d
}
 
proc getArgs args {
    global argv
    set argv $args
}
 
# Basic argument parsing.
 
test parse-1.1 {basic argument parsing} {
    set arg1 {}
    fourArgs a b        c                d
    list $arg1 $arg2 $arg3 $arg4
} {a b c d}
test parse-1.2 {basic argument parsing} {
    set arg1 {}
    eval "fourArgs 123\v4\f56\r7890"
    list $arg1 $arg2 $arg3 $arg4
} {123 4 56 7890}
 
# Quotes.
 
test parse-2.1 {quotes and variable-substitution} {
    getArgs "a b c" d
    set argv
} {{a b c} d}
test parse-2.2 {quotes and variable-substitution} {
    set a 101
    getArgs "a$a b c"
    set argv
} {{a101 b c}}
test parse-2.3 {quotes and variable-substitution} {
    set argv "xy[format xabc]"
    set argv
} {xyxabc}
test parse-2.4 {quotes and variable-substitution} {
    set argv "xy\t"
    set argv
} xy\t
test parse-2.5 {quotes and variable-substitution} {
    set argv "a b       c
d e f"
    set argv
} a\ b\tc\nd\ e\ f
test parse-2.6 {quotes and variable-substitution} {
    set argv a"bcd"e
    set argv
} {a"bcd"e}
 
# Braces.
 
test parse-3.1 {braces} {
    getArgs {a b c} d
    set argv
} "{a b c} d"
test parse-3.2 {braces} {
    set a 101
    set argv {a$a b c}
    set b [string index $argv 1]
    set b
} {$}
test parse-3.3 {braces} {
    set argv {a[format xyz] b}
    string length $argv
} 15
test parse-3.4 {braces} {
    set argv {a\nb\}}
    string length $argv
} 6
test parse-3.5 {braces} {
    set argv {{{{}}}}
    set argv
} "{{{}}}"
test parse-3.6 {braces} {
    set argv a{{}}b
    set argv
} "a{{}}b"
test parse-3.7 {braces} {
    set a [format "last]"]
    set a
} {last]}
 
# Command substitution.
 
test parse-4.1 {command substitution} {
    set a [format xyz]
    set a
} xyz
test parse-4.2 {command substitution} {
    set a a[format xyz]b[format q]
    set a
} axyzbq
test parse-4.3 {command substitution} {
    set a a[
set b 22;
format %s $b
 
]b
    set a
} a22b
test parse-4.4 {command substitution} {
    set a 7.7
    if [catch {expr int($a)}] {set a foo}
    set a
} 7.7
 
# Variable substitution.
 
test parse-5.1 {variable substitution} {
    set a 123
    set b $a
    set b
} 123
test parse-5.2 {variable substitution} {
    set a 345
    set b x$a.b
    set b
} x345.b
test parse-5.3 {variable substitution} {
    set _123z xx
    set b $_123z^
    set b
} xx^
test parse-5.4 {variable substitution} {
    set a 78
    set b a${a}b
    set b
} a78b
test parse-5.5 {variable substitution} {catch {$_non_existent_} msg} 1
test parse-5.6 {variable substitution} {
    catch {$_non_existent_} msg
    set msg
} {can't read "_non_existent_": no such variable}
test parse-5.7 {array variable substitution} {
    catch {unset a}
    set a(xyz) 123
    set b $a(xyz)foo
    set b
} 123foo
test parse-5.8 {array variable substitution} {
    catch {unset a}
    set "a(x y z)" 123
    set b $a(x y z)foo
    set b
} 123foo
test parse-5.9 {array variable substitution} {
    catch {unset a}; catch {unset qqq}
    set "a(x y z)" qqq
    set $a([format x]\ y [format z]) foo
    set qqq
} foo
test parse-5.10 {array variable substitution} {
    catch {unset a}
    list [catch {set b $a(22)} msg] $msg
} {1 {can't read "a(22)": no such variable}}
test parse-5.11 {array variable substitution} {
    set b a$!
    set b
} {a$!}
test parse-5.12 {array variable substitution} {
    set b a$()
    set b
} {a$()}
catch {unset a}
test parse-5.13 {array variable substitution} {
    catch {unset a}
    set long {This is a very long variable, long enough to cause storage \
        allocation to occur in Tcl_ParseVar.  If that storage isn't getting \
        freed up correctly, then a core leak will occur when this test is \
        run.  This text is probably beginning to sound like drivel, but I've \
        run out of things to say and I need more characters still.}
    set a($long) 777
    set b $a($long)
    list $b [array names a]
} {777 {{This is a very long variable, long enough to cause storage \
        allocation to occur in Tcl_ParseVar.  If that storage isn't getting \
        freed up correctly, then a core leak will occur when this test is \
        run.  This text is probably beginning to sound like drivel, but I've \
        run out of things to say and I need more characters still.}}}
test parse-5.14 {array variable substitution} {
    catch {unset a}; catch {unset b}; catch {unset a1}
    set a1(22) foo
    set a(foo) bar
    set b $a($a1(22))
    set b
} bar
catch {unset a}; catch {unset a1}
 
# Backslash substitution.
 
set errNum 1
proc bsCheck {char num} {
    global errNum
;   test parse-6.$errNum {backslash substitution} {
        scan $char %c value
        set value
    } $num
    set errNum [expr $errNum+1]
}
 
bsCheck \b      8
bsCheck \e      101
bsCheck \f      12
bsCheck \n      10
bsCheck \r      13
bsCheck \t      9
bsCheck \v      11
bsCheck \{      123
bsCheck \}      125
bsCheck \[      91
bsCheck \]      93
bsCheck \$      36
bsCheck \       32
bsCheck \;      59
bsCheck \\      92
bsCheck \Ca     67
bsCheck \Ma     77
bsCheck \CMa    67
bsCheck \8a     8
bsCheck \14     12
bsCheck \141    97
bsCheck \340    224
bsCheck b\0     98
bsCheck \x      120
bsCheck \xa     10
bsCheck \x41    65
bsCheck \x541   65
 
test parse-6.1 {backslash substitution} {
    set a "\a\c\n\]\}"
    string length $a
} 5
test parse-6.2 {backslash substitution} {
    set a {\a\c\n\]\}}
    string length $a
} 10
test parse-6.3 {backslash substitution} {
    set a "abc\
def"
    set a
} {abc def}
test parse-6.4 {backslash substitution} {
    set a {abc\
def}
    set a
} {abc def}
test parse-6.5 {backslash substitution} {
    set msg {}
    set a xxx
    set error [catch {if {24 < \
        35} {set a 22} {set \
            a 33}} msg]
    list $error $msg $a
} {0 22 22}
test parse-6.6 {backslash substitution} {
    eval "concat abc\\"
} "abc\\"
test parse-6.7 {backslash substitution} {
    eval "concat \\\na"
} "a"
test parse-6.8 {backslash substitution} {
    eval "concat x\\\n          a"
} "x a"
test parse-6.9 {backslash substitution} {
    eval "concat \\x"
} "x"
test parse-6.10 {backslash substitution} {
    eval "list a b\\\nc d"
} {a b c d}
test parse-6.11 {backslash substitution} {
    eval "list a \"b c\"\\\nd e"
} {a {b c} d e}
 
# Semi-colon.
 
test parse-7.1 {semi-colons} {
    set b 0
    getArgs a;set b 2
    set argv
} a
test parse-7.2 {semi-colons} {
    set b 0
    getArgs a;set b 2
    set b
} 2
test parse-7.3 {semi-colons} {
    getArgs a b ; set b 1
    set argv
} {a b}
test parse-7.4 {semi-colons} {
    getArgs a b ; set b 1
    set b
} 1
 
# The following checks are to ensure that the interpreter's result
# gets re-initialized by Tcl_Eval in all the right places.
 
test parse-8.1 {result initialization} {concat abc} abc
test parse-8.2 {result initialization} {concat abc; proc foo {} {}} {}
test parse-8.3 {result initialization} {concat abc; proc foo {} $a} {}
test parse-8.4 {result initialization} {proc foo {} [concat abc]} {}
test parse-8.5 {result initialization} {concat abc; } abc
test parse-8.6 {result initialization} {
    eval {
    concat abc
}} abc
test parse-8.7 {result initialization} {} {}
test parse-8.8 {result initialization} {concat abc; ; ;} abc
 
# Syntax errors.
 
test parse-9.1 {syntax errors} {catch "set a \{bcd" msg} 1
test parse-9.2 {syntax errors} {
        catch "set a \{bcd" msg
        set msg
} {missing close-brace}
test parse-9.3 {syntax errors} {catch {set a "bcd} msg} 1
test parse-9.4 {syntax errors} {
        catch {set a "bcd} msg
        set msg
} {quoted string doesn't terminate properly}
test parse-9.5 {syntax errors} {catch {set a "bcd"xy} msg} 1
test parse-9.6 {syntax errors} {
        catch {set a "bcd"xy} msg
        set msg
} {quoted string doesn't terminate properly}
test parse-9.7 {syntax errors} {catch "set a {bcd}xy" msg} 1
test parse-9.8 {syntax errors} {
        catch "set a {bcd}xy" msg
        set msg
} {argument word in braces doesn't terminate properly}
test parse-9.9 {syntax errors} {catch {set a [format abc} msg} 1
test parse-9.10 {syntax errors} {
        catch {set a [format abc} msg
        set msg
} {missing close-bracket or close-brace}
test parse-9.11 {syntax errors} {catch gorp-a-lot msg} 1
test parse-9.12 {syntax errors} {
        catch gorp-a-lot msg
        set msg
} {invalid command name "gorp-a-lot"}
test parse-9.13 {syntax errors} {
    set a [concat {a}\
 {b}]
    set a
} {a b}
test parse-9.14 {syntax errors} {
    list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo
} {1 {missing )} {missing )
    (parsing index for array "x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000")
    while compiling
"$x0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ..."
    ("eval" body line 1)
    invoked from within
"eval \$x[format "%01000d" 0]("}}
test parse-9.15 {syntax errors, missplaced braces} {
    catch {
        proc misplaced_end_brace {} {
            set what foo
            set when [expr ${what}size - [set off$what]}]
    } msg
    set msg
} {wrong # args: should be "proc name args body"}
test parse-9.16 {syntax errors, missplaced braces} {
    catch {
        set a {
            set what foo
            set when [expr ${what}size - [set off$what]}]
    } msg
    set msg
} {argument word in braces doesn't terminate properly}
 
# Long values (stressing storage management)
 
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}
 
test parse-10.1 {long values} {
    string length $a
} 214
test parse-10.2 {long values} {
    llength $a
} 43
test parse-10.3 {long values} {
    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"
    set b
} $a
test parse-10.4 {long values} {
    set b "$a"
    set b
} $a
test parse-10.5 {long values} {
    set b [set a]
    set b
} $a
test parse-10.6 {long values} {
    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]
    string length $b
} 214
test parse-10.7 {long values} {
    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]
    llength $b
} 43
test parse-10.8 {long values} {
    set b
} $a
test parse-10.9 {long values} {
    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]
    llength $a
} 62
set i 0
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] {
    set test [string index 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ $i]
    set test $test$test$test$test
    set i [expr $i+1]
    test parse-10.10 {long values} {
        set j
    } $test
}
test parse-10.11 {test buffer overflow in backslashes in braces} {
    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}}
} 0
 
test parse-11.1 {comments} {
    set a old
    eval {  # set a new}
    set a
} {old}
test parse-11.2 {comments} {
    set a old
    eval "  # set a new\nset a new"
    set a
} {new}
test parse-11.3 {comments} {
    set a old
    eval "  # set a new\\\nset a new"
    set a
} {old}
test parse-11.4 {comments} {
    set a old
    eval "  # set a new\\\\\nset a new"
    set a
} {new}
 
test parse-12.1 {comments at the end of a bracketed script} {
    set x "[
expr 1+1
# skip this!
]"
} {2}
 
if {[info command testwordend] == "testwordend"} {
    test parse-13.1 {TclWordEnd procedure} {
        testwordend "   \n abc"
    } {c}
    test parse-13.2 {TclWordEnd procedure} {
        testwordend "   \\\n"
    } {}
    test parse-13.3 {TclWordEnd procedure} {
        testwordend "   \\\n "
    } { }
    test parse-13.4 {TclWordEnd procedure} {
        testwordend {"abc"}
    } {"}
    test parse-13.5 {TclWordEnd procedure} {
        testwordend {{xyz}}
    } \}
    test parse-13.6 {TclWordEnd procedure} {
        testwordend {{a{}b{}\}} xyz}
    } "\} xyz"
    test parse-13.7 {TclWordEnd procedure} {
        testwordend {abc[this is a]def ghi}
    } {f ghi}
    test parse-13.8 {TclWordEnd procedure} {
        testwordend "puts\\\n\n  "
    } "s\\\n\n  "
    test parse-13.9 {TclWordEnd procedure} {
        testwordend "puts\\\n           "
    } "s\\\n    "
    test parse-13.10 {TclWordEnd procedure} {
        testwordend "puts\\\n           xyz"
    } "s\\\n    xyz"
    test parse-13.11 {TclWordEnd procedure} {
        testwordend {a$x.$y(a long index) foo}
    } ") foo"
    test parse-13.12 {TclWordEnd procedure} {
        testwordend {abc; def}
    } {; def}
    test parse-13.13 {TclWordEnd procedure} {
        testwordend {abc def}
    } {c def}
    test parse-13.14 {TclWordEnd procedure} {
        testwordend {abc        def}
    } {c        def}
    test parse-13.15 {TclWordEnd procedure} {
        testwordend "abc\ndef"
    } "c\ndef"
    test parse-13.16 {TclWordEnd procedure} {
        testwordend "abc"
    } {c}
    test parse-13.17 {TclWordEnd procedure} {
        testwordend "a\000bc"
    } {c}
    test parse-13.18 {TclWordEnd procedure} {
        testwordend \[a\000\]
    } {]}
    test parse-13.19 {TclWordEnd procedure} {
        testwordend \"a\000\"
    } {"}
    test parse-13.20 {TclWordEnd procedure} {
        testwordend a{\000}b
    } {b}
    test parse-13.21 {TclWordEnd procedure} {
        testwordend "   \000b"
    } {b}
}
 
test parse-14.1 {TclScriptEnd procedure} {
    info complete {puts [
        expr 1+1
        #this is a comment ]}
} {0}
test parse-14.2 {TclScriptEnd procedure} {
    info complete "abc\\\n"
} {0}
test parse-14.3 {TclScriptEnd procedure} {
    info complete "abc\\\\\n"
} {1}
test parse-14.4 {TclScriptEnd procedure} {
    info complete "xyz \[abc \{abc\]"
} {0}
test parse-14.5 {TclScriptEnd procedure} {
    info complete "xyz \[abc"
} {0}

Browse

Tools

Subversion Repositories or1k

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

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}`