Annotation of embedaddon/sqlite3/ext/rtree/rtree4.test, revision 1.1
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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>