# -*- tcl -*-
# Tests for the find function.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright (c) 2001 by ActiveState Tool Corp.
# All rights reserved.
#
# RCS: @(#) $Id: fileutil.test,v 1.13 2003/05/01 22:40:15 patthoyts Exp $

# -------------------------------------------------------------------------
# Initialise the test package
#
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

# -------------------------------------------------------------------------
# Ensure we test _this_ local copy and one installed somewhere else.
#
package forget fileutil
catch {namespace delete ::fileutil}
if { [lsearch $auto_path [file dirname [info script]]] == -1 } {
    set auto_path [linsert $auto_path 0 [file dirname [info script]]]
}
if {[catch {source [file join [file dirname [info script]] fileutil.tcl]} msg]} {
    puts "skipped [file tail [info script]]: $msg"
    return
}

# -------------------------------------------------------------------------
# Setup any constraints
#
# This constraint restricts certain tests to run on tcl 8.3+
if {[package vsatisfies [package provide tcltest] 2.0]} {
    # tcltest2.0+ has an API to specify a test constraint
    ::tcltest::testConstraint tcl8.3plus \
        [expr {[package vsatisfies [package provide Tcl] 8.3]}]
} else {
    # In tcltest1.0, a global variable needs to be set directly.
    set ::tcltest::testConstraints(tcl8.3plus) \
        [expr {[package vsatisfies [package provide Tcl] 8.3]}]
}

# -------------------------------------------------------------------------
# Now the package specific tests....
# -------------------------------------------------------------------------

puts "- tcltest [package present tcltest]"
puts "- fileutil [package present fileutil]"

# -------------------------------------------------------------------------

# Build a sample tree to search
# Structure
#
#	dir
#	+--find1
#          +--find2
#          |  +--file2
#          +--file1

catch {removeDirectory find1} ; # start with a clean structure!

makeDirectory find1
makeDirectory [file join find1 find2]
makeFile "" [file join find1 file1]
makeFile "test" [file join find1 find2 file2]
set dir $::tcltest::temporaryDirectory

proc fileIsBiggerThan {s f} {
    expr {![file isdirectory $f] && [file size $f] > $s}
}

test find-1.1 {standard recursive find} {
    lsort [fileutil::find [file join $dir find1]]
} [list [file join $dir find1 file1] [file join $dir find1 find2] \
	[file join $dir find1 find2 file2]]
test find-1.2 {find directories} {
    fileutil::find [file join $dir find1] {file isdirectory}
} [list [file join $dir find1 find2]]
test find-1.3 {find files bigger than a given size} {
    fileutil::find [file join $dir find1] {fileIsBiggerThan 1}
} [list [file join $dir find1 find2 file2]]


# Extend the previous sample tree
# Extended structure:
#
#	dir
#	+--find1
#          +--find2       <----------+
#          |  +--file2		     |
#          |  +--file3 --> ../find2 -+
#          +--file1

test find-1.4 {handling of circular links} {unix} {
    catch {file delete -force [file join $dir find1 find2 file3]}
    exec ln -s ../find2 [file join $dir find1 find2 file3]

    # Find has to skip 'file3'
    lsort [fileutil::find [file join $dir find1]]
} [list [file join $dir find1 file1] [file join $dir find1 find2] \
	[file join $dir find1 find2 file2]]


# find by pattern tests

