Tcl2002 programming contest: problem 1 test harness

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?