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 [file join [file dirname [info script]] rtree_util.tcl]
  19 source $testdir/tester.tcl
  20
  21 ifcapable !rtree {
  22   finish_test
  23   return
  24 }
  25
  26 set ::NROW 2500
  27 if {[info exists G(isquick)] && $G(isquick)} {
  28   set ::NROW 250
  29 }
  30
  31 ifcapable !rtree_int_only {
  32   # Return a floating point number between -X and X.
  33   #
  34   proc rand {X} {
  35     return [expr {int((rand()-0.5)*1024.0*$X)/512.0}]
  36   }
  37
  38   # Return a positive floating point number less than or equal to X
  39   #
  40   proc randincr {X} {
  41     while 1 {
  42       set r [expr {int(rand()*$X*32.0)/32.0}]
  43       if {$r>0.0} {return $r}
  44     }
  45   }
  46 } else {
  47   # For rtree_int_only, return an number between -X and X.
  48   #
  49   proc rand {X} {
  50     return [expr {int((rand()-0.5)*2*$X)}]
  51   }
  52
  53   # Return a positive integer less than or equal to X
  54   #
  55   proc randincr {X} {
  56     while 1 {
  57       set r [expr {int(rand()*$X)+1}]
  58       if {$r>0} {return $r}
  59     }
  60   }
  61 }
  62
  63 # Scramble the $inlist into a random order.
  64 #
  65 proc scramble {inlist} {
  66   set y {}
  67   foreach x $inlist {
  68     lappend y [list [expr {rand()}] $x]
  69   }
  70   set y [lsort $y]
  71   set outlist {}
  72   foreach x $y {
  73     lappend outlist [lindex $x 1]
  74   }
  75   return $outlist
  76 }
  77
  78 # Always use the same random seed so that the sequence of tests
  79 # is repeatable.
  80 #
  81 expr {srand(1234)}
  82
  83 # Run these tests for all number of dimensions between 1 and 5.
  84 #
  85 for {set nDim 1} {$nDim<=5} {incr nDim} {
  86
  87   # Construct an rtree virtual table and an ordinary btree table
  88   # to mirror it.  The ordinary table should be much slower (since
  89   # it has to do a full table scan) but should give the exact same
  90   # answers.
  91   #
  92   do_test rtree4-$nDim.1 {
  93     set clist {}
  94     set cklist {}
  95     for {set i 0} {$i<$nDim} {incr i} {
  96       lappend clist mn$i mx$i
  97       lappend cklist "mn$i<mx$i"
  98     }
  99     db eval "DROP TABLE IF EXISTS rx"
 100     db eval "DROP TABLE IF EXISTS bx"
 101     db eval "CREATE VIRTUAL TABLE rx USING rtree(id, [join $clist ,])"
 102     db eval "CREATE TABLE bx(id INTEGER PRIMARY KEY,\
 103                 [join $clist ,], CHECK( [join $cklist { AND }] ))"
 104   } {}
 105
 106   # Do many insertions of small objects.  Do both overlapping and
 107   # contained-within queries after each insert to verify that all
 108   # is well.
 109   #
 110   unset -nocomplain where
 111   for {set i 1} {$i<$::NROW} {incr i} {
 112     # Do a random insert
 113     #
 114     do_test rtree4-$nDim.2.$i.1 {
 115       set vlist {}
 116       for {set j 0} {$j<$nDim} {incr j} {
 117         set mn [rand 10000]
 118         set mx [expr {$mn+[randincr 50]}]
 119         lappend vlist $mn $mx
 120       }
 121       db eval "INSERT INTO rx VALUES(NULL, [join $vlist ,])"
 122       db eval "INSERT INTO bx VALUES(NULL, [join $vlist ,])"
 123     } {}
 124
 125     # Do a contained-in query on all dimensions
 126     #
 127     set where {}
 128     for {set j 0} {$j<$nDim} {incr j} {
 129       set mn [rand 10000]
 130       set mx [expr {$mn+[randincr 500]}]
 131       lappend where mn$j>=$mn mx$j<=$mx
 132     }
 133     set where "WHERE [join $where { AND }]"
 134     do_test rtree4-$nDim.2.$i.2 {
 135       list $where [db eval "SELECT id FROM rx $where ORDER BY id"]
 136     } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]]
 137
 138     # Do an overlaps query on all dimensions
 139     #
 140     set where {}
 141     for {set j 0} {$j<$nDim} {incr j} {
 142       set mn [rand 10000]
 143       set mx [expr {$mn+[randincr 500]}]
 144       lappend where mx$j>=$mn mn$j<=$mx
 145     }
 146     set where "WHERE [join $where { AND }]"
 147     do_test rtree4-$nDim.2.$i.3 {
 148       list $where [db eval "SELECT id FROM rx $where ORDER BY id"]
 149     } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]]
 150
 151     # Do a contained-in query with surplus contraints at the beginning.
 152     # This should force a full-table scan on the rtree.
 153     #
 154     set where {}
 155     for {set j 0} {$j<$nDim} {incr j} {
 156       lappend where mn$j>-10000 mx$j<10000
 157     }
 158     for {set j 0} {$j<$nDim} {incr j} {
 159       set mn [rand 10000]
 160       set mx [expr {$mn+[randincr 500]}]
 161       lappend where mn$j>=$mn mx$j<=$mx
 162     }
 163     set where "WHERE [join $where { AND }]"
 164     do_test rtree4-$nDim.2.$i.3 {
 165       list $where [db eval "SELECT id FROM rx $where ORDER BY id"]
 166     } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]]
 167
 168     # Do an overlaps query with surplus contraints at the beginning.
 169     # This should force a full-table scan on the rtree.
 170     #
 171     set where {}
 172     for {set j 0} {$j<$nDim} {incr j} {
 173       lappend where mn$j>=-10000 mx$j<=10000
 174     }
 175     for {set j 0} {$j<$nDim} {incr j} {
 176       set mn [rand 10000]
 177       set mx [expr {$mn+[randincr 500]}]
 178       lappend where mx$j>$mn mn$j<$mx
 179     }
 180     set where "WHERE [join $where { AND }]"
 181     do_test rtree4-$nDim.2.$i.4 {
 182       list $where [db eval "SELECT id FROM rx $where ORDER BY id"]
 183     } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]]
 184
 185     # Do a contained-in query with surplus contraints at the end
 186     #
 187     set where {}
 188     for {set j 0} {$j<$nDim} {incr j} {
 189       set mn [rand 10000]
 190       set mx [expr {$mn+[randincr 500]}]
 191       lappend where mn$j>=$mn mx$j<$mx
 192     }
 193     for {set j [expr {$nDim-1}]} {$j>=0} {incr j -1} {
 194       lappend where mn$j>=-10000 mx$j<10000
 195     }
 196     set where "WHERE [join $where { AND }]"
 197     do_test rtree4-$nDim.2.$i.5 {
 198       list $where [db eval "SELECT id FROM rx $where ORDER BY id"]
 199     } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]]
 200
 201     # Do an overlaps query with surplus contraints at the end
 202     #
 203     set where {}
 204     for {set j [expr {$nDim-1}]} {$j>=0} {incr j -1} {
 205       set mn [rand 10000]
 206       set mx [expr {$mn+[randincr 500]}]
 207       lappend where mx$j>$mn mn$j<=$mx
 208     }
 209     for {set j 0} {$j<$nDim} {incr j} {
 210       lappend where mx$j>-10000 mn$j<=10000
 211     }
 212     set where "WHERE [join $where { AND }]"
 213     do_test rtree4-$nDim.2.$i.6 {
 214       list $where [db eval "SELECT id FROM rx $where ORDER BY id"]
 215     } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]]
 216
 217     # Do a contained-in query with surplus contraints where the
 218     # constraints appear in a random order.
 219     #
 220     set where {}
 221     for {set j 0} {$j<$nDim} {incr j} {
 222       set mn1 [rand 10000]
 223       set mn2 [expr {$mn1+[randincr 100]}]
 224       set mx1 [expr {$mn2+[randincr 400]}]
 225       set mx2 [expr {$mx1+[randincr 100]}]
 226       lappend where mn$j>=$mn1 mn$j>$mn2 mx$j<$mx1 mx$j<=$mx2
 227     }
 228     set where "WHERE [join [scramble $where] { AND }]"
 229     do_test rtree4-$nDim.2.$i.7 {
 230       list $where [db eval "SELECT id FROM rx $where ORDER BY id"]
 231     } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]]
 232
 233     # Do an overlaps query with surplus contraints where the
 234     # constraints appear in a random order.
 235     #
 236     set where {}
 237     for {set j 0} {$j<$nDim} {incr j} {
 238       set mn1 [rand 10000]
 239       set mn2 [expr {$mn1+[randincr 100]}]
 240       set mx1 [expr {$mn2+[randincr 400]}]
 241       set mx2 [expr {$mx1+[randincr 100]}]
 242       lappend where mx$j>=$mn1 mx$j>$mn2 mn$j<$mx1 mn$j<=$mx2
 243     }
 244     set where "WHERE [join [scramble $where] { AND }]"
 245     do_test rtree4-$nDim.2.$i.8 {
 246       list $where [db eval "SELECT id FROM rx $where ORDER BY id"]
 247     } [list $where [db eval "SELECT id FROM bx $where ORDER BY id"]]
 248   }
 249
 250   do_rtree_integrity_test rtree4-$nDim.3 rx
 251 }
 252
 253 expand_all_sql db
 254 finish_test