os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/cmdMZ.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/cmdMZ.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,214 @@
1.4 +# The tests in this file cover the procedures in tclCmdMZ.c.
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1991-1993 The Regents of the University of California.
1.11 +# Copyright (c) 1994 Sun Microsystems, Inc.
1.12 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.13 +#
1.14 +# See the file "license.terms" for information on usage and redistribution
1.15 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 +#
1.17 +# RCS: @(#) $Id: cmdMZ.test,v 1.13.2.3 2004/02/25 23:38:16 dgp Exp $
1.18 +
1.19 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.20 + package require tcltest 2.1
1.21 + namespace import -force ::tcltest::*
1.22 +}
1.23 +
1.24 +# Tcl_PwdObjCmd
1.25 +
1.26 +test cmdMZ-1.1 {Tcl_PwdObjCmd} {
1.27 + list [catch {pwd a} msg] $msg
1.28 +} {1 {wrong # args: should be "pwd"}}
1.29 +test cmdMZ-1.2 {Tcl_PwdObjCmd: simple pwd} {
1.30 + catch pwd
1.31 +} 0
1.32 +test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} {
1.33 + expr [string length pwd]>0
1.34 +} 1
1.35 +test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unixOnly nonPortable} {
1.36 + # This test fails on various unix platforms (eg Linux) where
1.37 + # permissions caching causes this to fail. The caching is strictly
1.38 + # incorrect, but we have no control over that.
1.39 + set foodir [file join [temporaryDirectory] foo]
1.40 + file delete -force $foodir
1.41 + file mkdir $foodir
1.42 + set cwd [pwd]
1.43 + cd $foodir
1.44 + file attr . -permissions 000
1.45 + set result [list [catch {pwd} msg] $msg]
1.46 + cd $cwd
1.47 + file delete -force $foodir
1.48 + set result
1.49 +} {1 {error getting working directory name: permission denied}}
1.50 +
1.51 +# The tests for Tcl_RegexpObjCmd, Tcl_RegsubObjCmd are in regexp.test
1.52 +
1.53 +# Tcl_RenameObjCmd
1.54 +
1.55 +test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} {
1.56 + list [catch {rename r1} msg] $msg $errorCode
1.57 +} {1 {wrong # args: should be "rename oldName newName"} NONE}
1.58 +test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} {
1.59 + list [catch {rename r1 r2 r3} msg] $msg $errorCode
1.60 +} {1 {wrong # args: should be "rename oldName newName"} NONE}
1.61 +test cmdMZ-2.3 {Tcl_RenameObjCmd: success} {
1.62 + catch {rename r2 {}}
1.63 + proc r1 {} {return "r1"}
1.64 + rename r1 r2
1.65 + r2
1.66 +} {r1}
1.67 +test cmdMZ-2.4 {Tcl_RenameObjCmd: success} {
1.68 + proc r1 {} {return "r1"}
1.69 + rename r1 {}
1.70 + list [catch {r1} msg] $msg
1.71 +} {1 {invalid command name "r1"}}
1.72 +
1.73 +# The tests for Tcl_ReturnObjCmd are in proc-old.test
1.74 +# The tests for Tcl_ScanObjCmd are in scan.test
1.75 +
1.76 +# Tcl_SourceObjCmd
1.77 +
1.78 +test cmdMZ-3.1 {Tcl_SourceObjCmd: error conditions} {macOnly} {
1.79 + list [catch {source} msg] $msg
1.80 +} {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
1.81 +test cmdMZ-3.2 {Tcl_SourceObjCmd: error conditions} {macOnly} {
1.82 + list [catch {source a b} msg] $msg
1.83 +} {1 {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
1.84 +test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} {unixOrPc} {
1.85 + list [catch {source} msg] $msg
1.86 +} {1 {wrong # args: should be "source fileName"}}
1.87 +test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} {unixOrPc} {
1.88 + list [catch {source a b} msg] $msg
1.89 +} {1 {wrong # args: should be "source fileName"}}
1.90 +
1.91 +proc ListGlobMatch {expected actual} {
1.92 + if {[llength $expected] != [llength $actual]} {
1.93 + return 0
1.94 + }
1.95 + foreach e $expected a $actual {
1.96 + if {![string match $e $a]} {
1.97 + return 0
1.98 + }
1.99 + }
1.100 + return 1
1.101 +}
1.102 +customMatch listGlob ListGlobMatch
1.103 +
1.104 +test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -setup {
1.105 + set file [makeFile {
1.106 + set x 146
1.107 + error "error in sourced file"
1.108 + set y $x
1.109 + } source.file]
1.110 +} -body {
1.111 + list [catch {source $file} msg] $msg $errorInfo
1.112 +} -cleanup {
1.113 + removeFile source.file
1.114 +} -match listGlob -result {1 {error in sourced file} {error in sourced file
1.115 + while executing
1.116 +"error "error in sourced file""
1.117 + (file "*" line 3)
1.118 + invoked from within
1.119 +"source $file"}}
1.120 +test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} {
1.121 + set file [makeFile {list result} source.file]
1.122 + set result [source $file]
1.123 + removeFile source.file
1.124 + set result
1.125 +} result
1.126 +
1.127 +# Tcl_SplitObjCmd
1.128 +
1.129 +test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} {
1.130 + list [catch split msg] $msg $errorCode
1.131 +} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
1.132 +test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} {
1.133 + list [catch {split a b c} msg] $msg $errorCode
1.134 +} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
1.135 +test cmdMZ-4.3 {Tcl_SplitObjCmd: basic split commands} {
1.136 + split "a\n b\t\r c\n "
1.137 +} {a {} b {} {} c {} {}}
1.138 +test cmdMZ-4.4 {Tcl_SplitObjCmd: basic split commands} {
1.139 + split "word 1xyzword 2zword 3" xyz
1.140 +} {{word 1} {} {} {word 2} {word 3}}
1.141 +test cmdMZ-4.5 {Tcl_SplitObjCmd: basic split commands} {
1.142 + split "12345" {}
1.143 +} {1 2 3 4 5}
1.144 +test cmdMZ-4.6 {Tcl_SplitObjCmd: basic split commands} {
1.145 + split "a\}b\[c\{\]\$"
1.146 +} "a\\}b\\\[c\\{\\\]\\\$"
1.147 +test cmdMZ-4.7 {Tcl_SplitObjCmd: basic split commands} {
1.148 + split {} {}
1.149 +} {}
1.150 +test cmdMZ-4.8 {Tcl_SplitObjCmd: basic split commands} {
1.151 + split {}
1.152 +} {}
1.153 +test cmdMZ-4.9 {Tcl_SplitObjCmd: basic split commands} {
1.154 + split { }
1.155 +} {{} {} {} {}}
1.156 +test cmdMZ-4.10 {Tcl_SplitObjCmd: basic split commands} {
1.157 + proc foo {} {
1.158 + set x {}
1.159 + foreach f [split {]\n} {}] {
1.160 + append x $f
1.161 + }
1.162 + return $x
1.163 + }
1.164 + foo
1.165 +} {]\n}
1.166 +test cmdMZ-4.11 {Tcl_SplitObjCmd: basic split commands} {
1.167 + proc foo {} {
1.168 + set x ab\000c
1.169 + set y [split $x {}]
1.170 + return $y
1.171 + }
1.172 + foo
1.173 +} "a b \000 c"
1.174 +test cmdMZ-4.12 {Tcl_SplitObjCmd: basic split commands} {
1.175 + split "a0ab1b2bbb3\000c4" ab\000c
1.176 +} {{} 0 {} 1 2 {} {} 3 {} 4}
1.177 +test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
1.178 + # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq"
1.179 + split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e"
1.180 +} "a b qw\u5e4eN wq"
1.181 +
1.182 +# The tests for Tcl_StringObjCmd are in string.test
1.183 +# The tests for Tcl_SubstObjCmd are in subst.test
1.184 +# The tests for Tcl_SwitchObjCmd are in switch.test
1.185 +
1.186 +test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} {
1.187 + list [catch {time} msg] $msg
1.188 +} {1 {wrong # args: should be "time command ?count?"}}
1.189 +test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} {
1.190 + list [catch {time a b c} msg] $msg
1.191 +} {1 {wrong # args: should be "time command ?count?"}}
1.192 +test cmdMZ-5.3 {Tcl_TimeObjCmd: basic format of command} {
1.193 + list [catch {time a b} msg] $msg
1.194 +} {1 {expected integer but got "b"}}
1.195 +test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} {
1.196 + time bogusCmd -12456
1.197 +} {0 microseconds per iteration}
1.198 +test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} {
1.199 + regexp {^\d+ microseconds per iteration} [time {format 1}]
1.200 +} 1
1.201 +test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} {
1.202 + expr {[lindex [time {after 2}] 0] < [lindex [time {after 1000}] 0]}
1.203 +} 1
1.204 +test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} {
1.205 + list [catch {time {error foo}} msg] $msg $::errorInfo
1.206 +} {1 foo {foo
1.207 + while executing
1.208 +"error foo"
1.209 + invoked from within
1.210 +"time {error foo}"}}
1.211 +
1.212 +# The tests for Tcl_TraceObjCmd and TraceVarProc are in trace.test
1.213 +# The tests for Tcl_WhileObjCmd are in while.test
1.214 +
1.215 +# cleanup
1.216 +::tcltest::cleanupTests
1.217 +return