# # bsearch.test # # Tests for the bsearch command. #--------------------------------------------------------------------------- # Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans. # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, provided # that the above copyright notice appear in all copies. Karl Lehenbauer and # Mark Diekhans make no representations about the suitability of this # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ # $Id: bsearch.test,v 1.1 2001/10/24 23:31:49 hobbs Exp $ #------------------------------------------------------------------------------ # if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import ::tcltest::* } if {[cequal [info procs Test] {}]} { source [file join [file dirname [info script]] testlib.tcl] } # Create a test file TestRemove BSEARCH.TMP set testFH [open BSEARCH.TMP w] for {set cnt 0} {$cnt < 100} {incr cnt} { puts $testFH [GenRec $cnt] } close $testFH # Test bsearch proc BsearchTestCmp {key line} { set linekey [lindex $line 2] return [string compare $key $linekey] } set testFH [open BSEARCH.TMP r] set toggle 0 for {set cnt 0} {$cnt < 100} {incr cnt} { set key1 [format "Key:%04d" $cnt] set key2 [format "KeyX:%04d" $cnt] if {($cnt % 6) == 0} { set expect [GenRec $cnt] if {$toggle} { test bsearch-1.1.$cnt {bsearch tests} { bsearch $testFH $key1 } $expect test bsearch-1.2.$cnt {bsearch tests} { bsearch $testFH $key2 {} BsearchTestCmp } $expect } else { set rec {} test bsearch-1.3.$cnt {bsearch tests} { list [bsearch $testFH $key1 rec] $rec } [list 1 $expect] set rec {} test bsearch-1.4.$cnt {bsearch tests} { list [bsearch $testFH $key2 rec BsearchTestCmp] $rec } [list 1 $expect] } set toggle [expr !$toggle] } } close $testFH TestRemove BSEARCH.TMP # cleanup ::tcltest::cleanupTests return