# -*- tcl -*-
# Support code for the tests of the find command (and incremental find).
#
# Copyright (c) 2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
# All rights reserved.
#
# RCS: @(#) $Id: find.setup,v 1.3 2012/08/29 20:42:19 andreas_kupries Exp $

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

# Build a sample tree to search
# Structure
#
#	dir
#	+--{find 1}
#          +--{find 2}
#          |  +--{file* 2}  (This file is unix only)
#          +--{file 1}
#
#       dir2
#       +-- dotfiles
#           +-- .foo
#           +-- foo

proc f_setup {} {
    makeDirectory            {find 1}
    makeDirectory [file join {find 1} {find 2}]
    makeFile ""   [file join {find 1} {file [1]}]

    if {[string equal $::tcl_platform(platform) windows]} return

    makeFile "test" [file join {find 1} {find 2} {file* 2}]
    return
}

proc f_cleanup {} {
    # Remove sym link first. Not doing this causes the file delete for
    # the directory to fail (on Windows, Unix would have been fine).
    catch {removeFile [file join {find 1} {find 2} {file 3}]}
    removeDirectory {find 1}
    return
}

# Extend the previous sample tree with circular symbolic
# links. Unix-only.
#
#	dir
#	+--{find 1}
#          +--{find 2}          <----------+
#          |  +--{file* 2}		   |
#          |  +--{file 3} --> ../{find 2} -+
#          +--{file [1]}

proc f_setupcircle {} {
    f_setup

    set fthree [file join {find 1} {find 2} {file 3}]
    set path   [makeFile "" $fthree]
    removeFile $fthree

    # Added use of 'file link' for Tcl 8.4+, on windows, to have a
    # modicum of x-platform testing regarding the handling of symbolic
    # links.

    set target [file join .. {find 2}]

    if {
	[string equal $::tcl_platform(platform) windows] &&
	[package vsatisfies [package require Tcl] 8.4]
    } {
	if {[string equal $::tcl_platform(platform) windows]} {
	    # Windows doesn't like the .. in the target, it needs an
	    # absolute path.

	    # NOTE/BUG Even so the 'fullnormalize' in the traverser
	    # returns bogus results for the link, whereas use of file
	    # normalize and fullnormalize in a simple tclsh,
	    # i.e. outside of the testing is ok.

	    # It seems if the 'file join' in fullnormalize is replaced
	    # by a plain / then the results are ok again => The
	    # handling of paths on Windows by the Tcl core is bogus in
	    # some way which breaks the core 'normalize'.

	    set here [pwd]
	    cd [file dirname [tempPath $fthree]]
	    file link [file tail $fthree] [file normalize $target]
	    cd $here
	} else {
	    file link [tempPath $fthree] $target
	}
	return
    }

    exec ln -s $target [tempPath $fthree]
    return
}

# Change previous sample tree so that its circular symbolic
# link points to the base directory. Unix-only.
#
#	dir                    
#	+--{find 1}             <----------+
#          +--{find 2}                     |
#          |  +--{file* 2}		   |
#          |  +--{file 3} --> ../../find 1 +
#          +--{file [1]}

proc f_setupcircle2 {} {
    f_setup

    set fthree [file join {find 1} {find 2} {file 3}]
    set path   [makeFile "" $fthree]
    removeFile $fthree

    # Added use of 'file link' for Tcl 8.4+, on windows, to have a
    # modicum of x-platform testing regarding the handling of symbolic
    # links.

    set target [file join .. .. {find 1}]

    if {
	[string equal $::tcl_platform(platform) windows] &&
	[package vsatisfies [package require Tcl] 8.4]
    } {
	if {[string equal $::tcl_platform(platform) windows]} {
	    # Windows doesn't like the .. in the target, it needs an
	    # absolute path.

	    # NOTE/BUG Even so the 'fullnormalize' in the traverser
	    # returns bogus results for the link, whereas use of file
	    # normalize and fullnormalize in a simple tclsh,
	    # i.e. outside of the testing is ok.

	    # It seems if the 'file join' in fullnormalize is replaced
	    # by a plain / then the results are ok again => The
	    # handling of paths on Windows by the Tcl core is bogus in
	    # some way which breaks the core 'normalize'.

	    set here [pwd]
	    cd [file dirname [tempPath $fthree]]
	    file link [file tail $fthree] [file normalize $target]
	    cd $here
	} else {
	    file link [tempPath $fthree] $target
	}
	return
    }

    exec ln -s $target [tempPath $fthree]
    return
}

