Tcl/Tk Benchmark Suite And Tools
Artifact Content
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2018 Conference, Houston/TX, US, Oct 15-19
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Aug 20.

Artifact 4e12afabe61c95debd67f5a8c821476d97791001:


# 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}
}