# The tests in this file cover the procedures in tclCmdMZ.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 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # SCCS: @(#) cmdMZ.test 1.20 98/01/08 18:23:43 if {[string compare test [info procs test]] == 1} then {source defs} # Tcl_PwdObjCmd test cmdMZ-1.1 {Tcl_PwdObjCmd} { list [catch {pwd a} msg] $msg } {1 {wrong # args: should be "pwd"}} test cmdMZ-1.2 {Tcl_PwdObjCmd: simple pwd} { catch pwd } 0 test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} { expr [string length pwd]>0 } 1 test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unixOnly} { file delete -force foo file mkdir foo set cwd [pwd] cd foo file attr . -permissions 000 set result [list [catch {pwd} msg] $msg] cd $cwd file delete -force foo set result } {1 {error getting working directory name: permission denied}} # The tests for Tcl_RegexpObjCmd, Tcl_RegsubObjCmd are in regexp.test # Tcl_RenameObjCmd test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} { list [catch {rename r1} msg] $msg $errorCode } {1 {wrong # args: should be "rename oldName newName"} NONE} test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} { list [catch {rename r1 r2 r3} msg] $msg $errorCode } {1 {wrong # args: should be "rename oldName newName"} NONE} test cmdMZ-2.3 {Tcl_RenameObjCmd: success} { catch {rename r2 {}} proc r1 {} {return "r1"} rename r1 r2 r2 } {r1} test cmdMZ-2.4 {Tcl_RenameObjCmd: success} { proc r1 {} {return "r1"} rename r1 {} list [catch {r1} msg] $msg } {1 {invalid command name "r1"}} # The tests for Tcl_ReturnObjCmd are in proc-old.test # The tests for Tcl_ScanObjCmd are in scan.test # Tcl_SourceObjCmd test cmdMZ-3.1 {Tcl_SourceObjCmd: error conditions} {macOnly} { list [catch {source} msg] $msg } {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}} test cmdMZ-3.2 {Tcl_SourceObjCmd: error conditions} {macOnly} { list [catch {source a b} msg] $msg } {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}} test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} {unixOrPc} { list [catch {source} msg] $msg } {1 {wrong # args: should be "source fileName"}} test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} {unixOrPc} { list [catch {source a b} msg] $msg } {1 {wrong # args: should be "source fileName"}} test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} { makeFile { set x 146 error "error in sourced file" set y $x } source.file list [catch {source source.file} msg] $msg $errorInfo } {1 {error in sourced file} {error in sourced file while executing "error "error in sourced file"" (file "source.file" line 3) invoked from within "source source.file"}} test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} { makeFile {list result} source.file source source.file } result # Tcl_SplitObjCmd test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} { list [catch split msg] $msg $errorCode } {1 {wrong # args: should be "split string ?splitChars?"} NONE} test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} { list [catch {split a b c} msg] $msg $errorCode } {1 {wrong # args: should be "split string ?splitChars?"} NONE} test cmdMZ-4.3 {Tcl_SplitObjCmd: basic split commands} { split "a\n b\t\r c\n " } {a {} b {} {} c {} {}} test cmdMZ-4.4 {Tcl_SplitObjCmd: basic split commands} { split "word 1xyzword 2zword 3" xyz } {{word 1} {} {} {word 2} {word 3}} test cmdMZ-4.5 {Tcl_SplitObjCmd: basic split commands} { split "12345" {} } {1 2 3 4 5} test cmdMZ-4.6 {Tcl_SplitObjCmd: basic split commands} { split "a\}b\[c\{\]\$" } "a\\}b\\\[c\\{\\\]\\\$" test cmdMZ-4.7 {Tcl_SplitObjCmd: basic split commands} { split {} {} } {} test cmdMZ-4.8 {Tcl_SplitObjCmd: basic split commands} { split {} } {} test cmdMZ-4.9 {Tcl_SplitObjCmd: basic split commands} { split { } } {{} {} {} {}} test cmdMZ-4.10 {Tcl_SplitObjCmd: basic split commands} { proc foo {} { set x {} foreach f [split {]\n} {}] { append x $f } return $x } foo } {]\n} test cmdMZ-4.11 {Tcl_SplitObjCmd: basic split commands} { proc foo {} { set x ab\000c set y [split $x {}] return $y } foo } "a b \000 c" test cmdMZ-4.12 {Tcl_SplitObjCmd: basic split commands} { split "a0ab1b2bbb3\000c4" ab\000c } {{} 0 {} 1 2 {} {} 3 {} 4} test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} { # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq" split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e" } "a b qw\u5e4eN wq" # Tcl_StringObjCmd test cmdMZ-5.1 {Tcl_StringObjCmd: error conditions} { list [catch {string} msg] $msg } {1 {wrong # args: should be "string option arg ?arg ...?"}} test cmdMZ-5.2 {Tcl_StringObjCmd: error conditions} { list [catch {string gorp a b} msg] $msg } {1 {bad option "gorp": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}} test cmdMZ-6.1 {Tcl_StringObjCmd: string compare} { list [catch {string compare a} msg] $msg } {1 {wrong # args: should be "string compare string1 string2"}} test cmdMZ-6.2 {Tcl_StringObjCmd: string compare} { list [catch {string compare a b c} msg] $msg } {1 {wrong # args: should be "string compare string1 string2"}} test cmdMZ-6.3 {Tcl_StringObjCmd: string compare} { string compare abcde abdef } -1 test cmdMZ-6.4 {Tcl_StringObjCmd: string compare} { string c abcde ABCDE } 1 test cmdMZ-6.5 {Tcl_StringObjCmd: string compare} { string compare abcde abcde } 0 test cmdMZ-6.6 {Tcl_StringObjCmd: string compare} { string compare ab abcde } -1 test cmdMZ-6.7 {Tcl_StringObjCmd: string compare} { string compare abcde ab } 1 test cmdMZ-6.8 {Tcl_StringObjCmd: string compare} { string compare cde ab } 1 test cmdMZ-6.9 {Tcl_StringObjCmd: string compare} { string compare ab cde } -1 test cmdMZ-6.10 {Tcl_StringObjCmd: string compare, unicode} { string compare ab\u7266 ab\u7267 } -1 test cmdMZ-6.11 {Tcl_StringObjCmd: string compare, high bit} { # This test will fail if the underlying comparaison # is using signed chars instead of unsigned chars. # (like SunOS's default memcmp thus the compat/memcmp.c) string compare "\x80" "@" # Nb this tests works also in utf8 space because \x80 is # translated into a 2 or more bytes but whose first byte has # the high bit set. } 1 test cmdMZ-7.1 {Tcl_StringObjCmd: string first} { list [catch {string first a} msg] $msg } {1 {wrong # args: should be "string first string1 string2"}} test cmdMZ-7.2 {Tcl_StringObjCmd: string first} { list [catch {string first a b c} msg] $msg } {1 {wrong # args: should be "string first string1 string2"}} test cmdMZ-7.3 {Tcl_StringObjCmd: string first} { string first bq abcdefgbcefgbqrs } 12 test cmdMZ-7.4 {Tcl_StringObjCmd: string first} { string fir bcd abcdefgbcefgbqrs } 1 test cmdMZ-7.5 {Tcl_StringObjCmd: string first} { string f b abcdefgbcefgbqrs } 1 test cmdMZ-7.6 {Tcl_StringObjCmd: string first} { string first xxx x123xx345xxx789xxx012 } 9 test cmdMZ-7.7 {Tcl_StringObjCmd: string first} { string first "" x123xx345xxx789xxx012 } -1 test cmdMZ-7.8 {Tcl_StringObjCmd: string first, unicode} { string first x abc\u7266x } 4 test cmdMZ-7.9 {Tcl_StringObjCmd: string first, unicode} { string first \u7266 abc\u7266x } 3 test cmdMZ-8.1 {Tcl_StringObjCmd: string index} { list [catch {string index} msg] $msg } {1 {wrong # args: should be "string index string charIndex"}} test cmdMZ-8.2 {Tcl_StringObjCmd: string index} { list [catch {string index a b c} msg] $msg } {1 {wrong # args: should be "string index string charIndex"}} test cmdMZ-8.3 {Tcl_StringObjCmd: string index} { list [catch {string index a xyz} msg] $msg } {1 {expected integer but got "xyz"}} test cmdMZ-8.4 {Tcl_StringObjCmd: string index} { string index abcde 0 } a test cmdMZ-8.5 {Tcl_StringObjCmd: string index} { string i abcde 4 } e test cmdMZ-8.6 {Tcl_StringObjCmd: string index} { string index abcde 5 } {} test cmdMZ-8.7 {Tcl_StringObjCmd: string index} { list [catch {string index abcde -10} msg] $msg } {0 {}} test cmdMZ-8.8 {Tcl_StringObjCmd: string index, unicode} { string index abc\u7266d 4 } d test cmdMZ-8.9 {Tcl_StringObjCmd: string index, unicode} { string index abc\u7266d 3 } \u7266 test cmdMZ-9.1 {Tcl_StringObjCmd: string last} { list [catch {string last a} msg] $msg } {1 {wrong # args: should be "string last string1 string2"}} test cmdMZ-9.2 {Tcl_StringObjCmd: string last} { list [catch {string last a b c} msg] $msg } {1 {wrong # args: should be "string last string1 string2"}} test cmdMZ-9.3 {Tcl_StringObjCmd: string last} { string la xxx xxxx123xx345x678 } 1 test cmdMZ-9.4 {Tcl_StringObjCmd: string last} { string last xx xxxx123xx345x678 } 7 test cmdMZ-9.5 {Tcl_StringObjCmd: string last} { string las x xxxx123xx345x678 } 12 test cmdMZ-9.6 {Tcl_StringObjCmd: string last, unicode} { string las x xxxx12\u7266xx345x678 } 12 test cmdMZ-9.7 {Tcl_StringObjCmd: string last, unicode} { string las \u7266 xxxx12\u7266xx345x678 } 6 test cmdMZ-10.1 {Tcl_StringObjCmd: string length} { list [catch {string length} msg] $msg } {1 {wrong # args: should be "string length string"}} test cmdMZ-10.2 {Tcl_StringObjCmd: string length} { list [catch {string length a b} msg] $msg } {1 {wrong # args: should be "string length string"}} test cmdMZ-10.3 {Tcl_StringObjCmd: string length} { string length "a little string" } 15 test cmdMZ-10.4 {Tcl_StringObjCmd: string length} { string le "" } 0 test cmdMZ-10.5 {Tcl_StringObjCmd: string length, unicode} { string le "abcd\u7266" } 5 test cmdMZ-11.1 {Tcl_StringObjCmd: string match} { list [catch {string match a} msg] $msg } {1 {wrong # args: should be "string match pattern string"}} test cmdMZ-11.2 {Tcl_StringObjCmd: string match} { list [catch {string match a b c} msg] $msg } {1 {wrong # args: should be "string match pattern string"}} test cmdMZ-11.3 {Tcl_StringObjCmd: string match} { string match abc abc } 1 test cmdMZ-11.4 {Tcl_StringObjCmd: string match} { string m abc abd } 0 test cmdMZ-12.1 {Tcl_StringObjCmd: string range} { list [catch {string range} msg] $msg } {1 {wrong # args: should be "string range string first last"}} test cmdMZ-12.2 {Tcl_StringObjCmd: string range} { list [catch {string range a 1} msg] $msg } {1 {wrong # args: should be "string range string first last"}} test cmdMZ-12.3 {Tcl_StringObjCmd: string range} { list [catch {string range a 1 2 3} msg] $msg } {1 {wrong # args: should be "string range string first last"}} test cmdMZ-12.4 {Tcl_StringObjCmd: string range} { list [catch {string range abc abc 1} msg] $msg } {1 {bad index "abc": must be integer or "end"}} test cmdMZ-12.5 {Tcl_StringObjCmd: string range} { list [catch {string range abc 1 eof} msg] $msg } {1 {bad index "eof": must be integer or "end"}} test cmdMZ-12.6 {Tcl_StringObjCmd: string range, first < 0} { string range abcdefghijklmnop -3 2 } {abc} test cmdMZ-12.7 {Tcl_StringObjCmd: string range} { string range abcdefghijklmnop 2 14 } {cdefghijklmno} test cmdMZ-12.8 {Tcl_StringObjCmd: string range, last > length} { string range abcdefghijklmnop 7 1000 } {hijklmnop} test cmdMZ-12.9 {Tcl_StringObjCmd: string range} { string range abcdefghijklmnop 10 e } {klmnop} test cmdMZ-12.10 {Tcl_StringObjCmd: string range, last < first} { string range abcdefghijklmnop 10 9 } {} test cmdMZ-12.11 {Tcl_StringObjCmd: string range} { string range abcdefghijklmnop -3 -2 } {} test cmdMZ-12.12 {Tcl_StringObjCmd: string range} { string range abcdefghijklmnop 1000 1010 } {} test cmdMZ-12.13 {Tcl_StringObjCmd: string range} { string range abcdefghijklmnop -100 end } {abcdefghijklmnop} test cmdMZ-12.14 {Tcl_StringObjCmd: string range} { string range abcdefghijklmnop end end } {p} test cmdMZ-12.15 {Tcl_StringObjCmd: string range} { string range abcdefghijklmnop e 1000 } {p} test cmdMZ-12.16 {Tcl_StringObjCmd: string range, unicode} { string range ab\u7266cdefghijklmnop 5 5 } e test cmdMZ-12.17 {Tcl_StringObjCmd: string range, unicode} { string range ab\u7266cdefghijklmnop 2 3 } \u7266c test cmdMZ-13.1 {Tcl_StringObjCmd: string tolower} { list [catch {string tolower} msg] $msg } {1 {wrong # args: should be "string tolower string"}} test cmdMZ-13.2 {Tcl_StringObjCmd: string tolower} { list [catch {string tolower a b} msg] $msg } {1 {wrong # args: should be "string tolower string"}} test cmdMZ-13.3 {Tcl_StringObjCmd: string tolower} { string tolower ABCDeF } {abcdef} test cmdMZ-13.4 {Tcl_StringObjCmd: string tolower} { string tolower "ABC XyZ" } {abc xyz} test cmdMZ-13.5 {Tcl_StringObjCmd: string tolower} { string tolower {123#$&*()} } {123#$&*()} test cmdMZ-13.6 {Tcl_StringObjCmd: string tolower, unicode} {hasIsoLocale} { set_iso8859_1_locale set result [string tolower ABCabc\xc7\xe7] restore_locale set result } "abcabc\xe7\xe7" test cmdMZ-14.1 {Tcl_StringObjCmd: string toupper} { list [catch {string toupper} msg] $msg } {1 {wrong # args: should be "string toupper string"}} test cmdMZ-14.2 {Tcl_StringObjCmd: string toupper} { list [catch {string toupper a b} msg] $msg } {1 {wrong # args: should be "string toupper string"}} test cmdMZ-14.3 {Tcl_StringObjCmd: string toupper} { string toupper abCDEf } {ABCDEF} test cmdMZ-14.4 {Tcl_StringObjCmd: string toupper} { string toupper "abc xYz" } {ABC XYZ} test cmdMZ-14.5 {Tcl_StringObjCmd: string toupper} { string toupper {123#$&*()} } {123#$&*()} test cmdMZ-14.6 {Tcl_StringObjCmd: string toupper, unicode} {hasIsoLocale} { set_iso8859_1_locale set result [string toupper ABCabc\xc7\xe7] restore_locale set result } "ABCABC\xc7\xc7" test cmdMZ-15.1 {Tcl_StringObjCmd: string trim} { list [catch {string trim} msg] $msg } {1 {wrong # args: should be "string trim string ?chars?"}} test cmdMZ-15.2 {Tcl_StringObjCmd: string trim} { list [catch {string trim a b c} msg] $msg } {1 {wrong # args: should be "string trim string ?chars?"}} test cmdMZ-15.3 {Tcl_StringObjCmd: string trim} { string trim " XYZ " } {XYZ} test cmdMZ-15.4 {Tcl_StringObjCmd: string trim} { string trim "\t\nXYZ\t\n\r\n" } {XYZ} test cmdMZ-15.5 {Tcl_StringObjCmd: string trim} { string trim " A XYZ A " } {A XYZ A} test cmdMZ-15.6 {Tcl_StringObjCmd: string trim} { string trim "XXYYZZABC XXYYZZ" ZYX } {ABC } test cmdMZ-15.7 {Tcl_StringObjCmd: string trim} { string trim " \t\r " } {} test cmdMZ-15.8 {Tcl_StringObjCmd: string trim} { string trim {abcdefg} {} } {abcdefg} test cmdMZ-15.9 {Tcl_StringObjCmd: string trim} { string trim {} } {} test cmdMZ-15.10 {Tcl_StringObjCmd: string trim} { string trim ABC DEF } {ABC} test cmdMZ-15.11 {Tcl_StringObjCmd: string trim, unicode} { string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8 } " AB\xe7C " test cmdMZ-16.1 {Tcl_StringObjCmd: string trimleft} { string trimleft " XYZ " } {XYZ } test cmdMZ-16.2 {Tcl_StringObjCmd: string trimleft} { list [catch {string trimleft} msg] $msg } {1 {wrong # args: should be "string trimleft string ?chars?"}} test cmdMZ-16.3 {Tcl_StringObjCmd: string trimleft} { string length [string trimleft " "] } {0} test cmdMZ-17.1 {Tcl_StringObjCmd: string trimright} { string trimright " XYZ " } { XYZ} test cmdMZ-17.2 {Tcl_StringObjCmd: string trimright} { string trimright " " } {} test cmdMZ-17.3 {Tcl_StringObjCmd: string trimright} { string trimright "" } {} test cmdMZ-17.4 {Tcl_StringObjCmd: string trimright errors} { list [catch {string trimright} msg] $msg } {1 {wrong # args: should be "string trimright string ?chars?"}} test cmdMZ-17.5 {Tcl_StringObjCmd: string trimright errors} { list [catch {string trimg a} msg] $msg } {1 {bad option "trimg": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}} test cmdMZ-18.1 {Tcl_StringObjCmd: string wordend} { list [catch {string wordend a} msg] $msg } {1 {wrong # args: should be "string wordend string index"}} test cmdMZ-18.2 {Tcl_StringObjCmd: string wordend} { list [catch {string wordend a b c} msg] $msg } {1 {wrong # args: should be "string wordend string index"}} test cmdMZ-18.3 {Tcl_StringObjCmd: string wordend} { list [catch {string wordend a gorp} msg] $msg } {1 {expected integer but got "gorp"}} test cmdMZ-18.4 {Tcl_StringObjCmd: string wordend} { string wordend abc. -1 } 3 test cmdMZ-18.5 {Tcl_StringObjCmd: string wordend} { string wordend abc. 100 } 4 test cmdMZ-18.6 {Tcl_StringObjCmd: string wordend} { string wordend "word_one two three" 2 } 8 test cmdMZ-18.7 {Tcl_StringObjCmd: string wordend} { string wordend "one .&# three" 5 } 6 test cmdMZ-18.8 {Tcl_StringObjCmd: string wordend} { string worde "x.y" 0 } 1 test cmdMZ-18.9 {Tcl_StringObjCmd: string wordend, unicode} {hasIsoLocale} { set_iso8859_1_locale set result [string wordend "xyz\u00c7de fg" 0] restore_locale set result } 6 test cmdMZ-18.10 {Tcl_StringObjCmd: string wordend, unicode} {hasIsoLocale} { set_iso8859_1_locale set result [string wordend "xyz\uc700de fg" 0] restore_locale set result } 3 test cmdMZ-18.11 {Tcl_StringObjCmd: string wordend, unicode} {hasIsoLocale} { set_iso8859_1_locale set result [string wordend "xyz\uc700de fg" 0] restore_locale set result } 3 test cmdMZ-18.12 {Tcl_StringObjCmd: string wordend, unicode} { string wordend "\uc700\uc700 abc" 8 } 6 test cmdMZ-19.1 {Tcl_StringObjCmd: string wordstart} { list [catch {string word a} msg] $msg } {1 {ambiguous option "word": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}} test cmdMZ-19.2 {Tcl_StringObjCmd: string wordstart} { list [catch {string wordstart a} msg] $msg } {1 {wrong # args: should be "string wordstart string index"}} test cmdMZ-19.3 {Tcl_StringObjCmd: string wordstart} { list [catch {string wordstart a b c} msg] $msg } {1 {wrong # args: should be "string wordstart string index"}} test cmdMZ-19.4 {Tcl_StringObjCmd: string wordstart} { list [catch {string wordstart a gorp} msg] $msg } {1 {expected integer but got "gorp"}} test cmdMZ-19.5 {Tcl_StringObjCmd: string wordstart} { string wordstart "one two three_words" 400 } 8 test cmdMZ-19.6 {Tcl_StringObjCmd: string wordstart} { string wordstart "one two three_words" 2 } 0 test cmdMZ-19.7 {Tcl_StringObjCmd: string wordstart} { string wordstart "one two three_words" -2 } 0 test cmdMZ-19.8 {Tcl_StringObjCmd: string wordstart} { string wordstart "one .*&^ three" 6 } 6 test cmdMZ-19.9 {Tcl_StringObjCmd: string wordstart} { string wordstart "one two three" 4 } 4 test cmdMZ-19.10 {Tcl_StringObjCmd: string wordstart, unicode} {hasIsoLocale} { set_iso8859_1_locale set result [string wordstart "one tw\u00c7o three" 7] restore_locale set result } 4 test cmdMZ-19.11 {Tcl_StringObjCmd: string wordstart, unicode} {hasIsoLocale} { set_iso8859_1_locale set result [string wordstart "ab\uc700\uc700 cdef ghi" 12] restore_locale set result } 10 test cmdMZ-19.12 {Tcl_StringObjCmd: string wordstart, unicode} { string wordstart "\uc700\uc700 abc" 8 } 3 # The tests for Tcl_SubstObjCmd are in subst.test # The tests for Tcl_SwitchObjCmd are in switch.test # There are no tests for Tcl_TimeObjCmd # The tests for Tcl_TraceObjCmd and TraceVarProc are in trace.test # The tests for Tcl_WhileObjCmd are in while.test return