eda0001d89
FossilOrigin-Name: 54604869861cc5866d5de87785599ca56f75067f8cb7fe22e32912b3a037e37b
350 lines
9.7 KiB
C
350 lines
9.7 KiB
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;
|
|
};
|
|
|
|
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);
|
|
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-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 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,
|
|
int objc,
|
|
Tcl_Obj *CONST objv[]
|
|
){
|
|
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");
|
|
return TCL_ERROR;
|
|
}
|
|
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 */
|
|
|
|
|
|
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;
|
|
}
|
|
|