OLD | NEW |
(Empty) | |
| 1 # 2008 May 23 |
| 2 # |
| 3 # The author disclaims copyright to this source code. In place of |
| 4 # a legal notice, here is a blessing: |
| 5 # |
| 6 # May you do good and not evil. |
| 7 # May you find forgiveness for yourself and forgive others. |
| 8 # May you share freely, never taking more than you give. |
| 9 # |
| 10 #*********************************************************************** |
| 11 # |
| 12 # Randomized test cases for the rtree extension. |
| 13 # |
| 14 |
| 15 if {![info exists testdir]} { |
| 16 set testdir [file join [file dirname [info script]] .. .. test] |
| 17 } |
| 18 source $testdir/tester.tcl |
| 19 |
| 20 ifcapable !rtree { |
| 21 finish_test |
| 22 return |
| 23 } |
| 24 |
| 25 set ::NROW 2500 |
| 26 if {[info exists G(isquick)] && $G(isquick)} { |
| 27 set ::NROW 250 |
| 28 } |
| 29 |
| 30 # Return a floating point number between -X and X. |
| 31 # |
| 32 proc rand {X} { |
| 33 return [expr {int((rand()-0.5)*1024.0*$X)/512.0}] |
| 34 } |
| 35 |
| 36 # Return a positive floating point number less than or equal to X |
| 37 # |
| 38 proc randincr {X} { |
| 39 while 1 { |
| 40 set r [expr {int(rand()*$X*32.0)/32.0}] |
| 41 if {$r>0.0} {return $r} |
| 42 } |
| 43 } |
| 44 |
| 45 # Scramble the $inlist into a random order. |
| 46 # |
| 47 proc scramble {inlist} { |
| 48 set y {} |
| 49 foreach x $inlist { |
| 50 lappend y [list [expr {rand()}] $x] |
| 51 } |
| 52 set y [lsort $y] |
| 53 set outlist {} |
| 54 foreach x $y { |
| 55 lappend outlist [lindex $x 1] |
| 56 } |
| 57 return $outlist |
| 58 } |
| 59 |
| 60 # Always use the same random seed so that the sequence of tests |
| 61 # is repeatable. |
| 62 # |
| 63 expr {srand(1234)} |
| 64 |
| 65 # Run these tests for all number of dimensions between 1 and 5. |
| 66 # |
| 67 for {set nDim 1} {$nDim<=5} {incr nDim} { |
| 68 |
| 69 # Construct an rtree virtual table and an ordinary btree table |
| 70 # to mirror it. The ordinary table should be much slower (since |
| 71 # it has to do a full table scan) but should give the exact same |
| 72 # answers. |
| 73 # |
| 74 do_test rtree4-$nDim.1 { |
| 75 set clist {} |
| 76 set cklist {} |
| 77 for {set i 0} {$i<$nDim} {incr i} { |
| 78 lappend clist mn$i mx$i |
| 79 lappend cklist "mn$i<mx$i" |
| 80 } |
| 81 db eval "DROP TABLE IF EXISTS rx" |
| 82 db eval "DROP TABLE IF EXISTS bx" |
| 83 db eval "CREATE VIRTUAL TABLE rx USING rtree(id, [join $clist ,])" |
| 84 db eval "CREATE TABLE bx(id INTEGER PRIMARY KEY,\ |
| 85 [join $clist ,], CHECK( [join $cklist { AND }] ))" |
| 86 } {} |
| 87 |
| 88 # Do many insertions of small objects. Do both overlapping and |
| 89 # contained-within queries after each insert to verify that all |
| 90 # is well. |
| 91 # |
| 92 unset -nocomplain where |
| 93 for {set i 1} {$i<$::NROW} {incr i} { |
| 94 # Do a random insert |
| 95 # |
| 96 do_test rtree4-$nDim.2.$i.1 { |
| 97 set vlist {} |
| 98 for {set j 0} {$j<$nDim} {incr j} { |
| 99 set mn [rand 10000] |
| 100 set mx [expr {$mn+[randincr 50]}] |
| 101 lappend vlist $mn $mx |
| 102 } |
| 103 db eval "INSERT INTO rx VALUES(NULL, [join $vlist ,])" |
| 104 db eval "INSERT INTO bx VALUES(NULL, [join $vlist ,])" |
| 105 } {} |
| 106 |
| 107 # Do a contained-in query on all dimensions |
| 108 # |
| 109 set where {} |
| 110 for {set j 0} {$j<$nDim} {incr j} { |
| 111 set mn [rand 10000] |
| 112 set mx [expr {$mn+[randincr 500]}] |
| 113 lappend where mn$j>=$mn mx$j<=$mx |
| 114 } |
| 115 set where "WHERE [join $where { AND }]" |
| 116 do_test rtree4-$nDim.2.$i.2 { |
| 117 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] |
| 118 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] |
| 119 |
| 120 # Do an overlaps query on all dimensions |
| 121 # |
| 122 set where {} |
| 123 for {set j 0} {$j<$nDim} {incr j} { |
| 124 set mn [rand 10000] |
| 125 set mx [expr {$mn+[randincr 500]}] |
| 126 lappend where mx$j>=$mn mn$j<=$mx |
| 127 } |
| 128 set where "WHERE [join $where { AND }]" |
| 129 do_test rtree4-$nDim.2.$i.3 { |
| 130 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] |
| 131 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] |
| 132 |
| 133 # Do a contained-in query with surplus contraints at the beginning. |
| 134 # This should force a full-table scan on the rtree. |
| 135 # |
| 136 set where {} |
| 137 for {set j 0} {$j<$nDim} {incr j} { |
| 138 lappend where mn$j>-10000 mx$j<10000 |
| 139 } |
| 140 for {set j 0} {$j<$nDim} {incr j} { |
| 141 set mn [rand 10000] |
| 142 set mx [expr {$mn+[randincr 500]}] |
| 143 lappend where mn$j>=$mn mx$j<=$mx |
| 144 } |
| 145 set where "WHERE [join $where { AND }]" |
| 146 do_test rtree4-$nDim.2.$i.3 { |
| 147 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] |
| 148 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] |
| 149 |
| 150 # Do an overlaps query with surplus contraints at the beginning. |
| 151 # This should force a full-table scan on the rtree. |
| 152 # |
| 153 set where {} |
| 154 for {set j 0} {$j<$nDim} {incr j} { |
| 155 lappend where mn$j>=-10000 mx$j<=10000 |
| 156 } |
| 157 for {set j 0} {$j<$nDim} {incr j} { |
| 158 set mn [rand 10000] |
| 159 set mx [expr {$mn+[randincr 500]}] |
| 160 lappend where mx$j>$mn mn$j<$mx |
| 161 } |
| 162 set where "WHERE [join $where { AND }]" |
| 163 do_test rtree4-$nDim.2.$i.4 { |
| 164 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] |
| 165 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] |
| 166 |
| 167 # Do a contained-in query with surplus contraints at the end |
| 168 # |
| 169 set where {} |
| 170 for {set j 0} {$j<$nDim} {incr j} { |
| 171 set mn [rand 10000] |
| 172 set mx [expr {$mn+[randincr 500]}] |
| 173 lappend where mn$j>=$mn mx$j<$mx |
| 174 } |
| 175 for {set j [expr {$nDim-1}]} {$j>=0} {incr j -1} { |
| 176 lappend where mn$j>=-10000 mx$j<10000 |
| 177 } |
| 178 set where "WHERE [join $where { AND }]" |
| 179 do_test rtree4-$nDim.2.$i.5 { |
| 180 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] |
| 181 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] |
| 182 |
| 183 # Do an overlaps query with surplus contraints at the end |
| 184 # |
| 185 set where {} |
| 186 for {set j [expr {$nDim-1}]} {$j>=0} {incr j -1} { |
| 187 set mn [rand 10000] |
| 188 set mx [expr {$mn+[randincr 500]}] |
| 189 lappend where mx$j>$mn mn$j<=$mx |
| 190 } |
| 191 for {set j 0} {$j<$nDim} {incr j} { |
| 192 lappend where mx$j>-10000 mn$j<=10000 |
| 193 } |
| 194 set where "WHERE [join $where { AND }]" |
| 195 do_test rtree4-$nDim.2.$i.6 { |
| 196 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] |
| 197 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] |
| 198 |
| 199 # Do a contained-in query with surplus contraints where the |
| 200 # constraints appear in a random order. |
| 201 # |
| 202 set where {} |
| 203 for {set j 0} {$j<$nDim} {incr j} { |
| 204 set mn1 [rand 10000] |
| 205 set mn2 [expr {$mn1+[randincr 100]}] |
| 206 set mx1 [expr {$mn2+[randincr 400]}] |
| 207 set mx2 [expr {$mx1+[randincr 100]}] |
| 208 lappend where mn$j>=$mn1 mn$j>$mn2 mx$j<$mx1 mx$j<=$mx2 |
| 209 } |
| 210 set where "WHERE [join [scramble $where] { AND }]" |
| 211 do_test rtree4-$nDim.2.$i.7 { |
| 212 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] |
| 213 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] |
| 214 |
| 215 # Do an overlaps query with surplus contraints where the |
| 216 # constraints appear in a random order. |
| 217 # |
| 218 set where {} |
| 219 for {set j 0} {$j<$nDim} {incr j} { |
| 220 set mn1 [rand 10000] |
| 221 set mn2 [expr {$mn1+[randincr 100]}] |
| 222 set mx1 [expr {$mn2+[randincr 400]}] |
| 223 set mx2 [expr {$mx1+[randincr 100]}] |
| 224 lappend where mx$j>=$mn1 mx$j>$mn2 mn$j<$mx1 mn$j<=$mx2 |
| 225 } |
| 226 set where "WHERE [join [scramble $where] { AND }]" |
| 227 do_test rtree4-$nDim.2.$i.8 { |
| 228 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] |
| 229 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] |
| 230 } |
| 231 |
| 232 } |
| 233 |
| 234 finish_test |
OLD | NEW |