cmdah.test

tcl是工具命令语言

} {}
test cmdAH-11.11 {Tcl_FileObjCmd: extension} {
    testsetplatform mac
    file ext foo
} {}
test cmdAH-11.12 {Tcl_FileObjCmd: extension} {
    testsetplatform mac
    file extension {}
} {}
test cmdAH-11.13 {Tcl_FileObjCmd: extension} {
    testsetplatform mac
    file extension foo.
} .
test cmdAH-11.14 {Tcl_FileObjCmd: extension} {
    testsetplatform mac
    file extension .foo
} .foo
test cmdAH-11.15 {Tcl_FileObjCmd: extension} {
    testsetplatform mac
    file extension abc.def
} .def
test cmdAH-11.16 {Tcl_FileObjCmd: extension} {
    testsetplatform mac
    file extension abc.def.ghi
} .ghi
test cmdAH-11.17 {Tcl_FileObjCmd: extension} {
    testsetplatform mac
    file extension a:b:c.d
} .d
test cmdAH-11.18 {Tcl_FileObjCmd: extension} {
    testsetplatform mac
    file extension a:b.c:d
} {}
test cmdAH-11.19 {Tcl_FileObjCmd: extension} {
    testsetplatform mac
    file extension a/b/c.d
} .d
test cmdAH-11.20 {Tcl_FileObjCmd: extension} {
    testsetplatform mac
    file extension a/b.c/d
} {}
test cmdAH-11.21 {Tcl_FileObjCmd: extension} {
    testsetplatform mac
    file extension /a.b
} .b
test cmdAH-11.22 {Tcl_FileObjCmd: extension} {
    testsetplatform mac
    file extension foo.c:
} {}
test cmdAH-11.23 {Tcl_FileObjCmd: extension} {
    testsetplatform windows
    file extension {}
} {}
test cmdAH-11.24 {Tcl_FileObjCmd: extension} {
    testsetplatform windows
    file ext foo
} {}
test cmdAH-11.25 {Tcl_FileObjCmd: extension} {
    testsetplatform windows
    file extension foo.
} .
test cmdAH-11.26 {Tcl_FileObjCmd: extension} {
    testsetplatform windows
    file extension .foo
} .foo
test cmdAH-11.27 {Tcl_FileObjCmd: extension} {
    testsetplatform windows
    file extension abc.def
} .def
test cmdAH-11.28 {Tcl_FileObjCmd: extension} {
    testsetplatform windows
    file extension abc.def.ghi
} .ghi
test cmdAH-11.29 {Tcl_FileObjCmd: extension} {
    testsetplatform windows
    file extension a/b/c.d
} .d
test cmdAH-11.30 {Tcl_FileObjCmd: extension} {
    testsetplatform windows
    file extension a/b.c/d
} {}
test cmdAH-11.31 {Tcl_FileObjCmd: extension} {
    testsetplatform windows
    file extension a\\b.c\\
} {}
test cmdAH-11.32 {Tcl_FileObjCmd: extension} {
    testsetplatform windows
    file extension a\\b\\c.d
} .d
test cmdAH-11.33 {Tcl_FileObjCmd: extension} {
    testsetplatform windows
    file extension a\\b.c\\d
} {}
test cmdAH-11.34 {Tcl_FileObjCmd: extension} {
    testsetplatform windows
    file extension a\\b.c\\
} {}
set num 35
foreach value {a..b a...b a.c..b ..b} result {.b .b .b .b} {
    foreach p {unix mac windows} {
;	test cmdAH-7.$num {Tcl_FileObjCmd: extension} "
	    testsetplatform $p
	    file extension $value
	" $result
	incr num
    }
}

# pathtype

