Tcl Source Code

Artifact 7fcd72b94527b4b881e66d7b67b5af1d3be5c9d1:

Attachment "testfs.tcl" to ticket [682500ffff] added by vincentdarley 2003-02-08 02:06:16.

---

catch {console show}
update

proc recurseAndExamine {dir recurse} {
    set count 0 
    foreach f [glob -directory $dir -nocomplain *] {
	#file exists $f
	#file stat $f arr
	#file mtime $f
	incr count
	if {$recurse} {
	   if {[file isdirectory $f]} {
	       incr count [recurseAndExamine $f $recurse]
	   }
       }
    }
    return $count
}

proc recurseAndExamine2 {dir recurse} {
    set count 0 
    foreach f [glob -directory $dir -nocomplain *] {
	file exists $f
	#file stat $f arr
	#file mtime $f
	incr count
	if {$recurse} {
	   if {[file isdirectory $f]} {
	       incr count [recurseAndExamine2 $f $recurse]
	   }
       }
    }
    return $count
}

proc recurseAndExamine3 {dir recurse} {
    set count 0 
    foreach f [glob -directory $dir -nocomplain *] {
	file exists $f
	file stat $f arr
	file mtime $f
	incr count
	if {$recurse} {
	   if {[file isdirectory $f]} {
	       incr count [recurseAndExamine3 $f $recurse]
	   }
       }
    }
    return $count
}

proc dotheyExist {l} {
    foreach f $l {
	file exists $f
    }
}

proc dotheyExist2 {l} {
    foreach f $l {
	if {[file exists $f]} {
	    file stat $f arr
	}
    }
}

set dir C:/Tcl-source/tcl8.4

# ensure compiled
recurseAndExamine $dir 0
recurseAndExamine2 $dir 0
recurseAndExamine3 $dir 0
dotheyExist {}
dotheyExist2 {}

puts "Tcl [info patchlevel], debug is [info exists tcl_platform(debug)]\n"

set items [glob -directory $dir/doc -nocomplain *]
puts "Test 1 (file exists) time: [time {dotheyExist $items} 50]"
puts "Test 1 (repeat) time: [time {dotheyExist $items} 50]"

set items [glob -directory $dir/doc -nocomplain *]
puts "Test 1a (file exists, stat) time: [time {dotheyExist2 $items} 50]"
puts "Test 1a (repeat) time: [time {dotheyExist2 $items} 50]"

puts "Test 2a (glob no recurse) time:\
  [time {set count [recurseAndExamine $dir 0]} 30]"
puts "count is $count"
puts "Test 2b (glob and recurse) time:\
  [time {set count [recurseAndExamine $dir 1]} 3]"
puts "count is $count"

puts "Test 3a (glob no recurse) time:\
  [time {set count [recurseAndExamine2 $dir 0]} 30]"
puts "count is $count"
puts "Test 3b (glob and recurse) time:\
  [time {set count [recurseAndExamine2 $dir 1]} 3]"
puts "count is $count"

puts "Test 4a (glob no recurse) time:\
  [time {set count [recurseAndExamine3 $dir 0]} 30]"
puts "count is $count"
puts "Test 4b (glob and recurse) time:\
  [time {set count [recurseAndExamine3 $dir 1]} 3]"
puts "count is $count"

# Tcl 8.3 is 357333 microseconds per iteration
# Tcl 8.4 is 1201997 microseconds per iteration
# A factor of 3.3!
# Tcl 8.4 debug 1352399 microseconds per iteration