| 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 ifcapable !rtree_int_only { | |
| 31 # Return a floating point number between -X and X. | |
| 32 # | |
| 33 proc rand {X} { | |
| 34 return [expr {int((rand()-0.5)*1024.0*$X)/512.0}] | |
| 35 } | |
| 36 | |
| 37 # Return a positive floating point number less than or equal to X | |
| 38 # | |
| 39 proc randincr {X} { | |
| 40 while 1 { | |
| 41 set r [expr {int(rand()*$X*32.0)/32.0}] | |
| 42 if {$r>0.0} {return $r} | |
| 43 } | |
| 44 } | |
| 45 } else { | |
| 46 # For rtree_int_only, return an number between -X and X. | |
| 47 # | |
| 48 proc rand {X} { | |
| 49 return [expr {int((rand()-0.5)*2*$X)}] | |
| 50 } | |
| 51 | |
| 52 # Return a positive integer less than or equal to X | |
| 53 # | |
| 54 proc randincr {X} { | |
| 55 while 1 { | |
| 56 set r [expr {int(rand()*$X)+1}] | |
| 57 if {$r>0} {return $r} | |
| 58 } | |
| 59 } | |
| 60 } | |
| 61 | |
| 62 # Scramble the $inlist into a random order. | |
| 63 # | |
| 64 proc scramble {inlist} { | |
| 65 set y {} | |
| 66 foreach x $inlist { | |
| 67 lappend y [list [expr {rand()}] $x] | |
| 68 } | |
| 69 set y [lsort $y] | |
| 70 set outlist {} | |
| 71 foreach x $y { | |
| 72 lappend outlist [lindex $x 1] | |
| 73 } | |
| 74 return $outlist | |
| 75 } | |
| 76 | |
| 77 # Always use the same random seed so that the sequence of tests | |
| 78 # is repeatable. | |
| 79 # | |
| 80 expr {srand(1234)} | |
| 81 | |
| 82 # Run these tests for all number of dimensions between 1 and 5. | |
| 83 # | |
| 84 for {set nDim 1} {$nDim<=5} {incr nDim} { | |
| 85 | |
| 86 # Construct an rtree virtual table and an ordinary btree table | |
| 87 # to mirror it. The ordinary table should be much slower (since | |
| 88 # it has to do a full table scan) but should give the exact same | |
| 89 # answers. | |
| 90 # | |
| 91 do_test rtree4-$nDim.1 { | |
| 92 set clist {} | |
| 93 set cklist {} | |
| 94 for {set i 0} {$i<$nDim} {incr i} { | |
| 95 lappend clist mn$i mx$i | |
| 96 lappend cklist "mn$i<mx$i" | |
| 97 } | |
| 98 db eval "DROP TABLE IF EXISTS rx" | |
| 99 db eval "DROP TABLE IF EXISTS bx" | |
| 100 db eval "CREATE VIRTUAL TABLE rx USING rtree(id, [join $clist ,])" | |
| 101 db eval "CREATE TABLE bx(id INTEGER PRIMARY KEY,\ | |
| 102 [join $clist ,], CHECK( [join $cklist { AND }] ))" | |
| 103 } {} | |
| 104 | |
| 105 # Do many insertions of small objects. Do both overlapping and | |
| 106 # contained-within queries after each insert to verify that all | |
| 107 # is well. | |
| 108 # | |
| 109 unset -nocomplain where | |
| 110 for {set i 1} {$i<$::NROW} {incr i} { | |
| 111 # Do a random insert | |
| 112 # | |
| 113 do_test rtree4-$nDim.2.$i.1 { | |
| 114 set vlist {} | |
| 115 for {set j 0} {$j<$nDim} {incr j} { | |
| 116 set mn [rand 10000] | |
| 117 set mx [expr {$mn+[randincr 50]}] | |
| 118 lappend vlist $mn $mx | |
| 119 } | |
| 120 db eval "INSERT INTO rx VALUES(NULL, [join $vlist ,])" | |
| 121 db eval "INSERT INTO bx VALUES(NULL, [join $vlist ,])" | |
| 122 } {} | |
| 123 | |
| 124 # Do a contained-in query on all dimensions | |
| 125 # | |
| 126 set where {} | |
| 127 for {set j 0} {$j<$nDim} {incr j} { | |
| 128 set mn [rand 10000] | |
| 129 set mx [expr {$mn+[randincr 500]}] | |
| 130 lappend where mn$j>=$mn mx$j<=$mx | |
| 131 } | |
| 132 set where "WHERE [join $where { AND }]" | |
| 133 do_test rtree4-$nDim.2.$i.2 { | |
| 134 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] | |
| 135 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] | |
| 136 | |
| 137 # Do an overlaps query on all dimensions | |
| 138 # | |
| 139 set where {} | |
| 140 for {set j 0} {$j<$nDim} {incr j} { | |
| 141 set mn [rand 10000] | |
| 142 set mx [expr {$mn+[randincr 500]}] | |
| 143 lappend where mx$j>=$mn mn$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 a contained-in 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 mn$j>=$mn mx$j<=$mx | |
| 161 } | |
| 162 set where "WHERE [join $where { AND }]" | |
| 163 do_test rtree4-$nDim.2.$i.3 { | |
| 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 an overlaps query with surplus contraints at the beginning. | |
| 168 # This should force a full-table scan on the rtree. | |
| 169 # | |
| 170 set where {} | |
| 171 for {set j 0} {$j<$nDim} {incr j} { | |
| 172 lappend where mn$j>=-10000 mx$j<=10000 | |
| 173 } | |
| 174 for {set j 0} {$j<$nDim} {incr j} { | |
| 175 set mn [rand 10000] | |
| 176 set mx [expr {$mn+[randincr 500]}] | |
| 177 lappend where mx$j>$mn mn$j<$mx | |
| 178 } | |
| 179 set where "WHERE [join $where { AND }]" | |
| 180 do_test rtree4-$nDim.2.$i.4 { | |
| 181 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] | |
| 182 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] | |
| 183 | |
| 184 # Do a contained-in query with surplus contraints at the end | |
| 185 # | |
| 186 set where {} | |
| 187 for {set j 0} {$j<$nDim} {incr j} { | |
| 188 set mn [rand 10000] | |
| 189 set mx [expr {$mn+[randincr 500]}] | |
| 190 lappend where mn$j>=$mn mx$j<$mx | |
| 191 } | |
| 192 for {set j [expr {$nDim-1}]} {$j>=0} {incr j -1} { | |
| 193 lappend where mn$j>=-10000 mx$j<10000 | |
| 194 } | |
| 195 set where "WHERE [join $where { AND }]" | |
| 196 do_test rtree4-$nDim.2.$i.5 { | |
| 197 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] | |
| 198 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] | |
| 199 | |
| 200 # Do an overlaps query with surplus contraints at the end | |
| 201 # | |
| 202 set where {} | |
| 203 for {set j [expr {$nDim-1}]} {$j>=0} {incr j -1} { | |
| 204 set mn [rand 10000] | |
| 205 set mx [expr {$mn+[randincr 500]}] | |
| 206 lappend where mx$j>$mn mn$j<=$mx | |
| 207 } | |
| 208 for {set j 0} {$j<$nDim} {incr j} { | |
| 209 lappend where mx$j>-10000 mn$j<=10000 | |
| 210 } | |
| 211 set where "WHERE [join $where { AND }]" | |
| 212 do_test rtree4-$nDim.2.$i.6 { | |
| 213 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] | |
| 214 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] | |
| 215 | |
| 216 # Do a contained-in query with surplus contraints where the | |
| 217 # constraints appear in a random order. | |
| 218 # | |
| 219 set where {} | |
| 220 for {set j 0} {$j<$nDim} {incr j} { | |
| 221 set mn1 [rand 10000] | |
| 222 set mn2 [expr {$mn1+[randincr 100]}] | |
| 223 set mx1 [expr {$mn2+[randincr 400]}] | |
| 224 set mx2 [expr {$mx1+[randincr 100]}] | |
| 225 lappend where mn$j>=$mn1 mn$j>$mn2 mx$j<$mx1 mx$j<=$mx2 | |
| 226 } | |
| 227 set where "WHERE [join [scramble $where] { AND }]" | |
| 228 do_test rtree4-$nDim.2.$i.7 { | |
| 229 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] | |
| 230 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] | |
| 231 | |
| 232 # Do an overlaps query with surplus contraints where the | |
| 233 # constraints appear in a random order. | |
| 234 # | |
| 235 set where {} | |
| 236 for {set j 0} {$j<$nDim} {incr j} { | |
| 237 set mn1 [rand 10000] | |
| 238 set mn2 [expr {$mn1+[randincr 100]}] | |
| 239 set mx1 [expr {$mn2+[randincr 400]}] | |
| 240 set mx2 [expr {$mx1+[randincr 100]}] | |
| 241 lappend where mx$j>=$mn1 mx$j>$mn2 mn$j<$mx1 mn$j<=$mx2 | |
| 242 } | |
| 243 set where "WHERE [join [scramble $where] { AND }]" | |
| 244 do_test rtree4-$nDim.2.$i.8 { | |
| 245 list $where [db eval "SELECT id FROM rx $where ORDER BY id"] | |
| 246 } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]] | |
| 247 } | |
| 248 | |
| 249 } | |
| 250 | |
| 251 finish_test | |
| OLD | NEW |