Updated to tcl 8.4.1

[pf3gnuchains/pf3gnuchains3x.git] / tcl / tests / cmdMZ.test

diff --git a/tcl/tests/cmdMZ.test b/tcl/tests/cmdMZ.test
index f1926b8..234aedf 100644 (file)
--- a/tcl/tests/cmdMZ.test
+++ b/tcl/tests/cmdMZ.test
@@ -17,6 +17,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
+set tcltest::testConstraints(nonLinuxOnly) \
+       [expr {![string equal Linux $tcl_platform(os)]}]
 
 # Tcl_PwdObjCmd
 
@@ -29,15 +31,19 @@ test cmdMZ-1.2 {Tcl_PwdObjCmd: simple pwd} {
 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
+test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unixOnly nonLinuxOnly} {
+    # We don't want this test to run on Linux because they do a
+    # permissions caching trick which causes this to fail.  The
+    # caching is incorrect, but we have no control over that.
+    set foodir [file join [temporaryDirectory] foo]
+    file delete -force $foodir
+    file mkdir $foodir
     set cwd [pwd]
-    cd foo
+    cd $foodir
     file attr . -permissions 000
     set result [list [catch {pwd} msg] $msg]
     cd $cwd
-    file delete -force foo
+    file delete -force $foodir
     set result
 } {1 {error getting working directory name: permission denied}}
 
@@ -73,29 +79,33 @@ test cmdMZ-3.1 {Tcl_SourceObjCmd: error conditions} {macOnly} {
 } {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?"}}
+} {1 {bad argument: 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 {
+test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body {
+    set file [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
+    } source.file]
+    set result [list [catch {source $file} msg] $msg $errorInfo]
+    removeFile source.file
+    set result
+} -match glob -result {1 {error in sourced file} {error in sourced file
     while executing
 "error "error in sourced file""
-    (file "source.file" line 3)
+    (file "*" line 3)
     invoked from within
-"source source.file"}}
+"source $file"}}
 test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} {
-    makeFile {list result} source.file
-    source source.file
+    set file [makeFile {list result} source.file]
+    set result [source $file]
+    removeFile source.file
+    set result
 } result
 
 # Tcl_SplitObjCmd
@@ -156,11 +166,36 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
 # The tests for Tcl_StringObjCmd are in string.test
 # 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
+
+test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} {
+    list [catch {time} msg] $msg
+} {1 {wrong # args: should be "time command ?count?"}}
+test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} {
+    list [catch {time a b c} msg] $msg
+} {1 {wrong # args: should be "time command ?count?"}}
+test cmdMZ-5.3 {Tcl_TimeObjCmd: basic format of command} {
+    list [catch {time a b} msg] $msg
+} {1 {expected integer but got "b"}}
+test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} {
+    time bogusCmd -12456
+} {0 microseconds per iteration}
+test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} {
+    regexp {^\d+ microseconds per iteration} [time {format 1}]
+} 1
+test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} {
+    expr {[lindex [time {after 2}] 0] < [lindex [time {after 1000}] 0]}
+} 1
+test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} {
+    list [catch {time {error foo}} msg] $msg $::errorInfo
+} {1 foo {foo
+    while executing
+"error foo"
+    invoked from within
+"time {error foo}"}}
+
 # The tests for Tcl_TraceObjCmd and TraceVarProc are in trace.test
 # The tests for Tcl_WhileObjCmd are in while.test
 
 # cleanup
 ::tcltest::cleanupTests
 return
-