ext/rtree/rtree4.test

   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