1# Blocked view deletion tests 2# jcw, 26-3-2002 3 4if [catch {package require Mk4tcl}] { 5 catch {load ./Mk4tcl.so mk4tcl} 6 catch {load ./Mk4tcl_d.dll mk4tcl} 7} 8 9proc fill {n} { 10 $::bv size 0 11 set ::vv {} 12 for {set i 0} {$i < $n} {incr i} { 13 $::bv insert end a $i 14 lappend ::vv $i 15 } 16} 17 18proc remove {from {count 1}} { 19 incr count -1 20 $::bv delete $from [incr count $from] 21 set ::vv [lreplace $::vv $from $count] 22} 23 24proc check {} { 25 set pos 0 26 foreach y $::vv { 27 set x [$::bv get $pos a] 28 if {$x != $y} { error "pos $pos is $x, should be $y" } 29 incr pos 30 } 31} 32 33mk::file open db 34mk::view layout db.v {{_B {a:I}}} 35 36set bv [[mk::view open db.v] view blocked] 37 38for {set j 1} {$j < 6} {incr j} { 39 fill 2000 40 remove 996 $j 41 check 42} 43 44for {set j 988} {$j < 1001} {incr j} { 45 fill 2000 46 remove $j 10 47 check 48} 49 50for {set j 1100} {$j < 1110} {incr j} { 51 fill 3000 52 remove 985 $j 53 check 54} 55 56set total 50000 57fill $total 58 59foreach x {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15} { 60 puts -nonewline stderr "$x " 61 for {set i [expr {$total-1025}]} {$i > 0} {incr i -1000} { 62 remove $i 45 63 remove $i 45 64 incr total -90 65 } 66 check 67} 68 69puts stderr OK 70