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 |