sqlite/ext/rtree/test_rtreedoc.c

/*
** 2010 August 28
**
** 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.
**
*************************************************************************
** Code for testing all sorts of SQLite interfaces. This code
** is not included in the SQLite library. 
*/

#include "sqlite3.h"
#if defined(INCLUDE_SQLITE_TCL_H)
#  include "sqlite_tcl.h"
#else
#  include "tcl.h"
#endif

/* Solely for the UNUSED_PARAMETER() macro. */
#include "sqliteInt.h"

#ifdef SQLITE_ENABLE_RTREE

typedef struct BoxGeomCtx BoxGeomCtx;
struct BoxGeomCtx {
  Tcl_Interp *interp;
  Tcl_Obj *pScript;
};

static void testDelUser(void *pCtx){
  BoxGeomCtx *p = (BoxGeomCtx*)pCtx;
  Tcl_EvalObjEx(p->interp, p->pScript, 0);
  Tcl_DecrRefCount(p->pScript);
  sqlite3_free(p);
}

static int invokeTclGeomCb(
  const char *zName, 
  sqlite3_rtree_geometry *p, 
  int nCoord,
  sqlite3_rtree_dbl *aCoord
){
  int rc = SQLITE_OK;
  if( p->pContext ){
    char aPtr[64];
    BoxGeomCtx *pCtx = (BoxGeomCtx*)p->pContext;
    Tcl_Interp *interp = pCtx->interp;
    Tcl_Obj *pScript = 0;
    Tcl_Obj *pParam = 0;
    Tcl_Obj *pCoord = 0;
    int ii;
    Tcl_Obj *pRes;


    pScript = Tcl_DuplicateObj(pCtx->pScript);
    Tcl_IncrRefCount(pScript);
    Tcl_ListObjAppendElement(interp, pScript, Tcl_NewStringObj(zName,-1));

    sqlite3_snprintf(sizeof(aPtr)-1, aPtr, "%p", (void*)p->pContext);
    Tcl_ListObjAppendElement(interp, pScript, Tcl_NewStringObj(aPtr,-1));

    pParam = Tcl_NewObj();
    for(ii=0; ii<p->nParam; ii++){
      Tcl_ListObjAppendElement(
          interp, pParam, Tcl_NewDoubleObj(p->aParam[ii])
      );
    }
    Tcl_ListObjAppendElement(interp, pScript, pParam);

    pCoord = Tcl_NewObj();
    for(ii=0; ii<nCoord; ii++){
      Tcl_ListObjAppendElement(interp, pCoord, Tcl_NewDoubleObj(aCoord[ii]));
    }
    Tcl_ListObjAppendElement(interp, pScript, pCoord);

    sqlite3_snprintf(sizeof(aPtr)-1, aPtr, "%p", (void*)p);
    Tcl_ListObjAppendElement(interp, pScript, Tcl_NewStringObj(aPtr,-1));

    rc = Tcl_EvalObjEx(interp, pScript, 0);
    if( rc!=TCL_OK ){
      rc = SQLITE_ERROR;
    }else{
      int nObj = 0;
      Tcl_Obj **aObj = 0;

      pRes = Tcl_GetObjResult(interp);
      if( Tcl_ListObjGetElements(interp, pRes, &nObj, &aObj) ) return TCL_ERROR;
      if( nObj>0 ){
        const char *zCmd = Tcl_GetString(aObj[0]);
        if( 0==sqlite3_stricmp(zCmd, "zero") ){
          p->aParam[0] = 0.0;
          p->nParam = 1;
        }
        else if( 0==sqlite3_stricmp(zCmd, "user") ){
          if( p->pUser || p->xDelUser ){
            rc = SQLITE_ERROR;
          }else{
            BoxGeomCtx *pCtx = sqlite3_malloc(sizeof(BoxGeomCtx));
            if( pCtx==0 ){
              rc = SQLITE_NOMEM;
            }else{
              pCtx->interp = interp;
              pCtx->pScript = Tcl_DuplicateObj(pRes);
              Tcl_IncrRefCount(pCtx->pScript);
              Tcl_ListObjReplace(interp, pCtx->pScript, 0, 1, 0, 0);
              p->pUser = (void*)pCtx;
              p->xDelUser = testDelUser;
            }
          }
        }
        else if( 0==sqlite3_stricmp(zCmd, "user_is_zero") ){
          if( p->pUser || p->xDelUser ) rc = SQLITE_ERROR;
        }
      }
    }
  }
  return rc;
}

