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