source [file dirname [info script]]/testing.tcl

needs cmd file
catch {file link} msg
testConstraint filelink [string match "wrong # args:*" $msg]
catch {file lstat} msg
testConstraint filelstat [string match "wrong # args:*" $msg]
testConstraint unix [expr {$tcl_platform(platform) eq "unix"}]
if {[testConstraint jim]} {
	testConstraint mtimeset [expr {!$tcl_platform(bootstrap)}]
} else {
	testConstraint mtimeset 1
}

test join-1.1 "One name" {
	file join abc
} {abc}

test join-1.2 "One name with trailing slash" {
	file join abc/
} {abc}

test join-1.3 "One name with leading slash" {
	file join /abc
} {/abc}

test join-1.4 "One name with leading and trailing slash" {
	file join /abc/
} {/abc}

test join-1.5 "Two names" {
	file join abc def
} {abc/def}

test join-1.6 "Two names with dir trailing slash" {
	file join abc/ def
} {abc/def}

test join-1.7 "Two names with dir leading slash" {
	file join /abc def
} {/abc/def}

test join-1.8 "Two names with dir leading and trailing slash" {
	file join /abc/ def
} {/abc/def}

test join-1.9 "Two names with file trailing slash" {
	file join abc def/
} {abc/def}

test join-1.10 "Two names with file leading slash" {
	file join abc /def
} {/def}

test join-1.11 "Two names with file leading and trailing slash" {
	file join abc /def/
} {/def}

test join-1.12 "Two names with double slashes" {
	file join abc/ /def
} {/def}

test join-1.13 "Join to root" {
	file join / abc
} {/abc}

test join-1.14 "Join to root" {
	set dir [file join / .]
	# Either / or /. is OK here
	expr {$dir in {/ /.}}
} 1

test join-1.15 "Join to root" {
	file join / /
} {/}

test join-1.16 "Join to root" {
	file join /abc /
} {/}

test join-1.17 "With trailing slash" {
	file join /abc/def/ ghi/jkl
} {/abc/def/ghi/jkl}

test join-2.1 "Dir is empty string" {
	file join "" def
} {def}

test join-2.2 "File is empty string" {
	file join abc ""
} {abc}

test join-2.3 "Path too long" jim {
	set components [string repeat {abcdefghi } 500]
	list [catch [concat file join $components] msg] $msg
} {1 {Path too long}}

test tail-1.1 "One component" {
	file tail abc
} {abc}

test tail-1.2 "Two components" {
	file tail abc/def
} {def}

test tail-1.3 "Absolute one component" {
	file tail /abc
} {abc}

test tail-1.4 "Trailing slash" {
	file tail abc/
} {abc}

test dirname-1.1 "One component" {
	file dirname abc
} {.}

test dirname-1.2 "Two components" {
	file dirname abc/def
} {abc}

test dirname-1.3 "Absolute one component" {
	file dirname /abc
} {/}

test dirname-1.4 "Trailing slash" {
	file dirname abc/
} {.}

test dirname-1.5 ".." {
	file dirname ..
} {.}

test dirname-1.6 "abc/.." {
	file dirname abc/..
} {abc}

test dirname-1.7 "../abc" {
	file dirname ../abc
} {..}