/*
# EVIDENCE-OF: R-00693-36727 The legacy xGeom callback is invoked with
# four arguments.

# EVIDENCE-OF: R-50437-53270 The first argument is a pointer to an
# 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.

# EVIDENCE-OF: R-28207-40885 The last argument is a pointer into which
# the callback result should be written.

*/
static int box_geom(
  sqlite3_rtree_geometry *p,      /* R-50437-53270 */
  int nCoord,                     /* R-02424-24769 */
  sqlite3_rtree_dbl *aCoord,      /* R-00090-24248 */
  int *pRes                       /* R-28207-40885 */
){
  int ii;

  if( p->nParam!=nCoord ){
    invokeTclGeomCb("box", p, nCoord, aCoord);
    return SQLITE_ERROR;
  }
  if( invokeTclGeomCb("box", p, nCoord, aCoord) ) return SQLITE_ERROR;

  for(ii=0; ii<nCoord; ii+=2){
    if( aCoord[ii]>p->aParam[ii+1] || aCoord[ii+1]<p->aParam[ii] ){
      /* R-28207-40885 */
      *pRes = 0;
      return SQLITE_OK;
    }
  }

  /* R-28207-40885 */
  *pRes = 1;

  return SQLITE_OK;
}

static int SQLITE_TCLAPI register_box_geom(
  void * clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  extern int getDbPointer(Tcl_Interp*, const char*, sqlite3**);
  extern const char *sqlite3ErrName(int);
  sqlite3 *db;
  BoxGeomCtx *pCtx;
  char aPtr[64];

  if( objc!=3 ){
    Tcl_WrongNumArgs(interp, 1, objv, "DB SCRIPT");
    return TCL_ERROR;
  }
  if( getDbPointer(interp, Tcl_GetString(objv[1]), &db) ) return TCL_ERROR;

  pCtx = (BoxGeomCtx*)ckalloc(sizeof(BoxGeomCtx*));
  pCtx->interp = interp;
  pCtx->pScript = Tcl_DuplicateObj(objv[2]);
  Tcl_IncrRefCount(pCtx->pScript);

  sqlite3_rtree_geometry_callback(db, "box", box_geom, (void*)pCtx);

  sqlite3_snprintf(64, aPtr, "%p", (void*)pCtx);
  Tcl_SetObjResult(interp, Tcl_NewStringObj(aPtr, -1));
  return TCL_OK;
}

static int SQLITE_TCLAPI register_box_query(
  void * clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  extern int getDbPointer(Tcl_Interp*, const char*, sqlite3**);
  extern const char *sqlite3ErrName(int);
  sqlite3 *db;

  if( objc!=3 ){
    Tcl_WrongNumArgs(interp, 1, objv, "DB SCRIPT");
    return TCL_ERROR;
  }
  if( getDbPointer(interp, Tcl_GetString(objv[1]), &db) ) return TCL_ERROR;

  return TCL_OK;
}
#endif /* SQLITE_ENABLE_RTREE */


int Sqlitetestrtreedoc_Init(Tcl_Interp *interp){
#ifdef SQLITE_ENABLE_RTREE
  Tcl_CreateObjCommand(interp, "register_box_geom", register_box_geom, 0, 0);
  Tcl_CreateObjCommand(interp, "register_box_query", register_box_query, 0, 0);
#endif /* SQLITE_ENABLE_RTREE */
  return TCL_OK;
}