test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} {
    testsetplatform unix
    list [catch {file pathtype a b} msg] $msg
} {1 {wrong # args: should be "file pathtype name"}}
test cmdAH-12.2 {Tcl_FileObjCmd: pathtype} {
    testsetplatform unix
    file pathtype /a
} absolute
test cmdAH-12.3 {Tcl_FileObjCmd: pathtype} {
    testsetplatform unix
    file p a
} relative
test cmdAH-12.4 {Tcl_FileObjCmd: pathtype} {
    testsetplatform windows
    file pathtype c:a
} volumerelative

# split

test cmdAH-13.1 {Tcl_FileObjCmd: split} {
    testsetplatform unix
    list [catch {file split a b} msg] $msg
} {1 {wrong # args: should be "file split name"}}
test cmdAH-13.2 {Tcl_FileObjCmd: split} {
    testsetplatform unix
    file split a
} a
test cmdAH-13.3 {Tcl_FileObjCmd: split} {
    testsetplatform unix
    file split a/b
} {a b}

# join

test cmdAH-14.1 {Tcl_FileObjCmd: join} {
    testsetplatform unix
    file join a
} a
test cmdAH-14.2 {Tcl_FileObjCmd: join} {
    testsetplatform unix
    file join a b
} a/b
test cmdAH-14.3 {Tcl_FileObjCmd: join} {
    testsetplatform unix
    file join a b c d
} a/b/c/d

# error handling of Tcl_TranslateFileName

test cmdAH-15.1 {Tcl_FileObjCmd} {
    testsetplatform unix
    list [catch {file atime ~_bad_user} msg] $msg
} {1 {user "_bad_user" doesn't exist}}

testsetplatform $platform
}

# readable

set gorpfile [makeFile abcde gorp.file]
set dirfile [makeDirectory dir.file]

if {[info commands testchmod] == {}} {
    puts "This application hasn't been compiled with the \"testchmod\""
    puts "command, so I can't test Tcl_FileObjCmd etc."
} else {
test cmdAH-16.1 {Tcl_FileObjCmd: readable} {testchmod} {
    list [catch {file readable a b} msg] $msg
} {1 {wrong # args: should be "file readable name"}}
testchmod 0444 $gorpfile
test cmdAH-16.2 {Tcl_FileObjCmd: readable} {testchmod} {
    file readable $gorpfile
} 1
testchmod 0333 $gorpfile
test cmdAH-16.3 {Tcl_FileObjCmd: readable} {unixOnly notRoot testchmod} {
    file reada $gorpfile
} 0

# writable

test cmdAH-17.1 {Tcl_FileObjCmd: writable} {testchmod} {
    list [catch {file writable a b} msg] $msg
} {1 {wrong # args: should be "file writable name"}}
testchmod 0555 $gorpfile
test cmdAH-17.2 {Tcl_FileObjCmd: writable} {notRoot testchmod} {
    file writable $gorpfile
} 0
testchmod 0222 $gorpfile
test cmdAH-17.3 {Tcl_FileObjCmd: writable} {testchmod} {
    file writable $gorpfile
} 1
}

# executable

removeFile $gorpfile
removeDirectory $dirfile
set dirfile [makeDirectory dir.file]
set gorpfile [makeFile abcde gorp.file]

test cmdAH-18.1 {Tcl_FileObjCmd: executable} {testchmod} {
    list [catch {file executable a b} msg] $msg
} {1 {wrong # args: should be "file executable name"}}
test cmdAH-18.2 {Tcl_FileObjCmd: executable} {testchmod} {
    file executable $gorpfile
} 0
test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly testchmod} {
    # Only on unix will setting the execute bit on a regular file
    # cause that file to be executable.   
    
    testchmod 0775 $gorpfile
    file exe $gorpfile
} 1

test cmdAH-18.4 {Tcl_FileObjCmd: executable} {macOnly testchmod} {
    # On mac, the only executable files are of type APPL.

    set x [file exe $gorpfile]    
    file attrib $gorpfile -type APPL
    lappend x [file exe $gorpfile]
} {0 1}
test cmdAH-18.5 {Tcl_FileObjCmd: executable} {pcOnly testchmod} {
    # On pc, must be a .exe, .com, etc.
    
    set x [file exe $gorpfile]
    set gorpexe [makeFile foo gorp.exe]
    lappend x [file exe $gorpexe]
    removeFile $gorpexe
    set x
} {0 1}
test cmdAH-18.6 {Tcl_FileObjCmd: executable} {testchmod} {
    # Directories are always executable.
    
    file exe $dirfile
} 1

removeDirectory $dirfile
removeFile $gorpfile
set linkfile [file join [temporaryDirectory] link.file]
file delete $linkfile

# exists

test cmdAH-19.1 {Tcl_FileObjCmd: exists} {
    list [catch {file exists a b} msg] $msg
} {1 {wrong # args: should be "file exists name"}}
test cmdAH-19.2 {Tcl_FileObjCmd: exists} {file exists $gorpfile} 0
test cmdAH-19.3 {Tcl_FileObjCmd: exists} {
    file exists [file join [temporaryDirectory] dir.file gorp.file]
} 0
catch {
    set gorpfile [makeFile abcde gorp.file]
    set dirfile [makeDirectory dir.file]
    set subgorp [makeFile 12345 [file join $dirfile gorp.file]]
}
test cmdAH-19.4 {Tcl_FileObjCmd: exists} {
    file exists $gorpfile
} 1
test cmdAH-19.5 {Tcl_FileObjCmd: exists} {
    file exists $subgorp
} 1

# nativename
if {[info commands testsetplatform] == {}} {
    puts "This application hasn't been compiled with the \"testsetplatform\""
    puts "command, so I can't test Tcl_FileObjCmd etc."
} else {
test cmdAH-19.6 {Tcl_FileObjCmd: nativename} {
    testsetplatform unix
    list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
} {0 a/b {}}
test cmdAH-19.7 {Tcl_FileObjCmd: nativename} {
    testsetplatform windows
    list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
} {0 {a\b} {}}
test cmdAH-19.8 {Tcl_FileObjCmd: nativename} {
    testsetplatform mac
    list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
} {0 :a:b {}}
}

test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} {
    file exists ~nOsUcHuSeR
} 0
test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} {
    # should probably be 0 in fact...
    catch {file nativename ~nOsUcHuSeR}
} 1

# The test below has to be done in /tmp rather than the current
# directory in order to guarantee (?) a local file system:  some
# NFS file systems won't do the stuff below correctly.

test cmdAH-19.11 {Tcl_FileObjCmd: exists} {unixOnly notRoot} {
    file delete -force /tmp/tcl.foo.dir/file
    file delete -force /tmp/tcl.foo.dir
    makeDirectory /tmp/tcl.foo.dir
    makeFile 12345 /tmp/tcl.foo.dir/file
    file attributes /tmp/tcl.foo.dir -permissions 0000

    set result [file exists /tmp/tcl.foo.dir/file]

    file attributes /tmp/tcl.foo.dir -permissions 0775
    removeFile /tmp/tcl.foo.dir/file
    removeDirectory /tmp/tcl.foo.dir
    set result
} 0

# Stat related commands

catch {testsetplatform $platform}
removeFile $gorpfile
set gorpfile [makeFile "Test string" gorp.file]
catch {file attributes $gorpfile -permissions 0765}

# atime

set file [makeFile "data" touch.me]

test cmdAH-20.1 {Tcl_FileObjCmd: atime} {
    list [catch {file atime a b c} msg] $msg
} {1 {wrong # args: should be "file atime name ?time?"}}
test cmdAH-20.2 {Tcl_FileObjCmd: atime} {
    catch {unset stat}
    file stat $gorpfile stat
    list [expr {[file mtime $gorpfile] == $stat(mtime)}] \
	    [expr {[file atime $gorpfile] == $stat(atime)}]
} {1 1}
test cmdAH-20.3 {Tcl_FileObjCmd: atime} {
    string tolower [list [catch {file atime _bogus_} msg] \
	    $msg $errorCode]
} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-20.4 {Tcl_FileObjCmd: atime} {
    list [catch {file atime $file notint} msg] $msg
} {1 {expected integer but got "notint"}}
test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unixOrPc} {
    if {[string equal $tcl_platform(platform) "windows"]} {
	set old [pwd]
	cd $::tcltest::temporaryDirectory
	if {![string equal "NTFS" [testvolumetype]]} {
	    # Windows FAT doesn't understand atime, but NTFS does
	    # May also fail for Windows on NFS mounted disks
	    cd $old
	    return 1
	}
	cd $old
    }
    set atime [file atime $file]
    after 1100; # pause a sec to notice change in atime
    set newatime [clock seconds]
    set modatime [file atime $file $newatime]
    expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
} 1

removeFile touch.me
# isdirectory

test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} {
    list [catch {file isdirectory a b} msg] $msg
} {1 {wrong # args: should be "file isdirectory name"}}
test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {
    file isdirectory $gorpfile
} 0
test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {
    file isd $dirfile
} 1

# isfile

test cmdAH-22.1 {Tcl_FileObjCmd: isfile} {
    list [catch {file isfile a b} msg] $msg
} {1 {wrong # args: should be "file isfile name"}}
test cmdAH-22.2 {Tcl_FileObjCmd: isfile} {file isfile $gorpfile} 1
test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile $dirfile} 0

# lstat and readlink:  don't run these tests everywhere, since not all
# sites will have symbolic links

catch {file link -symbolic $linkfile $gorpfile}
test cmdAH-23.1 {Tcl_FileObjCmd: lstat} {
    list [catch {file lstat a} msg] $msg
} {1 {wrong # args: should be "file lstat name varName"}}
test cmdAH-23.2 {Tcl_FileObjCmd: lstat} {
    list [catch {file lstat a b c} msg] $msg
} {1 {wrong # args: should be "file lstat name varName"}}
test cmdAH-23.3 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
    catch {unset stat}
    file lstat $linkfile stat
    lsort [array names stat]
} {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-23.4 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
    catch {unset stat}
    file lstat $linkfile stat
    list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
} {1 511 link}
test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
    string tolower [list [catch {file lstat _bogus_ stat} msg] \
	    $msg $errorCode]
} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} {
    catch {unset x}
    set x 44
    list [catch {file lstat $gorpfile x} msg] $msg $errorCode
} {1 {can't set "x(dev)": variable isn't array} NONE}
catch {unset stat}

# mkdir

set dirA [file join [temporaryDirectory] a]
set dirB [file join [temporaryDirectory] a]
test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} {
    catch {file delete -force $dirA}
    file mkdir $dirA
    set res [file isdirectory $dirA]
    file delete $dirA