The following code was used by the judges of The Great Canadian Tcl/Tk Programming Contest to test submitted answers for Tcl2002 programming contest: problem 1.
package require Tk
::safe::interpCreate slave
set types { { {Tcl Scripts} .tcl } { {All Files} * }}
set fname [tk_getOpenFile \
-defaultextension .tcl \
-filetypes $types]
if { [string equal {} $fname] } exit
set f [open $fname r]
set ftext [read $f]
close $f
slave eval $ftext
set results [slave eval {
proc permute { list } {
set retval [list]
if { [llength $list] == 0 } { return [list [list]] }
for { set i 0 } { $i < [llength $list] } { incr i } {
set e [lindex $list $i]
foreach p [permute [lreplace $list $i $i]] {
lappend p $e
lappend retval $p
}
}
return $retval
}
set f 0
set s 0
set cases {}
foreach p [permute { {a a} {b b} {c c} {d d} {e e} }] {
lappend cases $p
set have($p) {}
set r [sort5 $p]
if { [string compare {{a a} {b b} {c c} {d d} {e e}} $r] } {
incr f
} else {
incr s
}
}
for { set i 0 } { $i < 32 } { incr i } {
set trial {}
set result {}
set list0 {}
set list1 {}
set data [list [expr int(1000000*rand())] [expr int(1000000*rand())] [expr int(1000000*rand())] [expr int(1000000*rand())] [expr int(1000000*rand())]]
set j 1
foreach value $data {
set key [expr { ( $i & $j ) != 0 }]
set pair [list $key $value]
lappend trial $pair
lappend list$key $pair
incr j $j
}
set result $list0
foreach x $list1 {
lappend result $x
}
lappend cases $trial
set r [sort5 $trial]
if { [string compare $r $result] } {
incr f
} else {
incr s
}
}
return [list $f $s [llength $cases] [time {
foreach c $cases {
set r [sort5 $c]
}
} 1000]]
}]
foreach {fail success cases time} $results {}
grid [label .l0 -text "File: $fname"]
grid [label .l1 -text "Failures: $fail / $cases"]
grid [label .l2 -text "Successes: $success / $cases"]
grid [label .l3 -text "Time: $time"]Tcl2002 programming contest: problem 1
The Great Canadian Tcl/Tk Programming Contest, eh?