test find-2.0 {find by pattern} {
    catch {::fileutil::findByPattern $dir -glob {fil*} foo} msg
    set msg
} {wrong#args for "::fileutil::findByPattern", should be "::fileutil::findByPattern basedir ?-regexp|-glob? ?--? patterns"}

test find-2.1 {find by pattern} {
    catch {::fileutil::findByPattern $dir -glob} msg
    set msg
} {wrong#args for "::fileutil::findByPattern", should be "::fileutil::findByPattern basedir ?-regexp|-glob? ?--? patterns"}

test find-2.2 {find by pattern} {
    lsort [::fileutil::findByPattern [file join $dir find1] -glob {fil*}]
} [list [file join $dir find1 file1] [file join $dir find1 find2 file2]]

test find-2.3 {find by pattern} {
    lsort [::fileutil::findByPattern [file join $dir find1] -regexp {.*1$}]
} [list [file join $dir find1 file1]]


catch {removeDirectory grepTest} ; # start with a clean structure!

# Build a sample tree to search
makeDirectory grepTest
makeFile "zoop" [file join $dir grepTest file1]
makeFile "zoo\nbart"  [file join $dir grepTest file2]

test grep-1.1 {normal grep} {
    lsort [fileutil::grep "zoo" [glob [file join $dir grepTest *]]]
} [list "[file join $dir grepTest file1]:1:zoop" \
	"[file join $dir grepTest file2]:1:zoo"]
test grep-1.2 {more restrictive grep} {
    lsort [fileutil::grep "zoo." [glob [file join $dir grepTest *]]]
} [list "[file join $dir grepTest file1]:1:zoop"]
test grep-1.3 {more restrictive grep} {
    lsort [fileutil::grep "bar" [glob [file join $dir grepTest *]]]
} [list "[file join $dir grepTest file2]:2:bart"]

makeDirectory catTest
makeFile "foo\nbar\nbaz\n" [file join $dir catTest file1]
test cat-1.1 {cat} {
    fileutil::cat [file join $dir catTest file1]
} "foo\nbar\nbaz\n"


test foreachline-1.0 {foreachLine} {
    set res ""
    ::fileutil::foreachLine line [file join $dir catTest file1] {
	append res /$line
    }
    set res
} {/foo/bar/baz}



catch {removeDirectory touchTest} ; # start with a clean structure!
makeDirectory touchTest
makeFile "blah" [file join $dir touchTest file1]

test touch-1.1 {create file} tcl8.3plus {
    set f [file join $dir touchTest here]
    fileutil::touch $f
    # reap this file on cleanup
    lappend ::tcltest::filesmade $f
    file exists $f
} 1

test touch-1.2 {'-c' prevents file creation} tcl8.3plus {
    set f [file join $dir touchTest nothere]
    fileutil::touch -c $f
    file exists $f
} 0

test touch-1.3 {'-c' has no effect on existing files} tcl8.3plus {
    set f [file join $dir touchTest file1]
    fileutil::touch -c $f
    file exists $f
} 1

test touch-1.4 {test relative times} tcl8.3plus {
    set f [file join $dir touchTest file1]
    fileutil::touch $f
    set a1 [file atime $f]
    set m1 [file mtime $f]
    after 1001
    fileutil::touch $f
    set a2 [file atime $f]
    set m2 [file mtime $f]
    list [expr {$a1 == $m1}] [expr {$a2 == $m2}] [expr {$a1 < $a2}] [expr {$m1 < $m2}]
} [list 1 1 1 1]

test touch-1.5 {test relative times using -a} tcl8.3plus {
    set f [file join $dir touchTest file1]
    fileutil::touch $f
    set a1 [file atime $f]
    set m1 [file mtime $f]
    after 1001
    fileutil::touch -a $f
    set a2 [file atime $f]
    set m2 [file mtime $f]
    list [expr {$a1 == $m1}] [expr {$a2 == $m2}] [expr {$a1 < $a2}] [expr {$m1 < $m2}]
} [list 1 0 1 0]

test touch-1.6 {test relative times using -m} tcl8.3plus {
    set f [file join $dir touchTest file1]
    fileutil::touch $f
    set a1 [file atime $f]
    set m1 [file mtime $f]
    after 1001
    fileutil::touch -m $f
    set a2 [file atime $f]
    set m2 [file mtime $f]
    list [expr {$a1 == $m1}] [expr {$a2 == $m2}] [expr {$a1 < $a2}] [expr {$m1 < $m2}]
} [list 1 0 0 1]

test touch-1.7 {test relative times using -a and -m} tcl8.3plus {
    set f [file join $dir touchTest file1]
    fileutil::touch $f
    set a1 [file atime $f]
    set m1 [file mtime $f]
    after 1001
    fileutil::touch -a -m $f
    set a2 [file atime $f]
    set m2 [file mtime $f]
    list [expr {$a1 == $m1}] [expr {$a2 == $m2}] [expr {$a1 < $a2}] [expr {$m1 < $m2}]
} [list 1 1 1 1]

test touch-1.8 {test -t} tcl8.3plus {
    set f [file join $dir touchTest file1]
    fileutil::touch $f
    after 1001
    fileutil::touch -t 42 $f
    set a1 [file atime $f]
    set m1 [file mtime $f]
    list [expr {$a1 == 42}] [expr {$m1 == 42}]
} [list 1 1]

test touch-1.9 {test -t with -a} tcl8.3plus {
    set f [file join $dir touchTest file1]
    fileutil::touch $f
    after 1001
    fileutil::touch -t 42 -a $f
    set a1 [file atime $f]
    set m1 [file mtime $f]
    list [expr {$a1 == 42}] [expr {$m1 == 42}]
} [list 1 0]

test touch-1.10 {test -t with -m} tcl8.3plus {
    set f [file join $dir touchTest file1]
    fileutil::touch $f
    after 1001
    fileutil::touch -t 42 -m $f
    set a1 [file atime $f]
    set m1 [file mtime $f]
    list [expr {$a1 == 42}] [expr {$m1 == 42}]
} [list 0 1]

test touch-1.11 {test -t with -a and -m} tcl8.3plus {
    set f [file join $dir touchTest file1]
    fileutil::touch $f
    after 1001
    fileutil::touch -t 42 -a -m $f
    set a1 [file atime $f]
    set m1 [file mtime $f]
    list [expr {$a1 == 42}] [expr {$m1 == 42}]
} [list 1 1]

test touch-1.12 {test -r} tcl8.3plus {
    set r [info script]
    set f [file join $dir touchTest file1]
    fileutil::touch $f
    after 1001
    fileutil::touch -r $r $f
    set a1 [file atime $f]
    set m1 [file mtime $f]
    list [expr {$a1 == [file atime $r]}] [expr {$m1 == [file mtime $r]}]
} [list 1 1]

test touch-1.13 {test -r with -a} tcl8.3plus {
    set r [info script]
    set f [file join $dir touchTest file1]
    fileutil::touch $f
    after 1001
    fileutil::touch -r $r -a $f
    set a1 [file atime $f]
    set m1 [file mtime $f]
    list [expr {$a1 == [file atime $r]}] [expr {$m1 == [file mtime $r]}]
} [list 1 0]

test touch-1.14 {test -r with -m} tcl8.3plus {
    set r [info script]
    set f [file join $dir touchTest file1]
    fileutil::touch $f
    after 1001
    fileutil::touch -r $r -m $f
    set a1 [file atime $f]
    set m1 [file mtime $f]
    list [expr {$a1 == [file atime $r]}] [expr {$m1 == [file mtime $r]}]
} [list 0 1]

test touch-1.15 {test -r with -a and -m} tcl8.3plus {
    set r [info script]
    set f [file join $dir touchTest file1]
    fileutil::touch $f
    after 1001
    fileutil::touch -r $r -m -a $f
    set a1 [file atime $f]
    set m1 [file mtime $f]
    list [expr {$a1 == [file atime $r]}] [expr {$m1 == [file mtime $r]}]
} [list 1 1]


catch {removeDirectory fileTypeTest} ; # start with a clean structure!
makeDirectory fileTypeTest
# Can't use for tcl < 8.3
#fileutil::touch [file join $dir fileTypeTest emptyFile]
set _f [open [file join $dir fileTypeTest emptyFile] a] ; close $_f

makeFile "\u0000" [file join $dir fileTypeTest binaryFile]

set elfData "\x7F"
append elfData "ELF"
append elfData "\x01\x01\x01\x00\x00"
makeFile $elfData [file join $dir fileTypeTest elfFile]

set bzipData "BZh91AY&SY"
append bzipData "\x01\x01\x01\x00\x00"
makeFile $bzipData [file join $dir fileTypeTest bzipFile]

set gzipData "\x1f\x8b"
append gzipData "\x01\x01\x01\x00\x00"
makeFile $gzipData [set f [file join $dir fileTypeTest gzipFile]]
set fh [open $f w] ; fconfigure $fh -encoding binary ; puts -nonewline $fh $gzipData ; close $fh

set jpgData "\xFF\xD8\xFF\xE0\x00\x10JFIF"
append jpgData "\x00\x01\x02\x01\x01\x2c"
makeFile $jpgData [file join $dir fileTypeTest jpegFile]

set gifData "GIF89a\x2b\x00\x40\x00\xf7\xff\x00"
makeFile $gifData [file join $dir fileTypeTest gifFile]

set pngData "\x89PNG"
append pngData "\x00\x01\x02\x01\x01\x2c"
makeFile $pngData [set f [file join $dir fileTypeTest pngFile]]
set fh [open $f w] ; fconfigure $fh -encoding binary ; puts -nonewline $fh $pngData ; close $fh

set tiffData "MM\x00\*"
append tiffData "\x00\x01\x02\x01\x01\x2c"
makeFile $tiffData [file join $dir fileTypeTest tiffFile]

set psData "%!PS-"
append psData "ADOBO-123 EPSF-1.4"
makeFile $psData [file join $dir fileTypeTest psFile]

set pdfData "%PDF-"
append pdfData "1.2 \x00\x01\x02\x01\x01\x2c"
makeFile $pdfData [file join $dir fileTypeTest pdfFile]

set epsData $psData
makeFile $psData [file join $dir fileTypeTest epsFile]

set igwdData "IGWD"
append igwdData "\x00\x01\x02\x01\x01\x2c"
makeFile $igwdData [file join $dir fileTypeTest igwdFile]

makeFile "simple text" [file join $dir fileTypeTest textFile]
makeFile "#!/bin/tclsh" [file join $dir fileTypeTest scriptFile]
makeFile "<html></html>" [file join $dir fileTypeTest htmlFile]

set xmlData {<?xml version="1.0" encoding="ISO-8859-1"?>

<foobar></foobar>
}

set xmlDataWithDTD {<?xml version="1.0" encoding="ISO-8859-1"?>

<!DOCTYPE foobar SYSTEM bogus.dtd>
<foobar></foobar>
}

makeFile $xmlData [file join $dir fileTypeTest xmlFile]
makeFile $xmlDataWithDTD [file join $dir fileTypeTest xmlWithDTDFile]

set pgpData {-----BEGIN PGP MESSAGE-----
Version: PGP 6.5.8

abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
}

makeFile $pgpData [file join $dir fileTypeTest pgpFile]

test fileType-1.1 {test file non-existance} {
    set f [file join $dir fileTypeTest bogus]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 1 "file not found: '[file join $dir fileTypeTest bogus]'"]
test fileType-1.2 {test file directory} {
    set f [file join $dir fileTypeTest]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list directory]]
test fileType-1.3 {test file empty} {
    set f [file join $dir fileTypeTest emptyFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list empty]]
test fileType-1.4 {test simple binary} {
    set f [file join $dir fileTypeTest binaryFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list binary]]
test fileType-1.5 {test elf executable} {
    set f [file join $dir fileTypeTest elfFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list binary executable elf]]
test fileType-1.6 {test simple text} {
    set f [file join $dir fileTypeTest textFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list text]]
test fileType-1.7 {test script file} {
    set f [file join $dir fileTypeTest scriptFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list text script /bin/tclsh]]
test fileType-1.8 {test html text} {
    set f [file join $dir fileTypeTest htmlFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list text html]]
test fileType-1.9 {test xml text} {
    set f [file join $dir fileTypeTest xmlFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list text xml]]
test fileType-1.10 {test xml with dtd text} {
    set f [file join $dir fileTypeTest xmlWithDTDFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list text xml foobar]]
test fileType-1.11 {test PGP message} {
    set f [file join $dir fileTypeTest pgpFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list text message pgp]]
test fileType-1.12 {test binary graphic jpeg} {
    set f [file join $dir fileTypeTest jpegFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list binary graphic jpeg]]
test fileType-1.13 {test binary graphic gif} {
    set f [file join $dir fileTypeTest gifFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list binary graphic gif]]
test fileType-1.14 {test binary graphic png} {
    set f [file join $dir fileTypeTest pngFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list binary graphic png]]
test fileType-1.15 {test binary graphic tiff} {
    set f [file join $dir fileTypeTest tiffFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list binary graphic tiff]]
test fileType-1.16 {test binary pdf} {
    set f [file join $dir fileTypeTest pdfFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list binary pdf]]
test fileType-1.17 {test text ps} {
    set f [file join $dir fileTypeTest psFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list text ps eps]]
test fileType-1.18 {test text eps} {
    set f [file join $dir fileTypeTest epsFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list text ps eps]]
test fileType-1.19 {test binary gravity_wave_data_frame} {
    set f [file join $dir fileTypeTest igwdFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list binary gravity_wave_data_frame]]
test fileType-1.20 {test binary compressed bzip} {
    set f [file join $dir fileTypeTest bzipFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list binary compressed bzip]]
test fileType-1.21 {test binary compressed gzip} {
    set f [file join $dir fileTypeTest gzipFile]
    set res [catch {fileutil::fileType $f} msg]
    list $res $msg
} [list 0 [list binary compressed gzip]]



# stripPwd/N -----------------------------------------------------
# dir = $::tcltest::temporaryDirectory = current working directory

test stripPwd-1.0 {unrelated path} {
    fileutil::stripPwd find1
} find1

test stripPwd-1.1 {pwd-relative path} {
    fileutil::stripPwd [file join [pwd] $dir find1]
} find1

test stripPwd-1.2 {pwd-relative path} {
    fileutil::stripPwd [file join [pwd] $dir find1 find2]
} [file join find1 find2]

test stripPwd-1.3 {pwd itself} {
    fileutil::stripPwd [pwd]
} .


test stripN-1.0 {remove nothing} {
    fileutil::stripN find1 0
} find1

test stripN-1.1 {remove all} {
    fileutil::stripN find1 1
} {}

test stripN-1.2 {remove more than existing} {
    fileutil::stripN find1 2
} {}

test stripN-2.0 {remove nothing} {
    fileutil::stripN [file join find1 find2] 0
} [file join find1 find2]

test stripN-2.1 {remove part} {
    fileutil::stripN [file join find1 find2] 1
} find2

test stripN-2.2 {remove all} {
    fileutil::stripN [file join find1 find2] 2
} {}

test stripN-2.3 {remove more than existing} {
    fileutil::stripN [file join find1 find2] 3
} {}


# ----------------------------------------------------------------

::tcltest::cleanupTests
return