test stat-1.1 {file stat usage} -body {
	file stat
} -returnCodes error -match glob -result {wrong # args: should be "file stat name*"}

test stat-1.2 {file stat usage} -body {
	file stat nonexistent a
} -returnCodes error -match glob -result {could not read "nonexistent": *}

test stat-1.3 {file stat} {
	unset -nocomplain a
	file stat [info script] a
	set a(type)
} {file}

test stat-1.4 {file stat update array} {
	set a(type) bogus
	file stat [info nameofexecutable] a
	set a(type)
} {file}

test stat-1.5 {file stat update bad array} -body {
	unset -nocomplain a
	# invalid dict/array
	set a {1 2 3}
	file stat [info nameofexecutable] a
} -returnCodes error -result {can't set "a(dev)": variable isn't array}

test stat-1.7 {file stat no variable} jim {
	set a [file stat [info script]]
	set a(type)
} {file}

test ext-1.1 {file ext} -body {
	file ext
} -returnCodes error -result {wrong # args: should be "file extension name"}

test ext-1.2 {file ext basic} {
	file ext abc.def
} {.def}

test ext-1.3 {file ext path} {
	file ext 123/abc.def
} {.def}

test ext-1.4 {file ext noext} {
	file ext abc
} {}

test ext-1.5 {file ext noext} {
	file ext abc.def/ghi
} {}

test rootname-1.1 {file rootname} -body {
	file rootname
} -returnCodes error -result {wrong # args: should be "file rootname name"}

test rootname-1.2 {file rootname basic} -body {
	file rootname abc
} -result {abc}

test rootname-1.3 {file rootname basic} -body {
	file rootname abc/def
} -result {abc/def}

test rootname-1.4 {file rootname basic} -body {
	file rootname abc.c
} -result {abc}

test rootname-1.5 {file rootname basic} -body {
	file rootname abc/def.c
} -result {abc/def}

test rootname-1.6 {file rootname odd cases} -body {
	file rootname abc/def.c/ghi
} -result {abc/def.c/ghi}

test rootname-1.7 {file rootname odd cases} -body {
	file rootname abc/def.c/
} -result {abc/def.c/}

test rootname-1.8 {file rootname odd cases} -body {
	file rootname abc/def.c//
} -result {abc/def.c//}

test readable-1.1 {file readable} {
	file readable [info script]
} {1}

test writable-1.1 {file writable} -body {
	set name tmp.[pid]
	makeFile testing $name
	file writable $name
} -result 1 -cleanup {
	file delete $name
}

test rename-1.1 {file rename usage} -body {
	file rename
} -returnCodes error -match glob -result {wrong # args: should be *}

test rename-1.2 {file rename usage} -body {
	file rename -badarg name1 name2
} -returnCodes error -match glob -result {*}

test rename-1.1 {file rename, target exists} -body {
	set name1 tmp.[pid]
	set name2 tmp2.[pid]
	makeFile testing $name1
	makeFile testing2 $name2
	file rename $name1 $name2
} -returnCodes error -match glob -result {error renaming *}

test rename-1.2 {file rename -force, target exists} -body {
	file rename -force $name1 $name2
	list [file exists $name1] [file exists $name2]
} -result {0 1} -cleanup {
	file delete $name2
}

test link-1.1 {file link usage} -constraints filelink -body {
	file link
} -returnCodes error -match glob -result {wrong # args: should be "file link*}

test link-1.2 {file hard link} -constraints filelink -body {
	set name tmp.[pid]
	file link $name [info script]
	file exists $name
} -result {1} -cleanup {
	file delete $name
}

test link-1.3 {file hard link} -constraints filelink -body {
	set name tmp.[pid]
	file link -hard $name [info script]
	file exists $name
} -result {1} -cleanup {
	file delete $name
}

test link-1.4 {file sym link} -constraints filelink -body {
	set name tmp.[pid]
	file link -sym $name [info script]
	list [file exists $name] [file tail [file readlink $name]]
} -result {1 file.test} -cleanup {
	file delete $name
}

test link-1.5 {file readlink, bad link} -constraints filelink -body {
	file readlink [info script]
} -returnCodes error -match glob -result {could not read*link "*file.test": *}

test link-1.6 {file link badopt} -constraints filelink -body {
	file link -bad name1 name2
} -returnCodes error -match glob -result {bad * "-bad": must be *}

test lstat-1.1 {file lstat} -constraints filelstat -body {
	file lstat
} -returnCodes error -match glob -result {wrong # args: should be "file lstat name *}

test lstat-1.2 {file lstat} -constraints filelstat -body {
	file lstat nonexistent ls
} -returnCodes error -match glob -result {could not read "nonexistent": *}

test lstat-1.3 {file lstat} -constraints {filelink filelstat} -body {
	set name tmp.[pid]
	file link -sym $name [info script]
	unset -nocomplain s ls
	file lstat $name ls
	file stat [info script] s
	list $ls(type) $s(type)
} -match glob -result {link file} -cleanup {
	file delete $name
}

test type-1.1 {file type} {
	file type [info script]
} {file}

test type-1.2 {file type} {
	file type [file dirname [info script]]
} {directory}

test type-1.2 {file type} -body {
	file type nonexistent
} -returnCodes error -match glob -result {could not read "nonexistent": *}

test isfile-1.1 {file isfile} -body {
	file isfile
} -returnCodes error -result {wrong # args: should be "file isfile name"}

test isfile-1.2 {file isfile} {
	file isfile [info script]
} {1}

test isfile-1.3 {file isfile} {
	file isfile [file dirname [info script]]
} {0}

test size-1.1 {file size} -body {
	file size
} -returnCodes error -result {wrong # args: should be "file size name"}

test size-1.2 {file size} -body {
	file size nonexistent
} -returnCodes error -match glob -result {could not read "nonexistent":*}

test size-1.3 {file size} {
	set size [file size [info script]]
	file stat [info script] s
	expr {$size - $s(size)}
} {0}

test mtime-1.1 {file mtime} -body {
	file mtime
} -returnCodes error -result {wrong # args: should be "file mtime name ?time?"}

test mtime-1.2 {file mtime} -body {
	file mtime nonexistent
} -returnCodes error -match glob -result {could not read "nonexistent":*}

test mtime-1.3 {file mtime} -body {
	file mtime [info script] bad
} -returnCodes error -result {expected integer but got "bad"}

test mtime-1.4 {file mtime} {
	set mtime [file mtime [info script]]
	file stat [info script] s
	if {$mtime != $s(mtime)} {
		error "mtime was $mtime but s(mtime) was $s(mtime)"
	}
} {}

test mtime-1.5 {file mtime} -constraints {mtimeset unix} -body {
	set name tmp.[pid]
	makeFile testing $name
	set t [file mtime [info script]]
	file mtime $name $t
	expr {$t - [file mtime $name]}
} -result {0} -cleanup {
	file delete $name
}

test atime-1.1 {file atime} -body {
	file atime
} -returnCodes error -match glob -result {wrong # args: should be "file atime name*}

test atime-1.2 {file atime} -body {
	file atime nonexistent
} -returnCodes error -match glob -result {could not read "nonexistent":*}

test atime-1.3 {file atime} {
	set atime [file atime [info script]]
	file stat [info script] s
	expr {$atime - $s(atime)}
} {0}

# These tests are courtesy of picol

test file.12.1 "picol test" {file dirname /foo/bar/grill.txt}  /foo/bar
test file.12.2 "picol test" {file dirname /foo/bar/baz/}       /foo/bar
test file.12.3 "picol test" {file dirname /foo/bar/baz///}     /foo/bar
test file.12.4 "picol test" {file dirname /foo/bar/baz///qux}  /foo/bar/baz
test file.12.5 "picol test" {file dirname foo/bar/grill.txt}   foo/bar
test file.12.6 "picol test" {file dirname foo/bar/baz/}        foo/bar
test file.12.7 "picol test" {file dirname {}}    .
test file.12.8 "picol test" {file dirname /}     /
test file.12.9 "picol test" {file dirname ///}   /

test file.13.1 "picol test" {file tail /foo/bar/grill.txt}   grill.txt
test file.13.2 "picol test" {file tail /foo/bar/baz/}        baz
test file.13.3 "picol test" {file tail /foo/bar/baz///}      baz
test file.13.4 "picol test" {file dirname /foo/bar/baz///qux}  /foo/bar/baz
test file.13.5 "picol test" {file tail foo/bar/grill.txt}    grill.txt
test file.13.6 "picol test" {file tail foo/bar/baz/}         baz
test file.13.7 "picol test" {file tail {}}    {}
test file.13.8 "picol test" {file tail /}     {}
test file.13.9 "picol test" {file tail ///}   {}

test file.14   "picol test" {file join foo}               foo
test file.15   "picol test" {file join foo bar}           foo/bar
test file.16   "picol test" {file join foo /bar}          /bar

if {$tcl_platform(platform) eq {windows}} {
    test file.17  "picol test" {file join foo C:/bar grill}  C:/bar/grill
}

test file.18   "picol test" {file split {/foo/space station/bar}}  {/ foo {space station} bar}
test file.19   "picol test" {file split {/foo/space station/bar/}}  {/ foo {space station} bar}
test file.20   "picol test" {file split {foo/space station/bar}}  {foo {space station} bar}
test file.21   "picol test" {file split foo///bar}  {foo bar}
test file.22   "picol test" {file split foo}  foo

testreport