# -*- tcl -*- # Support code for the tests of the find command (and incremental find). # # Copyright (c) 2007 by Andreas Kupries # All rights reserved. # # RCS: @(#) $Id: find.setup,v 1.2 2007/10/24 19:28:36 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 } # 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. Uunix 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_cleanall {} { rename f_setup {} rename f_cleanup {} rename f_setupcircle {} rename f_setupdot {} rename f_cleanupdot {} rename f_setupnostat {} rename f_cleanupnostat {} rename f_cleanall {} rename fileIsBiggerThan {} catch {unset ::res} return } # ------------------------------------------------------------------------- proc fileIsBiggerThan {s f} { expr { ![file isdirectory $f] && ([file size $f] > $s) } } # -------------------------------------------------------------------------