# file.bench -- # # setup routines proc contents {file str} { set fp [open $file w] puts $fp $str close $fp } proc setup {dir size} { for {set i 0} {$i < $size} {incr i} { file mkdir [file join $dir _benchdir.$i] contents [file join $dir _benchdir.$i _benchfile.$i] "delete me" contents [file join $dir _benchfile.$i] "delete me" } } set file [bench_tmpfile] set dir $file.DIR file mkdir $dir setup $dir 30 # test procs if {$tcl_version >= 8.3} { proc listfiles {dir ptn} { glob -nocomplain -directory $dir $ptn } } else { proc listfiles {dir ptn} { glob -nocomplain $dir/$ptn } } proc checkone {dir cmd} { foreach f [listfiles $dir *] { file $cmd $f } } proc checkstat {dir} { foreach f [listfiles $dir *] { file stat $f var } } set FCMDS [list \ atime dirname executable exists extension isdirectory \ isfile mtime owned readable rootname size tail writable \ ] if {[info tclversion] >= 8.0} { lappend FCMDS attributes } proc checkall {dir} { global FCMDS foreach f [listfiles $dir *] { foreach fcmd $FCMDS { file $fcmd $f } file stat $f var } } proc recurseAndExamine {dir recurse} { foreach f [listfiles $dir *] { file stat $f arr if {$recurse && [file isdirectory $f]} { recurseAndExamine $f $recurse } } } proc recurseAndExamine4 {dir recurse} { set orig [pwd] cd $dir foreach f [glob -nocomplain *] { file stat $f arr if {$recurse && [file isdirectory $f]} { recurseAndExamine4 $f $recurse } } cd $orig } set fileBogusAsObj $file.BOGUS bench -desc "FILE exists ~" -iter 100 \ -body {file exists ~} bench -desc "FILE exists tmpfile (obj)" -iter 100 \ -body {file exists $file} bench -desc "FILE exists! tmpfile (str)" -iter 100 \ -body {file exists $file.BOGIE} bench -desc "FILE exists! tmpfile (obj)" -iter 100 \ -body {file exists $fileBogusAsObj} set num [llength [listfiles $dir *]] bench -desc "FILE glob tmpdir ($num entries)" -iter 100 \ -body {listfiles $dir *} foreach fcmd $FCMDS { bench -desc "FILE glob / $fcmd" -iter 100 \ -body {checkone $dir $fcmd} } bench -desc "FILE glob / all subcommands" -iter 100 \ -body {checkall $dir} bench -desc "FILE recurse / -dir" -iter 100 \ -body {recurseAndExamine $dir 1} bench -desc "FILE recurse / cd" -iter 100 \ -body {recurseAndExamine4 $dir 1} contents $file "exit" bench -desc "FILE exec interp" -iter 30 \ -body {exec $BENCH(INTERP) $file} contents $file "catch {package require bogus-name}; package names" bench -desc "FILE exec interp: pkg require" -iter 30 \ -body {exec $BENCH(INTERP) $file} bench_rm $file if {[catch {file delete -force $dir}] && $tcl_platform(platform) == "unix"} { catch {exec rm -rf $dir} }