parseold.test

tcl是工具命令语言

# Commands covered:  set (plus basic command syntax).  Also tests the
# procedures in the file tclOldParse.c.  This set of tests is an old
# one that predates the new parser in Tcl 8.1.
#
# 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.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: parseOld.test,v 1.11 2002/06/25 01:13:38 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

tcltest::testConstraint testwordend \
	[string equal "testwordend" [info commands testwordend]]

# Save the argv value for restoration later
set savedArgv $argv

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 parseOld-1.1 {basic argument parsing} {
    set arg1 {}
    fourArgs a b	c 		 d
    list $arg1 $arg2 $arg3 $arg4
} {a b c d}
test parseOld-1.2 {basic argument parsing} {
    set arg1 {}
    eval "fourArgs 123\v4\f56\r7890"
    list $arg1 $arg2 $arg3 $arg4
} {123 4 56 7890}

# Quotes.

test parseOld-2.1 {quotes and variable-substitution} {
    getArgs "a b c" d
    set argv
} {{a b c} d}
test parseOld-2.2 {quotes and variable-substitution} {
    set a 101
    getArgs "a$a b c"
    set argv
} {{a101 b c}}
test parseOld-2.3 {quotes and variable-substitution} {
    set argv "xy[format xabc]"
    set argv
} {xyxabc}
test parseOld-2.4 {quotes and variable-substitution} {
    set argv "xy\t"
    set argv
} xy\t
test parseOld-2.5 {quotes and variable-substitution} {
    set argv "a b	c
d e f"
    set argv
} a\ b\tc\nd\ e\ f
test parseOld-2.6 {quotes and variable-substitution} {
    set argv a"bcd"e
    set argv
} {a"bcd"e}

# Braces.

test parseOld-3.1 {braces} {
    getArgs {a b c} d
    set argv
} "{a b c} d"
test parseOld-3.2 {braces} {
    set a 101
    set argv {a$a b c}
    set b [string index $argv 1]
    set b
} {$}
test parseOld-3.3 {braces} {
    set argv {a[format xyz] b}
    string length $argv
} 15
test parseOld-3.4 {braces} {
    set argv {a\nb\}}
    string length $argv
} 6
test parseOld-3.5 {braces} {
    set argv {{{{}}}}
    set argv
} "{{{}}}"
test parseOld-3.6 {braces} {
    set argv a{{}}b
    set argv
} "a{{}}b"
test parseOld-3.7 {braces} {
    set a [format "last]"]
    set a
} {last]}

# Command substitution.

test parseOld-4.1 {command substitution} {
    set a [format xyz]
    set a
} xyz
test parseOld-4.2 {command substitution} {
    set a a[format xyz]b[format q]
    set a
} axyzbq
test parseOld-4.3 {command substitution} {
    set a a[
set b 22;
format %s $b

]b
    set a
} a22b
test parseOld-4.4 {command substitution} {
    set a 7.7
    if [catch {expr int($a)}] {set a foo}
    set a
} 7.7

# Variable substitution.

test parseOld-5.1 {variable substitution} {
    set a 123
    set b $a
    set b
} 123
test parseOld-5.2 {variable substitution} {
    set a 345
    set b x$a.b
    set b
} x345.b
test parseOld-5.3 {variable substitution} {
    set _123z xx
    set b $_123z^
    set b
} xx^
test parseOld-5.4 {variable substitution} {
    set a 78
    set b a${a}b
    set b
} a78b
test parseOld-5.5 {variable substitution} {catch {$_non_existent_} msg} 1
test parseOld-5.6 {variable substitution} {
    catch {$_non_existent_} msg
    set msg
} {can't read "_non_existent_": no such variable}
test parseOld-5.7 {array variable substitution} {
    catch {unset a}
    set a(xyz) 123
    set b $a(xyz)foo
    set b
} 123foo
test parseOld-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 parseOld-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 parseOld-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 parseOld-5.11 {array variable substitution} {
    set b a$!
    set b
} {a$!}
test parseOld-5.12 {empty array name support} {
    list [catch {set b a$()} msg] $msg
} {1 {can't read "()": no such variable}}
catch {unset a}
test parseOld-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 parseOld-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}

test parseOld-7.1 {backslash substitution} {
    set a "\a\c\n\]\}"
    string length $a
} 5
test parseOld-7.2 {backslash substitution} {
    set a {\a\c\n\]\}}
    string length $a
} 10
test parseOld-7.3 {backslash substitution} {
    set a "abc\
def"
    set a
} {abc def}
test parseOld-7.4 {backslash substitution} {
    set a {abc\
def}
    set a
} {abc def}
test parseOld-7.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 parseOld-7.6 {backslash substitution} {
    eval "concat abc\\"
} "abc\\"
test parseOld-7.7 {backslash substitution} {
    eval "concat \\\na"
} "a"
test parseOld-7.8 {backslash substitution} {
    eval "concat x\\\n   	a"
} "x a"
test parseOld-7.9 {backslash substitution} {
    eval "concat \\x"
} "x"
test parseOld-7.10 {backslash substitution} {
    eval "list a b\\\nc d"
} {a b c d}
test parseOld-7.11 {backslash substitution} {
    eval "list a \"b c\"\\\nd e"
} {a {b c} d e}
test parseOld-7.12 {backslash substitution} {
    list \ua2
} [bytestring "\xc2\xa2"]
test parseOld-7.13 {backslash substitution} {
    list \u4e21
} [bytestring "\xe4\xb8\xa1"]
test parseOld-7.14 {backslash substitution} {
    list \u4e2k
} [bytestring "\xd3\xa2k"]

# Semi-colon.

test parseOld-8.1 {semi-colons} {
    set b 0