# Extend the regular sample tree with a broken symbolic link. Unix-only.
#
#	dir
#	+--{find 1}
#          +--{find 2}
#          |  +--{file* 2}
#          |  +--{file 3} --> BROKEN
#          +--{file [1]}


proc f_setupbroken {} {
    f_setup

    set fthree [file join {find 1} {find 2} {file 3}]
    set path   [makeFile "" $fthree]
    removeFile $fthree

    # Added use of 'file link' for Tcl 8.4+, on windows, to have a
    # modicum of x-platform testing regarding the handling of symbolic
    # links.

    set target BROKEN

    if {
	[string equal $::tcl_platform(platform) windows] &&
	[package vsatisfies [package require Tcl] 8.4]
    } {
	makeFile {} [file dirname $fthree]/BROKEN

	if {[string equal $::tcl_platform(platform) windows]} {
	    # Windows doesn't like the .. in the target, it needs an
	    # absolute path.

	    # NOTE/BUG Even so the 'fullnormalize' in the traverser
	    # returns bogus results for the link, whereas use of file
	    # normalize and fullnormalize in a simple tclsh,
	    # i.e. outside of the testing is ok.

	    # It seems if the 'file join' in fullnormalize is replaced
	    # by a plain / then the results are ok again => The
	    # handling of paths on Windows by the Tcl core is bogus in
	    # some way which breaks the core 'normalize'.

	    set here [pwd]
	    cd [file dirname [tempPath $fthree]]
	    file link [file tail $fthree] [file normalize $target]
	    cd $here
	} else {
	    file link [tempPath $fthree] $target
	}
	removeFile [file dirname $fthree]/BROKEN
	return
    }

    exec ln -s $target [tempPath $fthree]
    return
}

proc f_setupdot {} {
    makeDirectory          dotfiles
    makeFile "" [file join dotfiles foo]
    makeFile "" [file join dotfiles .foo]
    return
}

proc f_cleanupdot {} {
    removeDirectory dotfiles
    return
}

proc f_setupnostat {} {
    # Finding inaccessible directories. Unix only, as I do not know
    # how to make the directory inaccessible on Windows, and then
    # reaccessible again.

    makeDirectory find3
    makeDirectory find3/find4
    makeFile {}   find3/find4/file5

    if {[string equal $::tcl_platform(platform) windows]} return
    exec chmod -x [tempPath find3/find4]
    return
}

proc f_cleanupnostat {} {
    if {![string equal $::tcl_platform(platform) windows]} {
	exec chmod +x [tempPath find3/find4]
    }
    removeDirectory find3
    return
}

proc f_setupnoread {} {
    # Finding unreadable directories.

    makeDirectory find3
    makeDirectory find3/find4
    makeFile {}   find3/find4/file5

    if {[string equal $::tcl_platform(platform) windows]} {
	file attributes -readonly 1 [tempPath find3/find4]
    } else {
	exec chmod -r [tempPath find3/find4]
    }
    return
}

proc f_cleanupnoread {} {
    if {[string equal $::tcl_platform(platform) windows]} {
	file attributes -readonly 0 [tempPath find3/find4]
    } else {
	exec chmod +r [tempPath find3/find4]
    }
    removeDirectory find3
    return
}

proc f_cleanall {} {
    rename f_setup          {}
    rename f_cleanup        {}
    rename f_setupcircle    {}
    rename f_setupdot       {}
    rename f_cleanupdot     {}
    rename f_setupnostat    {}
    rename f_cleanupnostat  {}
    rename f_setupnoread    {}
    rename f_cleanupnoread  {}
    rename f_cleanall       {}
    rename fileIsBiggerThan {}
    catch {unset ::res}
    return
}

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

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

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