parse.test

tcl是工具命令语言

    testcmdtrace tracetest {testevalobjv 0 set x $x}
} {{testevalobjv 0 set x $x} {testevalobjv 0 set x 123} {set x 123} {set x 123}}
test parse-8.7 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL flag} {
    proc x {} {
	set y 23
	set z [testevalobjv 1 set y]
	return [list $z $y]
    }
    catch {unset y}
    set y 16
    x
} {16 23}
test parse-8.8 {Tcl_EvalObjv procedure, async handlers} {
    proc async1 {result code} {
	global aresult acode
	set aresult $result
	set acode $code
	return "new result"
    }
    set handler1 [testasync create async1]
    set aresult xxx
    set acode yyy
    set x [list [catch [list testevalobjv 0 testasync mark $handler1 original 0] msg] $msg $acode $aresult]
    testasync delete
    set x
} {0 {new result} 0 original}
test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} {
    list [catch {testevalobjv 0 error message} msg] $msg
} {1 message}

test parse-9.1 {Tcl_LogCommandInfo, line numbers} {
    catch {unset x}
    list [catch {testevalex {for {} 1 {} {


	# asdf
	set x
    }}}] $errorInfo
} {1 {can't read "x": no such variable
    while executing
"set x"
    ("for" body line 5)
    invoked from within
"for {} 1 {} {


	# asdf
	set x
    }"
    invoked from within
"testevalex {for {} 1 {} {


	# asdf
	set x
    }}"}}
test parse-9.2 {Tcl_LogCommandInfo, truncating long commands} {
    list [testevalex {catch {set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee fffffffff ggggggggg}}] $errorInfo
} {1 {wrong # args: should be "set varName ?newValue?"
    while executing
"set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd ee..."}}

