Return to rtree4.test CVS log

Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / ext / rtree

sqlite3

    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