# 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