CREATE VIRTUAL TABLE $nm USING rtree(a,b,c,d,e);
"
- # EVIDENCE-OF: R-37699-54000 This is their schema: CREATE TABLE
- # %_node(nodeno INTEGER PRIMARY KEY, data BLOB) CREATE TABLE
- # %_parent(nodeno INTEGER PRIMARY KEY, parentnode INTEGER) CREATE TABLE
- # %_rowid(rowid INTEGER PRIMARY KEY, nodeno INTEGER)
+ # EVIDENCE-OF: R-33789-46762 The content of an R*Tree index is actually
+ # stored in three ordinary SQLite tables with names derived from the
+ # name of the R*Tree.
+ #
+ # EVIDENCE-OF: R-39849-06566 This is their schema: CREATE TABLE
+ # %_node(nodeno INTEGER PRIMARY KEY, data) CREATE TABLE %_parent(nodeno
+ # INTEGER PRIMARY KEY, parentnode) CREATE TABLE %_rowid(rowid INTEGER
+ # PRIMARY KEY, nodeno)
#
# EVIDENCE-OF: R-07489-10051 The "%" in the name of each shadow table is
# replaced by the name of the R*Tree virtual table. So, if the name of
--- /dev/null
+# 2021 September 13
+#
+# The author disclaims copyright to this source code. In place of
+# a legal notice, here is a blessing:
+#
+# May you do good and not evil.
+# May you find forgiveness for yourself and forgive others.
+# May you share freely, never taking more than you give.
+#
+#***********************************************************************
+#
+# The focus of this file is testing the r-tree extension.
+#
+
+if {![info exists testdir]} {
+ set testdir [file join [file dirname [info script]] .. .. test]
+}
+source [file join [file dirname [info script]] rtree_util.tcl]
+source $testdir/tester.tcl
+set testprefix rtreedoc3
+
+ifcapable !rtree {
+ finish_test
+ return
+}
+
+
+# This command assumes that the argument is a node blob for a 2 dimensional
+# i32 r-tree table. It decodes and returns a list of cells from the node
+# as a list. Each cell is itself a list of the following form:
+#
+# {$rowid $minX $maxX $minY $maxY}
+#
+# For internal (non-leaf) nodes, the rowid is replaced by the child node
+# number.
+#
+proc rnode_cells {aData} {
+ set nDim 2
+
+ set nData [string length $aData]
+ set nBytePerCell [expr (8 + 2*$nDim*4)]
+ binary scan [string range $aData 2 3] S nCell
+
+ set res [list]
+ for {set i 0} {$i < $nCell} {incr i} {
+ set iOff [expr $i*$nBytePerCell+4]
+ set cell [string range $aData $iOff [expr $iOff+$nBytePerCell-1]]
+ binary scan $cell WIIII rowid x1 x2 y1 y2
+ lappend res [list $rowid $x1 $x2 $y1 $y2]
+ }
+
+ return $res
+}
+
+# Interpret the first two bytes of the blob passed as the only parameter
+# as a 16-bit big-endian integer and return the value. If this blob is
+# the root node of an r-tree, this value is the height of the tree.
+#
+proc rnode_height {aData} {
+ binary scan [string range $aData 0 1] S nHeight
+ return $nHeight
+}
+
+# Return a blob containing node iNode of r-tree "rt".
+#
+proc rt_node_get {iNode} {
+ db one { SELECT data FROM rt_node WHERE nodeno=$iNode }
+}
+
+
+#--------------------------------------------------------------
+# API:
+#
+# pq_init
+# Initialize a new test.
+#
+# pq_test_callback
+# Invoked each time the xQueryCallback function is called. This Tcl
+# command checks that the arguments that SQLite passed to xQueryCallback
+# are as expected.
+#
+# pq_test_row
+# Invoked each time a row is returned. Checks that the row returned
+# was predicted by the documentation.
+#
+# DATA STRUCTURE:
+# The priority queue is stored as a Tcl list. The order of elements in
+# the list is unimportant - it is just used as a set here. Each element
+# in the priority queue is itself a list. The first element is the
+# priority value for the entry (a real). Following this is a list of
+# key-value pairs that make up the entries fields.
+#
+proc pq_init {} {
+ global Q
+ set Q(pri_queue) [list]
+
+ set nHeight [rnode_height [rt_node_get 1]]
+ set nCell [llength [rnode_cells [rt_node_get 1]]]
+
+ # EVIDENCE-OF: R-54708-13595 An R*Tree query is initialized by making
+ # the root node the only entry in a priority queue sorted by rScore.
+ lappend Q(pri_queue) [list 0.0 [list \
+ iLevel [expr $nHeight+1] \
+ iChild 1 \
+ iCurrent 0 \
+ ]]
+}
+
+proc pq_extract {} {
+ global Q
+ if {[llength $Q(pri_queue)]==0} {
+ error "priority queue is empty!"
+ }
+
+ # Find the priority queue entry with the lowest score.
+ #
+ # EVIDENCE-OF: R-47257-47871 Smaller scores are processed first.
+ set iBest 0
+ set rBestScore [lindex $Q(pri_queue) 0 0]
+ for {set ii 1} {$ii < [llength $Q(pri_queue)]} {incr ii} {
+ set rScore [expr [lindex $Q(pri_queue) $ii 0]]
+ if {$rScore<$rBestScore} {
+ set rBestScore $rScore
+ set iBest $ii
+ }
+ }
+
+ # Extract the entry with the lowest score from the queue and return it.
+ #
+ # EVIDENCE-OF: R-60002-49798 The query proceeds by extracting the entry
+ # from the priority queue that has the lowest score.
+ set ret [lindex $Q(pri_queue) $iBest]
+ set Q(pri_queue) [lreplace $Q(pri_queue) $iBest $iBest]
+
+ return $ret
+}
+
+proc pq_new_entry {rScore iLevel cell} {
+ global Q
+
+ set rowid_name "iChild"
+ if {$iLevel==0} { set rowid_name "iRowid" }
+
+ set kv [list]
+ lappend kv aCoord [lrange $cell 1 end]
+ lappend kv iLevel $iLevel
+
+ if {$iLevel==0} {
+ lappend kv iRowid [lindex $cell 0]
+ } else {
+ lappend kv iChild [lindex $cell 0]
+ lappend kv iCurrent 0
+ }
+
+ lappend Q(pri_queue) [list $rScore $kv]
+}
+
+proc pq_test_callback {L res} {
+ #pq_debug "pq_test_callback $L -> $res"
+ global Q
+
+ array set G $L ;# "Got" - as in stuff passed to xQuery
+
+ # EVIDENCE-OF: R-65127-42665 If the extracted priority queue entry is a
+ # node (a subtree), then the next child of that node is passed to the
+ # xQueryFunc callback.
+ #
+ # If it had been a leaf, the row should have been returned, instead of
+ # xQueryCallback being called on a child - as is happening here.
+ foreach {rParentScore parent} [pq_extract] {}
+ array set P $parent ;# "Parent" - as in parent of expected cell
+ if {$P(iLevel)==0} { error "query callback mismatch (1)" }
+ set child_node [rnode_cells [rt_node_get $P(iChild)]]
+ set expected_cell [lindex $child_node $P(iCurrent)]
+ set expected_coords [lrange $expected_cell 1 end]
+ if {[llength $expected_coords] != [llength $G(aCoord)]} {
+ puts [array get P]
+ puts "E: $expected_coords G: $G(aCoord)"
+ error "coordinate mismatch in query callback (1)"
+ }
+ foreach a [lrange $expected_cell 1 end] b $G(aCoord) {
+ if {$a!=$b} { error "coordinate mismatch in query callback (2)" }
+ }
+
+ # Check level is as expected
+ #
+ if {$G(iLevel) != $P(iLevel)-1} {
+ error "iLevel mismatch in query callback (1)"
+ }
+
+ # Unless the callback returned NOT_WITHIN, add the entry to the priority
+ # queue.
+ #
+ # EVIDENCE-OF: R-28754-35153 Those subelements for which the xQueryFunc
+ # callback sets eWithin to PARTLY_WITHIN or FULLY_WITHIN are added to
+ # the priority queue using the score supplied by the callback.
+ #
+ # EVIDENCE-OF: R-08681-45277 Subelements that return NOT_WITHIN are
+ # discarded.
+ set r [lindex $res 0]
+ set rScore [lindex $res 1]
+ if {$r!="fully" && $r!="partly" && $r!="not"} {
+ error "unknown result: $r - expected \"fully\", \"partly\" or \"not\""
+ }
+ if {$r!="not"} {
+ pq_new_entry $rScore [expr $P(iLevel)-1] $expected_cell
+ }
+
+ # EVIDENCE-OF: R-07194-63805 If the node has more children then it is
+ # returned to the priority queue. Otherwise it is discarded.
+ incr P(iCurrent)
+ if {$P(iCurrent)<[llength $child_node]} {
+ lappend Q(pri_queue) [list $rParentScore [array get P]]
+ }
+}
+
+proc pq_test_result {id x1 x2 y1 y2} {
+ #pq_debug "pq_test_result $id $x1 $x2 $y1 $y2"
+ foreach {rScore next} [pq_extract] {}
+
+ # The extracted entry must be a leaf (otherwise, xQueryCallback would
+ # have been called on the extracted entries children instead of just
+ # returning the data).
+ #
+ # EVIDENCE-OF: R-13214-54017 If that entry is a leaf (meaning that it is
+ # an actual R*Tree entry and not a subtree) then that entry is returned
+ # as one row of the query result.
+ array set N $next
+ if {$N(iLevel)!=0} { error "result row mismatch (1)" }
+
+ if {$x1!=[lindex $N(aCoord) 0] || $x2!=[lindex $N(aCoord) 1]
+ || $y1!=[lindex $N(aCoord) 2] || $y2!=[lindex $N(aCoord) 3]
+ } {
+ if {$N(iLevel)!=0} { error "result row mismatch (2)" }
+ }
+
+ if {$id!=$N(iRowid)} { error "result row mismatch (3)" }
+}
+
+proc pq_done {} {
+ global Q
+ # EVIDENCE-OF: R-57438-45968 The query runs until the priority queue is
+ # empty.
+ if {[llength $Q(pri_queue)]>0} {
+ error "priority queue is not empty!"
+ }
+}
+
+proc pq_debug {caption} {
+ global Q
+
+ puts "**** $caption ****"
+ set i 0
+ foreach q [lsort -real -index 0 $Q(pri_queue)] {
+ puts "PQ $i: $q"
+ incr i
+ }
+}
+
+#--------------------------------------------------------------
+
+proc box_query {a} {
+ set res [list fully [expr rand()]]
+ pq_test_callback $a $res
+ return $res
+}
+
+register_box_query db box_query
+
+do_execsql_test 1.0 {
+ CREATE VIRTUAL TABLE rt USING rtree_i32(id, x1,x2, y1,y2);
+ WITH s(i) AS (
+ SELECT 0 UNION ALL SELECT i+1 FROM s WHERE i<64
+ )
+ INSERT INTO rt SELECT NULL, a.i, a.i+1, b.i, b.i+1 FROM s a, s b;
+}
+
+proc box_query {a} {
+ set res [list fully [expr rand()]]
+ pq_test_callback $a $res
+ return $res
+}
+
+pq_init
+db eval { SELECT id, x1,x2, y1,y2 FROM rt WHERE id MATCH qbox() } {
+ pq_test_result $id $x1 $x2 $y1 $y2
+}
+pq_done
+
+finish_test
+
+
Tcl_Obj *pScript;
};
+typedef struct BoxQueryCtx BoxQueryCtx;
+struct BoxQueryCtx {
+ Tcl_Interp *interp;
+ Tcl_Obj *pScript;
+};
+
static void testDelUser(void *pCtx){
BoxGeomCtx *p = (BoxGeomCtx*)pCtx;
Tcl_EvalObjEx(p->interp, p->pScript, 0);
# sqlite3_rtree_geometry structure which provides information about how
# the SQL function was invoked.
-# EVIDENCE-OF: R-40260-16838 The number of coordinates is 2 for a
-# 1-dimensional R*Tree, 4 for a 2-dimensional R*Tree, 6 for a
-# 3-dimensional R*Tree, and so forth.
-
# EVIDENCE-OF: R-00090-24248 The third argument, aCoord[], is an array
# of nCoord coordinates that defines a bounding box to be tested.
return TCL_OK;
}
+static int box_query(sqlite3_rtree_query_info *pInfo){
+ const char *azParentWithin[] = {"not", "partly", "fully", 0};
+ BoxQueryCtx *pCtx = (BoxQueryCtx*)pInfo->pContext;
+ Tcl_Interp *interp = pCtx->interp;
+ Tcl_Obj *pEval;
+ Tcl_Obj *pArg;
+ Tcl_Obj *pTmp = 0;
+ int rc;
+ int ii;
+
+ pEval = Tcl_DuplicateObj(pCtx->pScript);
+ Tcl_IncrRefCount(pEval);
+ pArg = Tcl_NewObj();
+ Tcl_IncrRefCount(pArg);
+
+ /* aParam[] */
+ pTmp = Tcl_NewObj();
+ Tcl_IncrRefCount(pTmp);
+ for(ii=0; ii<pInfo->nParam; ii++){
+ Tcl_Obj *p = Tcl_NewDoubleObj(pInfo->aParam[ii]);
+ Tcl_ListObjAppendElement(interp, pTmp, p);
+ }
+ Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("aParam", -1));
+ Tcl_ListObjAppendElement(interp, pArg, pTmp);
+ Tcl_DecrRefCount(pTmp);
+
+ /* aCoord[] */
+ pTmp = Tcl_NewObj();
+ Tcl_IncrRefCount(pTmp);
+ for(ii=0; ii<pInfo->nCoord; ii++){
+ Tcl_Obj *p = Tcl_NewDoubleObj(pInfo->aCoord[ii]);
+ Tcl_ListObjAppendElement(interp, pTmp, p);
+ }
+ Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("aCoord", -1));
+ Tcl_ListObjAppendElement(interp, pArg, pTmp);
+ Tcl_DecrRefCount(pTmp);
+
+ /* anQueue[] */
+ pTmp = Tcl_NewObj();
+ Tcl_IncrRefCount(pTmp);
+ for(ii=0; ii<=pInfo->mxLevel; ii++){
+ Tcl_Obj *p = Tcl_NewIntObj((int)pInfo->anQueue[ii]);
+ Tcl_ListObjAppendElement(interp, pTmp, p);
+ }
+ Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("anQueue", -1));
+ Tcl_ListObjAppendElement(interp, pArg, pTmp);
+ Tcl_DecrRefCount(pTmp);
+
+ /* iLevel */
+ Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("iLevel", -1));
+ Tcl_ListObjAppendElement(interp, pArg, Tcl_NewIntObj(pInfo->iLevel));
+
+ /* mxLevel */
+ Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("mxLevel", -1));
+ Tcl_ListObjAppendElement(interp, pArg, Tcl_NewIntObj(pInfo->mxLevel));
+
+ /* iRowid */
+ Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("iRowid", -1));
+ Tcl_ListObjAppendElement(interp, pArg, Tcl_NewWideIntObj(pInfo->iRowid));
+
+ /* rParentScore */
+ Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("rParentScore", -1));
+ Tcl_ListObjAppendElement(interp, pArg, Tcl_NewDoubleObj(pInfo->rParentScore));
+
+ /* eParentWithin */
+ assert( pInfo->eParentWithin==0
+ || pInfo->eParentWithin==1
+ || pInfo->eParentWithin==2
+ );
+ Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("eParentWithin", -1));
+ Tcl_ListObjAppendElement(interp, pArg,
+ Tcl_NewStringObj(azParentWithin[pInfo->eParentWithin], -1)
+ );
+
+ Tcl_ListObjAppendElement(interp, pEval, pArg);
+ rc = Tcl_EvalObjEx(interp, pEval, 0) ? SQLITE_ERROR : SQLITE_OK;
+
+ if( rc==SQLITE_OK ){
+ double rScore = 0.0;
+ int nObj = 0;
+ int eP = 0;
+ Tcl_Obj **aObj = 0;
+ Tcl_Obj *pRes = Tcl_GetObjResult(interp);
+
+ if( Tcl_ListObjGetElements(interp, pRes, &nObj, &aObj)
+ || nObj!=2
+ || Tcl_GetDoubleFromObj(interp, aObj[1], &rScore)
+ || Tcl_GetIndexFromObj(interp, aObj[0], azParentWithin, "value", 0, &eP)
+ ){
+ rc = SQLITE_ERROR;
+ }else{
+ pInfo->rScore = rScore;
+ pInfo->eParentWithin = eP;
+ }
+ }
+
+ Tcl_DecrRefCount(pArg);
+ Tcl_DecrRefCount(pEval);
+ return rc;
+}
+
+static void box_query_destroy(void *p){
+ BoxQueryCtx *pCtx = (BoxQueryCtx*)p;
+ Tcl_DecrRefCount(pCtx->pScript);
+ ckfree(pCtx);
+}
+
static int SQLITE_TCLAPI register_box_query(
void * clientData,
Tcl_Interp *interp,
extern int getDbPointer(Tcl_Interp*, const char*, sqlite3**);
extern const char *sqlite3ErrName(int);
sqlite3 *db;
+ BoxQueryCtx *pCtx;
if( objc!=3 ){
Tcl_WrongNumArgs(interp, 1, objv, "DB SCRIPT");
}
if( getDbPointer(interp, Tcl_GetString(objv[1]), &db) ) return TCL_ERROR;
+ pCtx = (BoxQueryCtx*)ckalloc(sizeof(BoxQueryCtx*));
+ pCtx->interp = interp;
+ pCtx->pScript = Tcl_DuplicateObj(objv[2]);
+ Tcl_IncrRefCount(pCtx->pScript);
+
+ sqlite3_rtree_query_callback(
+ db, "qbox", box_query, (void*)pCtx, box_query_destroy
+ );
+
+ Tcl_ResetResult(interp);
return TCL_OK;
}
#endif /* SQLITE_ENABLE_RTREE */
#endif /* SQLITE_ENABLE_RTREE */
return TCL_OK;
}
+
-C Improved\stestability\sof\schanges\sfrom\scheck-in\s[255b0eeed113d83b].
-D 2021-09-29T14:01:44.665
+C Add\snew\stest\sfile\srtreedoc3.test.
+D 2021-09-29T16:38:02.070
F .fossil-settings/empty-dirs dbb81e8fc0401ac46a1491ab34a7f2c7c0452f2f06b54ebb845d024ca8283ef1
F .fossil-settings/ignore-glob 35175cdfcf539b2318cb04a9901442804be81cd677d8b889fcc9149c21f239ea
F LICENSE.md df5091916dbb40e6e9686186587125e1b2ff51f022cc334e886c19a0e9982724
F ext/rtree/rtreecheck.test d67d5b3e9e45bfa8cd90734e8e9302144ac415b8e9176c6f02d4f92892ee8a35
F ext/rtree/rtreecirc.test aec664eb21ae943aeb344191407afff5d392d3ae9d12b9a112ced0d9c5de298e
F ext/rtree/rtreeconnect.test 225ad3fcb483d36cbee423a25052a6bbae762c9576ae9268332360c68c170d3d
-F ext/rtree/rtreedoc.test 243cd3fdee1cb89e290e908ddde0cc0cfda0ccb85473c6d1b3c43e6260b14cac
+F ext/rtree/rtreedoc.test 9d59baa8bce94056c63f872ad99fd9eaed60105be432af55402777f8ce093fb0
F ext/rtree/rtreedoc2.test 194ebb7d561452dcdc10bf03f44e30c082c2f0c14efeb07f5e02c7daf8284d93
+F ext/rtree/rtreedoc3.test 555a878c4d79c4e37fa439a1c3b02ee65d3ebaf75d9e8d96a9c55d66db3efbf8
F ext/rtree/rtreefuzz001.test 0fc793f67897c250c5fde96cefee455a5e2fb92f4feeabde5b85ea02040790ee
F ext/rtree/sqlite3rtree.h 03c8db3261e435fbddcfc961471795cbf12b24e03001d0015b2636b0f3881373
-F ext/rtree/test_rtreedoc.c 216f988e0b56474a3d42905653777772d3bdd413a7fe09a79e466b19296853b0
+F ext/rtree/test_rtreedoc.c e81d9bf69f7cbc8ba536458bbd8fc06a6f9ca93165f7d68832f588461e6a53cb
F ext/rtree/tkt3363.test 142ab96eded44a3615ec79fba98c7bde7d0f96de
F ext/rtree/util/randomshape.tcl 54ee03d0d4a1c621806f7f44d5b78d2db8fac26e0e8687c36c4bd0203b27dbff
F ext/rtree/viewrtree.tcl eea6224b3553599ae665b239bd827e182b466024
F vsixtest/vsixtest.vcxproj.data 2ed517e100c66dc455b492e1a33350c1b20fbcdc
F vsixtest/vsixtest.vcxproj.filters 37e51ffedcdb064aad6ff33b6148725226cd608e
F vsixtest/vsixtest_TemporaryKey.pfx e5b1b036facdb453873e7084e1cae9102ccc67a0
-P 9bbc01fb239b4aa752a56c584baa29655a3c845425d5c17d24a3939984d54fe2
-R c40e5ac53dc649361977b7f5af733d92
-U drh
-Z 737a81f3f3c6c485a35681c71272067e
+P bbfd083c26086fb103fec88faa59a01e689e0b7fce38c09d8846bb472a0e6760
+R 1037eaccd5510af0a78ced89d8bc5f27
+U dan
+Z 19b69f1d272ce42a44f4a2c19e639601
-bbfd083c26086fb103fec88faa59a01e689e0b7fce38c09d8846bb472a0e6760
\ No newline at end of file
+54604869861cc5866d5de87785599ca56f75067f8cb7fe22e32912b3a037e37b
\ No newline at end of file
projects / thirdparty / sqlite.git / commitdiff
