1 files changed, 346 insertions, 0 deletions
diff --git a/ext/rtree/rtreedoc2.test b/ext/rtree/rtreedoc2.test
new file mode 100644
index 0000000..ca0c6b3
--- /dev/null
+++ b/ext/rtree/rtreedoc2.test
@@ -0,0 +1,346 @@
+# 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 rtreedoc2
+
+ifcapable !rtree {
+  finish_test
+  return
+}
+
+#-------------------------------------------------------------------------
+#-------------------------------------------------------------------------
+# Section 6 of documentation.
+#-------------------------------------------------------------------------
+#-------------------------------------------------------------------------
+set testprefix rtreedoc2-1
+
+# EVIDENCE-OF: R-35254-48865 A call to one of the above APIs creates a
+# new SQL function named by the second parameter (zQueryFunc or zGeom).
+#
+# [register_circle_geom db] registers new geometry callback "Qcircle"
+# and legacy implementation "circle". Test that these do actually appear.
+#
+do_execsql_test 1.1.0 {
+  SELECT * FROM pragma_function_list WHERE name IN('circle', 'qcircle');
+} {
+}
+do_test 1.1 {
+  register_circle_geom db
+} {SQLITE_OK}
+do_execsql_test 1.1.2 {
+  SELECT * FROM pragma_function_list WHERE name = 'circle' AND enc='utf8';
+} {
+  circle 0 s utf8 -1 0
+}
+do_execsql_test 1.1.3 {
+  SELECT * FROM pragma_function_list WHERE name = 'qcircle' AND enc='utf8';
+} {
+  qcircle 0 s utf8 -1 0
+} 
+
+do_execsql_test 1.2.0 { SELECT circle(1, 2, 3); } {{}}
+do_execsql_test 1.2.1 { SELECT qcircle(1, 2, 3); } {{}}
+
+# EVIDENCE-OF: R-61427-46983
+do_execsql_test 1.3.0 {
+  CREATE VIRTUAL TABLE demo_index USING rtree(id, x1,x2, y1,y2);
+  INSERT INTO demo_index VALUES(10, 45,45,  24,24);
+  INSERT INTO demo_index VALUES(20, 50,50,  28,28);
+  INSERT INTO demo_index VALUES(30, 43,43,  22,22);
+}
+do_execsql_test 1.3.1 {
+  SELECT id FROM demo_index WHERE id MATCH circle(45.3, 22.9, 5.0)
+} {10 30}
+
+# EVIDENCE-OF: R-16907-50223 The SQL syntax for custom queries is the
+# same regardless of which interface, sqlite3_rtree_geometry_callback()
+# or sqlite3_rtree_query_callback(), is used to register the SQL
+# function.
+do_execsql_test 1.3.2 {
+  SELECT id FROM demo_index WHERE id MATCH qcircle(45.3, 22.9, 5.0, 1)
+} {10 30}
+
+
+# EVIDENCE-OF: R-59634-51678 When that SQL function appears on the
+# right-hand side of the MATCH operator and the left-hand side of the
+# MATCH operator is any column in the R*Tree virtual table, then the
+# callback defined by the third argument (xQueryFunc or xGeom) is
+# invoked to determine if a particular object or subtree overlaps the
+# desired region.
+proc box_geom {args} {
+  lappend ::box_geom [concat [lindex $args 0] [lrange $args 2 end-1]]
+  return ""
+}
+register_box_geom db box_geom
+set box_geom [list]
+do_execsql_test 1.3.2 {
+  SELECT id FROM demo_index WHERE id MATCH box(43,46, 21,25);
+} {10 30}
+do_test 1.3.3 {
+  set ::box_geom
+} [list {*}{
+  {box {43.0 46.0 21.0 25.0} {45.0 45.0 24.0 24.0}}
+  {box {43.0 46.0 21.0 25.0} {50.0 50.0 28.0 28.0}} 
+  {box {43.0 46.0 21.0 25.0} {43.0 43.0 22.0 22.0}}
+}]
+
+#-------------------------------------------------------------------------
+#-------------------------------------------------------------------------
+# Section 6 of documentation.
+#-------------------------------------------------------------------------
+#-------------------------------------------------------------------------
+set testprefix rtreedoc2-2
+
+# EVIDENCE-OF: R-02424-24769 The second argument is the number of
+# coordinates in each r-tree entry, and is always the same for any given
+# R*Tree.
+#
+# 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.
+#
+# The second argument refered to above is the length of the list passed
+# as the 3rd parameter to the Tcl script.
+#
+do_execsql_test 1.0 {
+  CREATE VIRTUAL TABLE rt1 USING rtree(id, x1,x2);
+  CREATE VIRTUAL TABLE rt2 USING rtree(id, x1,x2, y1,y2);
+  CREATE VIRTUAL TABLE rt3 USING rtree(id, x1,x2, y1,y2, z1,z2);
+
+  INSERT INTO rt1 DEFAULT VALUES;
+  INSERT INTO rt2 DEFAULT VALUES;
+  INSERT INTO rt3 DEFAULT VALUES;
+}
+foreach {tn tbl nCoord} {
+  1 rt1 2     
+  2 rt2 4
+  3 rt3 6
+} {
+  set ::box_geom [list]
+  do_catchsql_test 1.$tn.1 "
+    SELECT id FROM $tbl WHERE id MATCH box();
+  " {1 {SQL logic error}}
+
+  do_test 1.$tn.2 {
+    llength [lindex $::box_geom 0 2]
+  } $nCoord
+}
+
+# EVIDENCE-OF: R-28051-48608 If xGeom returns anything other than
+# SQLITE_OK, then the r-tree query will abort with an error.
+proc box_geom {args} {
+  error "an error!"
+}
+do_catchsql_test 2.0 {
+  SELECT * FROM rt2 WHERE id MATCH box(22,23, 24,25); 
+} {1 {SQL logic error}}
+
+do_execsql_test 3.0 {
+  INSERT INTO rt1 VALUES(10, 10, 10);
+  INSERT INTO rt1 VALUES(11, 11, 11);
+  INSERT INTO rt1 VALUES(12, 12, 12);
+  INSERT INTO rt1 VALUES(13, 13, 13);
+  INSERT INTO rt1 VALUES(14, 14, 14);
+}
+
+# EVIDENCE-OF: R-53759-57366 The exact same sqlite3_rtree_geometry
+# structure is used for every callback for same MATCH operator in the
+# same query.
+proc box_geom {args} {
+  lappend ::ptr_list [lindex $args 4]
+  return 0
+}
+set ::ptr_list [list]
+do_execsql_test 3.1 {
+  SELECT * FROM rt1 WHERE id MATCH box(1,1);
+}
+do_test 3.2 {
+  set val [lindex $::ptr_list 0]
+  foreach p $::ptr_list {
+    if {$p!=$val} {error "pointer mismatch"}
+  }
+} {}
+
+# EVIDENCE-OF: R-60247-35692 The contents of the sqlite3_rtree_geometry
+# structure are initialized by SQLite but are not subsequently modified.
+proc box_geom {args} {
+  lappend ::box_geom [concat [lindex $args 0] [lrange $args 2 end-1]]
+  if {[llength $::box_geom]==3} {
+    return "zero"
+  }
+  return ""
+}
+set ::box_geom [list]
+do_catchsql_test 3.2 {
+  SELECT * FROM rt1 WHERE id MATCH box(1,1);
+} {1 {SQL logic error}}
+do_test 3.3 {
+  set ::box_geom
+} [list {*}{
+  {box {1.0 1.0} {0.0 0.0}} 
+  {box {1.0 1.0} {10.0 10.0}} 
+  {box {1.0 1.0} {11.0 11.0}} 
+  {box 0.0 {12.0 12.0}}
+}]
+
+# EVIDENCE-OF: R-31246-29731 The pContext member of the
+# sqlite3_rtree_geometry structure is always set to a copy of the
+# pContext argument passed to sqlite3_rtree_geometry_callback() when the
+# callback is registered.
+reset_db
+do_execsql_test 4.0 {
+  CREATE VIRTUAL TABLE r1 USING rtree(id, minX,maxX, minY,maxY);
+  WITH s(i) AS (
+    VALUES(1) UNION ALL SELECT i+1 FROM s WHERE i<120
+  )
+  INSERT INTO r1 SELECT i,i,i+1,  200,201 FROM s;
+}
+set ctx [register_box_geom db box_geom]
+set ::box_geom [list]
+proc box_geom {args} {
+  lappend ::box_geom [lindex $args 1]
+  return ""
+}
+do_execsql_test 4.1 {
+  SELECT count(*) FROM r1 WHERE id MATCH box(0,150,199,201)
+} 120
+do_test 4.2 {
+  foreach g $::box_geom {
+    if {$g!=$ctx} {error "pointer mismatch"}
+  }
+} {}
+
+# EVIDENCE-OF: R-09904-19077 The aParam[] array (size nParam) contains
+# the parameter values passed to the SQL function on the right-hand side
+# of the MATCH operator.
+proc box_geom {args} {
+  set ::box_geom [lindex $args 2]
+}
+foreach {tn q vals} {
+  1 "SELECT count(*) FROM r1 WHERE id MATCH box(1,2,3)" {1.0 2.0 3.0}
+  2 "SELECT count(*) FROM r1 WHERE id MATCH box(10001)" {10001.0}
+  3 "SELECT count(*) FROM r1 WHERE id MATCH box(-10001)" {-10001.0}
+} {
+  do_catchsql_test 5.$tn.1 $q {1 {SQL logic error}}
+  do_test 5.$tn.2 { set ::box_geom } $vals
+}
+
+do_execsql_test 5.0 {
+  CREATE VIRTUAL TABLE myrtree USING rtree(id, x1,x2);
+  INSERT INTO myrtree VALUES(1, 1, 1);
+  INSERT INTO myrtree VALUES(2, 2, 2);
+  INSERT INTO myrtree VALUES(3, 3, 3);
+}
+
+# EVIDENCE-OF: R-44448-00687 The pUser and xDelUser members of the
+# sqlite3_rtree_geometry structure are initially set to NULL.
+set ::box_geom_calls 0
+proc box_geom {args} {
+  incr ::box_geom_calls
+  return user_is_zero
+}
+do_execsql_test 5.1.1 {
+  SELECT * FROM myrtree WHERE id MATCH box(4, 5);
+} 
+do_test 5.1.2 { set ::box_geom_calls } 3
+
+
+# EVIDENCE-OF: R-55837-00155 The pUser variable may be set by the
+# callback implementation to any arbitrary value that may be useful to
+# subsequent invocations of the callback within the same query (for
+# example, a pointer to a complicated data structure used to test for
+# region intersection).
+#
+# EVIDENCE-OF: R-34745-08839 If the xDelUser variable is set to a
+# non-NULL value, then after the query has finished running SQLite
+# automatically invokes it with the value of the pUser variable as the
+# only argument.
+#
+set ::box_geom_calls 0
+proc box_geom {args} {
+  incr ::box_geom_calls
+  switch -- $::box_geom_calls {
+    1 {
+      return user_is_zero
+    }
+    2 {
+      return [list user box_geom_finalizer]
+    }
+  }
+  return ""
+}
+proc box_geom_finalizer {} {
+  set ::box_geom_finalizer "::box_geom_calls is $::box_geom_calls"
+}
+do_execsql_test 5.1.1 {
+  SELECT * FROM myrtree WHERE id MATCH box(4, 5);
+} 
+do_test 5.1.2 { set ::box_geom_calls } 3
+do_test 5.1.3 {
+  set ::box_geom_finalizer
+} {::box_geom_calls is 3}
+ 
+
+# EVIDENCE-OF: R-28176-28813 The xGeom callback always does a
+# depth-first search of the r-tree.
+#
+# For a breadth first search, final test case would return "B L" only.
+#
+do_execsql_test 6.0 {
+  CREATE VIRTUAL TABLE xyz USING rtree(x, x1,x2, y1,y2);
+  WITH s(i) AS (
+    VALUES(1) UNION ALL SELECT i+1 FROM s WHERE i<15
+  )
+  INSERT INTO xyz SELECT NULL, one.i,one.i+1,  two.i,two.i+1 FROM s one, s two;
+}
+do_execsql_test 6.1 {
+  SELECT count(*) FROM xyz_node
+} {10}
+proc box_geom {args} {
+  set coords [lindex $args 3]
+  set area [expr {
+    ([lindex $coords 1]-[lindex $coords 0]) * 
+    ([lindex $coords 3]-[lindex $coords 2])
+  }]
+  if {$area==1} {
+    lappend ::box_geom_calls L
+  } else {
+    lappend ::box_geom_calls B
+  }
+}
+set ::box_geom_calls [list]
+do_execsql_test 6.2 {
+  SELECT count(*) FROM xyz WHERE x MATCH box(0,20,0,20)
+} 225
+do_test 6.3 {
+  set prev ""
+  set box_calls [list]
+  foreach c $::box_geom_calls {
+    if {$c!=$prev} {
+      lappend ::box_calls $c
+      set prev $c
+    }
+  }
+  set ::box_calls
+} {B L B L B L B L B L B L B L B L B L}
+
+
+finish_test
+