parse.test

tcl是工具命令语言

# This file contains a collection of tests for the procedures in the
# file tclParse.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 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: parse.test,v 1.11 2003/02/16 01:36:32 msofer Exp $

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

if {[info commands testparser] == {}} {
    puts "This application hasn't been compiled with the \"testparser\""
    puts "command, so I can't test the Tcl parser."
    ::tcltest::cleanupTests
    return 
}

test parse-1.1 {Tcl_ParseCommand procedure, computing string length} {
    testparser [bytestring "foo\0 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-1.2 {Tcl_ParseCommand procedure, computing string length} {
    testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
test parse-1.3 {Tcl_ParseCommand procedure, leading space} {
    testparser "  \n\t   foo" 0
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-1.4 {Tcl_ParseCommand procedure, leading space} {
    testparser "\f\r\vfoo" 0
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-1.5 {Tcl_ParseCommand procedure, backslash-newline in leading space} {
    testparser "  \\\n foo" 0
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-1.6 {Tcl_ParseCommand procedure, backslash-newline in leading space} {
    testparser {  \a foo} 0
} {- {\a foo} 2 word {\a} 1 backslash {\a} 0 simple foo 1 text foo 0 {}}
test parse-1.7 {Tcl_ParseCommand procedure, missing continuation line in leading space} {
    testparser "   \\\n" 0
} {- {} 0 {}}
test parse-1.8 {Tcl_ParseCommand procedure, eof in leading space} {
    testparser "      foo" 3
} {- {} 0 {   foo}}

test parse-2.1 {Tcl_ParseCommand procedure, comments} {
    testparser "# foo bar\n foo" 0
} {{# foo bar
} foo 1 simple foo 1 text foo 0 {}}
test parse-2.2 {Tcl_ParseCommand procedure, several comments} {
    testparser " # foo bar\n # another comment\n\n   foo" 0
} {{# foo bar
 # another comment
} foo 1 simple foo 1 text foo 0 {}}
test parse-2.3 {Tcl_ParseCommand procedure, backslash-newline in comments} {
    testparser " # foo bar\\\ncomment on continuation line\nfoo" 0
} {#\ foo\ bar\\\ncomment\ on\ continuation\ line\n foo 1 simple foo 1 text foo 0 {}}
test parse-2.4 {Tcl_ParseCommand procedure, missing continuation line in comment} {
    testparser "#   \\\n" 0
} {#\ \ \ \\\n {} 0 {}}
test parse-2.5 {Tcl_ParseCommand procedure, eof in comment} {
    testparser " # foo bar\nfoo" 8
} {{# foo b} {} 0 {ar
foo}}

test parse-3.1 {Tcl_ParseCommand procedure, parsing words, skipping space} {
    testparser "foo  bar\t\tx" 0
} {- {foo  bar		x} 3 simple foo 1 text foo 0 simple bar 1 text bar 0 simple x 1 text x 0 {}}
test parse-3.2 {Tcl_ParseCommand procedure, missing continuation line in leading space} {
    testparser "abc  \\\n" 0
} {- abc\ \ \\\n 1 simple abc 1 text abc 0 {}}
test parse-3.3 {Tcl_ParseCommand procedure, parsing words, command ends in space} {
    testparser "foo  ;  bar x" 0
} {- {foo  ;} 1 simple foo 1 text foo 0 {  bar x}}
test parse-3.4 {Tcl_ParseCommand procedure, parsing words, command ends in space} {
    testparser "foo       " 5
} {- {foo  } 1 simple foo 1 text foo 0 {     }}
test parse-3.5 {Tcl_ParseCommand procedure, quoted words} {
    testparser {foo "a b c" d "efg";} 0
} {- {foo "a b c" d "efg";} 4 simple foo 1 text foo 0 simple {"a b c"} 1 text {a b c} 0 simple d 1 text d 0 simple {"efg"} 1 text efg 0 {}}
test parse-3.6 {Tcl_ParseCommand procedure, words in braces} {
    testparser {foo {a $b [concat foo]} {c d}} 0
} {- {foo {a $b [concat foo]} {c d}} 3 simple foo 1 text foo 0 simple {{a $b [concat foo]}} 1 text {a $b [concat foo]} 0 simple {{c d}} 1 text {c d} 0 {}}
test parse-3.7 {Tcl_ParseCommand procedure, error in unquoted word} {
    list [catch {testparser "foo \$\{abc" 0} msg] $msg $errorInfo
} {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\$\\\{abc\"\ 0\"}

test parse-4.1 {Tcl_ParseCommand procedure, simple words} {
    testparser {foo} 0
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-4.2 {Tcl_ParseCommand procedure, simple words} {
    testparser {{abc}} 0
} {- {{abc}} 1 simple {{abc}} 1 text abc 0 {}}
test parse-4.3 {Tcl_ParseCommand procedure, simple words} {
    testparser {"c d"} 0
} {- {"c d"} 1 simple {"c d"} 1 text {c d} 0 {}}
test parse-4.4 {Tcl_ParseCommand procedure, simple words} {
    testparser {x$d} 0
} {- {x$d} 1 word {x$d} 3 text x 0 variable {$d} 1 text d 0 {}}
test parse-4.5 {Tcl_ParseCommand procedure, simple words} {
    testparser {"a [foo] b"} 0
} {- {"a [foo] b"} 1 word {"a [foo] b"} 3 text {a } 0 command {[foo]} 0 text { b} 0 {}}
test parse-4.6 {Tcl_ParseCommand procedure, simple words} {
    testparser {$x} 0
} {- {$x} 1 word {$x} 2 variable {$x} 1 text x 0 {}}

test parse-5.1 {Tcl_ParseCommand procedure, backslash-newline terminates word} {
    testparser "{abc}\\\n" 0
} {- \{abc\}\\\n 1 simple {{abc}} 1 text abc 0 {}}
test parse-5.2 {Tcl_ParseCommand procedure, backslash-newline terminates word} {
    testparser "foo\\\nbar" 0
} {- foo\\\nbar 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
test parse-5.3 {Tcl_ParseCommand procedure, word terminator is command terminator} {
    testparser "foo\n bar" 0
} {- {foo
} 1 simple foo 1 text foo 0 { bar}}
test parse-5.4 {Tcl_ParseCommand procedure, word terminator is command terminator} {
    testparser "foo; bar" 0
} {- {foo;} 1 simple foo 1 text foo 0 { bar}}
test parse-5.5 {Tcl_ParseCommand procedure, word terminator is end of string} {
    testparser "\"foo\" bar" 5
} {- {"foo"} 1 simple {"foo"} 1 text foo 0 { bar}}
test parse-5.6 {Tcl_ParseCommand procedure, junk after close quote} {
    list [catch {testparser {foo "bar"x} 0} msg] $msg $errorInfo
} {1 {extra characters after close-quote} {extra characters after close-quote
    (remainder of script: "x")
    invoked from within
"testparser {foo "bar"x} 0"}}
test parse-5.7 {Tcl_ParseCommand procedure, backslash-newline after close quote} {
    testparser "foo \"bar\"\\\nx" 0
} {- foo\ \"bar\"\\\nx 3 simple foo 1 text foo 0 simple {"bar"} 1 text bar 0 simple x 1 text x 0 {}}
test parse-5.8 {Tcl_ParseCommand procedure, junk after close brace} {
    list [catch {testparser {foo {bar}x} 0} msg] $msg $errorInfo
} {1 {extra characters after close-brace} {extra characters after close-brace
    (remainder of script: "x")
    invoked from within
"testparser {foo {bar}x} 0"}}
test parse-5.9 {Tcl_ParseCommand procedure, backslash-newline after close brace} {
    testparser "foo {bar}\\\nx" 0
} {- foo\ \{bar\}\\\nx 3 simple foo 1 text foo 0 simple {{bar}} 1 text bar 0 simple x 1 text x 0 {}}
test parse-5.10 {Tcl_ParseCommand procedure, multiple deletion of non-static buffer} {
    # This test is designed to catch bug 1681.
    list [catch {testparser "a \"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8" 0} msg] $msg $errorInfo
} "1 {missing \"} {missing \"
    (remainder of script: \"\"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8\")
    invoked from within
\"testparser \"a \\\"\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\\\\9\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\" 0\"}"

test parse-6.1 {ParseTokens procedure, empty word} {
    testparser {""} 0
} {- {""} 1 simple {""} 1 text {} 0 {}}
test parse-6.2 {ParseTokens procedure, simple range} {
    testparser {"abc$x.e"} 0
} {- {"abc$x.e"} 1 word {"abc$x.e"} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 {}}
test parse-6.3 {ParseTokens procedure, variable reference} {
    testparser {abc$x.e $y(z)} 0
} {- {abc$x.e $y(z)} 2 word {abc$x.e} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 word {$y(z)} 3 variable {$y(z)} 2 text y 0 text z 0 {}}
test parse-6.4 {ParseTokens procedure, variable reference} {
    list [catch {testparser {$x([a )} 0} msg] $msg
} {1 {missing close-bracket}}
test parse-6.5 {ParseTokens procedure, command substitution} {
    testparser {[foo $x bar]z} 0
} {- {[foo $x bar]z} 1 word {[foo $x bar]z} 2 command {[foo $x bar]} 0 text z 0 {}}
test parse-6.6 {ParseTokens procedure, command substitution} {
    testparser {[foo \] [a b]]} 0
} {- {[foo \] [a b]]} 1 word {[foo \] [a b]]} 1 command {[foo \] [a b]]} 0 {}}
test parse-6.7 {ParseTokens procedure, error in command substitution} {
    list [catch {testparser {a [b {}c d] e} 0} msg] $msg $errorInfo
} {1 {extra characters after close-brace} {extra characters after close-brace
    (remainder of script: "c d] e")
    invoked from within
"testparser {a [b {}c d] e} 0"}}
test parse-6.8 {ParseTokens procedure, error in command substitution} {
    info complete {a [b {}c d]}
} {1}
test parse-6.9 {ParseTokens procedure, error in command substitution} {
    info complete {a [b "c d}
} {0}
test parse-6.10 {ParseTokens procedure, incomplete sub-command} {
    info complete {puts [
	expr 1+1
	#this is a comment ]}
} {0}
test parse-6.11 {ParseTokens procedure, memory allocation for big nested command} {
    testparser {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0
} {- {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 word {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 command {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0 {}}
test parse-6.12 {ParseTokens procedure, missing close bracket} {
    list [catch {testparser {[foo $x bar} 0} msg] $msg $errorInfo
} {1 {missing close-bracket} {missing close-bracket
    (remainder of script: "[foo $x bar")
    invoked from within
"testparser {[foo $x bar} 0"}}
test parse-6.13 {ParseTokens procedure, backslash-newline without continuation line} {
    list [catch {testparser "\"a b\\\n" 0} msg] $msg $errorInfo
} {1 {missing "} missing\ \"\n\ \ \ \ (remainder\ of\ script:\ \"\"a\ b\\\n\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\\\"a\ b\\\\\\n\"\ 0\"}
test parse-6.14 {ParseTokens procedure, backslash-newline} {
    testparser "b\\\nc" 0
} {- b\\\nc 2 simple b 1 text b 0 simple c 1 text c 0 {}}
test parse-6.15 {ParseTokens procedure, backslash-newline} {
    testparser "\"b\\\nc\"" 0
} {- \"b\\\nc\" 1 word \"b\\\nc\" 3 text b 0 backslash \\\n 0 text c 0 {}}
test parse-6.16 {ParseTokens procedure, backslash substitution} {
    testparser {\n\a\x7f} 0
} {- {\n\a\x7f} 1 word {\n\a\x7f} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7f} 0 {}}
test parse-6.17 {ParseTokens procedure, null characters} {
    testparser [bytestring "foo\0zz"] 0
} "- [bytestring foo\0zz] 1 word [bytestring foo\0zz] 3 text foo 0 text [bytestring \0] 0 text zz 0 {}"
test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} {
    # Test for Bug 681841
    list [catch {testparser {[a]} 2} msg] $msg
} {1 {missing close-bracket}}

test parse-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} {
    testparser {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 0
} {- {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 16 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 {}}

test parse-8.1 {Tcl_EvalObjv procedure} {
    testevalobjv 0 concat this is a test
} {this is a test}
test parse-8.2 {Tcl_EvalObjv procedure, unknown commands} {
    rename unknown unknown.old
    set x [catch {testevalobjv 10 asdf poiu} msg]
    rename unknown.old unknown
    list $x $msg
} {1 {invalid command name "asdf"}}
test parse-8.3 {Tcl_EvalObjv procedure, unknown commands} {
    rename unknown unknown.old
    proc unknown args {
	return "unknown $args"
    }
    set x [catch {testevalobjv 0 asdf poiu} msg]
    rename unknown {}
    rename unknown.old unknown
    list $x $msg
} {0 {unknown asdf poiu}}
test parse-8.4 {Tcl_EvalObjv procedure, unknown commands} {
    rename unknown unknown.old
    proc unknown args {
	error "I don't like that command"
    }
    set x [catch {testevalobjv 0 asdf poiu} msg]
    rename unknown {}
    rename unknown.old unknown
    list $x $msg
} {1 {I don't like that command}}
test parse-8.5 {Tcl_EvalObjv procedure, command traces} {
    testevalobjv 0 set x 123