Tcl Source Code

Artifact [38f1dc3117]
Login

Artifact 38f1dc3117e9c02d715df8164e21d70a64411c33:

Attachment "test.tcl" to ticket [1973096fff] added by msofer 2008-05-26 22:44:39.
proc myfor {start end next body} {
    set test [list expr $end]
    uplevel 1 $start
    while {[uplevel 1 $test]} {
	uplevel 1 $body
	uplevel 1 $next
    }
}

proc mytime script {
    set times {}
    set foo [list time $script]
    for {set i 0} {$i < 10} {incr i} {
	lappend times [lindex [time {uplevel 1 $foo}] 0]
    }
    lindex [lsort -increasing -integer $times] 0
}

set body {
    set N [lindex $::argv 0]
    if {$N eq {}} {
	set N 200
    }

    set x 0
    myfor {set i 0} {$i < $N} {incr i} {
	for {set j 0} {$j < $i} {incr j} {
	    incr x $j
	}
    }
}

set t [list t0:[mytime {eval $body}]]
lappend t t1:[mytime $body]

proc test0 {} $body

lappend t t2:[mytime test0]

append body "\nset i; set j"
proc test1 {} $body
lappend t t3:[mytime test1]

puts [join $t \n]