# 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.

 # 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: cmdMZ.test,v 1.13.2.3 2004/02/25 23:38:16 dgp Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {

     package require tcltest 2.1

     namespace import -force ::tcltest::*

 }

 # 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 nonPortable} {

     # This test fails on various unix platforms (eg Linux) where

     # permissions caching causes this to fail.  The caching is strictly

     # 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 $foodir

     file attr . -permissions 000

     set result [list [catch {pwd} msg] $msg]

     cd $cwd

     file delete -force $foodir

     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 {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"}}

 proc ListGlobMatch {expected actual} {

     if {[llength $expected] != [llength $actual]} {

 	return 0

     }

     foreach e $expected a $actual {

 	if {![string match $e $a]} {

 	    return 0

 	}

     }

     return 1

 }

 customMatch listGlob ListGlobMatch

 test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -setup {

     set file [makeFile {

 	set x 146

 	error "error in sourced file"

 	set y $x

     } source.file]

 } -body {

     list [catch {source $file} msg] $msg $errorInfo

 } -cleanup {

     removeFile source.file

 } -match listGlob -result {1 {error in sourced file} {error in sourced file

     while executing

 "error "error in sourced file""

     (file "*" line 3)

     invoked from within

 "source $file"}}

 test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} {

     set file [makeFile {list result} source.file]

     set result [source $file]

     removeFile source.file

     set result

 } 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"

 # 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

 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