Return to rtree4.test CVS log | Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / ext / rtree |
1.1 ! misho 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