test parse-10.1 {Tcl_EvalTokens, simple text} {
    testevalex {concat test}
} {test}
test parse-10.2 {Tcl_EvalTokens, backslash sequences} {
    testevalex {concat test\063\062test}
} {test32test}
test parse-10.3 {Tcl_EvalTokens, nested commands} {
    testevalex {concat [expr 2 + 6]}
} {8}
test parse-10.4 {Tcl_EvalTokens, nested commands} {
    catch {unset a}
    list [catch {testevalex {concat xxx[expr $a]}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-10.5 {Tcl_EvalTokens, simple variables} {
    set a hello
    testevalex {concat $a}
} {hello}
test parse-10.6 {Tcl_EvalTokens, array variables} {
    catch {unset a}
    set a(12) 46
    testevalex {concat $a(12)}
} {46}
test parse-10.7 {Tcl_EvalTokens, array variables} {
    catch {unset a}
    set a(12) 46
    testevalex {concat $a(1[expr 3 - 1])}
} {46}
test parse-10.8 {Tcl_EvalTokens, array variables} {
    catch {unset a}
    list [catch {testevalex {concat $x($a)}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-10.9 {Tcl_EvalTokens, array variables} {
    catch {unset a}
    list [catch {testevalex {concat xyz$a(1)}} msg] $msg
} {1 {can't read "a(1)": no such variable}}
test parse-10.10 {Tcl_EvalTokens, object values} {
    set a 123
    testevalex {concat $a}
} {123}
test parse-10.11 {Tcl_EvalTokens, object values} {
    set a 123
    testevalex {concat $a$a$a}
} {123123123}
test parse-10.12 {Tcl_EvalTokens, object values} {
    testevalex {concat [expr 2][expr 4][expr 6]}
} {246}
test parse-10.13 {Tcl_EvalTokens, string values} {
    testevalex {concat {a" b"}}
} {a" b"}
test parse-10.14 {Tcl_EvalTokens, string values} {
    set a 111
    testevalex {concat x$a.$a.$a}
} {x111.111.111}

test parse-11.1 {Tcl_EvalEx, TCL_EVAL_GLOBAL flag} {
    proc x {} {
	set y 777
	set z [testevalex "set y" global]
	return [list $z $y]
    }
    catch {unset y}
    set y 321
    x
} {321 777}
test parse-11.2 {Tcl_EvalEx, error while parsing} {
    list [catch {testevalex {concat "abc}} msg] $msg
} {1 {missing "}}
test parse-11.3 {Tcl_EvalEx, error while collecting words} {
    catch {unset a}
    list [catch {testevalex {concat xyz $a}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-11.4 {Tcl_EvalEx, error in Tcl_EvalObjv call} {
    catch {unset a}
    list [catch {testevalex {_bogus_ a b c d}} msg] $msg
} {1 {invalid command name "_bogus_"}}
test parse-11.5 {Tcl_EvalEx, exceptional return} {
    list [catch {testevalex {break}} msg] $msg
} {3 {}}
test parse-11.6 {Tcl_EvalEx, freeing memory} {
    testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z}
} {a b c d e f g h i j k l m n o p q r s t u v w x y z}
test parse-11.7 {Tcl_EvalEx, multiple commands in script} {
    list [testevalex {set a b; set c d}] $a $c
} {d b d}
test parse-11.8 {Tcl_EvalEx, multiple commands in script} {
    list [testevalex {
	set a b
	set c d
    }] $a $c
} {d b d}
test parse-11.9 {Tcl_EvalEx, freeing memory after error} {
    catch {unset a}
    list [catch {testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z $a}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-11.10 {Tcl_EvalTokens, empty commands} {
    testevalex {concat xyz;   }
} {xyz}
test parse-11.11 {Tcl_EvalTokens, empty commands} {
    testevalex "concat abc; ; # this is a comment\n"
} {abc}
test parse-11.12 {Tcl_EvalTokens, empty commands} {
    testevalex {}
} {}

test parse-12.1 {Tcl_ParseVarName procedure, initialization} {
    list [catch {testparsevarname {$a([first second])} 8 0} msg] $msg
} {1 {missing close-bracket}}
test parse-12.2 {Tcl_ParseVarName procedure, initialization} {
    testparsevarname {$a([first second])} 0 0
} {- {} 0 variable {$a([first second])} 2 text a 0 command {[first second]} 0 {}}
test parse-12.3 {Tcl_ParseVarName procedure, initialization} {
    list [catch {testparsevarname {$abcd} 3 0} msg] $msg
} {0 {- {} 0 variable {$ab} 1 text ab 0 cd}}
test parse-12.4 {Tcl_ParseVarName procedure, initialization} {
    testparsevarname {$abcd} 0 0
} {- {} 0 variable {$abcd} 1 text abcd 0 {}}
test parse-12.5 {Tcl_ParseVarName procedure, just a dollar sign} {
    testparsevarname {$abcd} 1 0
} {- {} 0 text {$} 0 abcd}
test parse-12.6 {Tcl_ParseVarName procedure, braced variable name} {
    testparser {${..[]b}cd} 0
} {- {${..[]b}cd} 1 word {${..[]b}cd} 3 variable {${..[]b}} 1 text {..[]b} 0 text cd 0 {}}
test parse-12.7 {Tcl_ParseVarName procedure, braced variable name} {
    testparser "\$\{\{\} " 0
} {- \$\{\{\}\  1 word \$\{\{\} 2 variable \$\{\{\} 1 text \{ 0 {}}
test parse-12.8 {Tcl_ParseVarName procedure, missing close brace} {
    list [catch {testparser "$\{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\ \"\$\\\{abc\"\ 0\"}
test parse-12.9 {Tcl_ParseVarName procedure, missing close brace} {
    list [catch {testparsevarname {${bcd}} 4 0} msg] $msg
} {1 {missing close-brace for variable name}}
test parse-12.10 {Tcl_ParseVarName procedure, missing close brace} {
    list [catch {testparsevarname {${bc}} 4 0} msg] $msg
} {1 {missing close-brace for variable name}}
test parse-12.11 {Tcl_ParseVarName procedure, simple variable name} {
    testparser {$az_AZ.} 0
} {- {$az_AZ.} 1 word {$az_AZ.} 3 variable {$az_AZ} 1 text az_AZ 0 text . 0 {}}
test parse-12.12 {Tcl_ParseVarName procedure, simple variable name} {
    testparser {$abcdefg} 4
} {- {$abc} 1 word {$abc} 2 variable {$abc} 1 text abc 0 defg}
test parse-12.13 {Tcl_ParseVarName procedure, simple variable name with ::} {
    testparser {$xyz::ab:c} 0
} {- {$xyz::ab:c} 1 word {$xyz::ab:c} 3 variable {$xyz::ab} 1 text xyz::ab 0 text :c 0 {}}
test parse-12.14 {Tcl_ParseVarName procedure, variable names with many colons} {
    testparser {$xyz:::::c} 0
} {- {$xyz:::::c} 1 word {$xyz:::::c} 2 variable {$xyz:::::c} 1 text xyz:::::c 0 {}}
test parse-12.15 {Tcl_ParseVarName procedure, : vs. ::} {
    testparsevarname {$ab:cd} 0 0
} {- {} 0 variable {$ab} 1 text ab 0 :cd}
test parse-12.16 {Tcl_ParseVarName procedure, eof in ::} {
    testparsevarname {$ab::cd} 4 0
} {- {} 0 variable {$ab} 1 text ab 0 ::cd}
test parse-12.17 {Tcl_ParseVarName procedure, eof in ::} {
    testparsevarname {$ab:::cd} 5 0
} {- {} 0 variable {$ab::} 1 text ab:: 0 :cd}
test parse-12.18 {Tcl_ParseVarName procedure, no variable name} {
    testparser {$$ $.} 0
} {- {$$ $.} 2 word {$$} 2 text {$} 0 text {$} 0 word {$.} 2 text {$} 0 text . 0 {}}
test parse-12.19 {Tcl_ParseVarName procedure, EOF before (} {
    testparsevarname {$ab(cd)} 3 0
} {- {} 0 variable {$ab} 1 text ab 0 (cd)}
test parse-12.20 {Tcl_ParseVarName procedure, array reference} {
    testparser {$x(abc)} 0
} {- {$x(abc)} 1 word {$x(abc)} 3 variable {$x(abc)} 2 text x 0 text abc 0 {}}
test parse-12.21 {Tcl_ParseVarName procedure, array reference} {
    testparser {$x(ab$cde[foo bar])} 0
} {- {$x(ab$cde[foo bar])} 1 word {$x(ab$cde[foo bar])} 6 variable {$x(ab$cde[foo bar])} 5 text x 0 text ab 0 variable {$cde} 1 text cde 0 command {[foo bar]} 0 {}}
test parse-12.22 {Tcl_ParseVarName procedure, array reference} {
    testparser {$x([cmd arg]zz)} 0
} {- {$x([cmd arg]zz)} 1 word {$x([cmd arg]zz)} 4 variable {$x([cmd arg]zz)} 3 text x 0 command {[cmd arg]} 0 text zz 0 {}}
test parse-12.23 {Tcl_ParseVarName procedure, missing close paren in array reference} {
    list [catch {testparser {$x(poiu} 0} msg] $msg $errorInfo
} {1 {missing )} {missing )
    (remainder of script: "(poiu")
    invoked from within
"testparser {$x(poiu} 0"}}
test parse-12.24 {Tcl_ParseVarName procedure, missing close paren in array reference} {
    list [catch {testparsevarname {$ab(cd)} 6 0} msg] $msg $errorInfo
} {1 {missing )} {missing )
    (remainder of script: "(cd)")
    invoked from within
"testparsevarname {$ab(cd)} 6 0"}}
test parse-12.25 {Tcl_ParseVarName procedure, nested array reference} {
    testparser {$x(a$y(b$z))} 0
} {- {$x(a$y(b$z))} 1 word {$x(a$y(b$z))} 8 variable {$x(a$y(b$z))} 7 text x 0 text a 0 variable {$y(b$z)} 4 text y 0 text b 0 variable {$z} 1 text z 0 {}}

test parse-13.1 {Tcl_ParseVar procedure} {
    set abc 24
    testparsevar {$abc.fg}