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"] ---- [Tcl 2002 programming contest: problem 1] [The Great Canadian Tcl/Tk Programming Contest], eh?