SQLite

# endif
#endif
/* Compatability between Tcl8.6 and Tcl9.0 */
#if TCL_MAJOR_VERSION==9
# define CONST const
#elif !defined(Tcl_Size)
  typedef int Tcl_Size;
# ifndef Tcl_BounceRefCount
#  define Tcl_BounceRefCount(X) Tcl_IncrRefCount(X); Tcl_DecrRefCount(X)
   /* https://www.tcl-lang.org/man/tcl9.0/TclLib/Object.html */
# endif
#endif
/**** End copy of tclsqlite.h ****/

#include <errno.h>

/*
** Some additional include files are needed if this file is not

      ** happening, make sure pCmd has a valid string representation */
      Tcl_GetString(pCmd);
    }
    rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
    Tcl_DecrRefCount(pCmd);
  }

  if( TCL_BREAK==rc ){
    sqlite3_result_null(context);
  }else if( rc && rc!=TCL_RETURN ){
    sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
  }else{
    Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);
    Tcl_Size n;
    u8 *data;
    const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
    char c = zType[0];
    int eType = p->eType;

    if( eType==SQLITE_NULL ){
      if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
        /* Only return a BLOB type if the Tcl variable is a bytearray and
        ** has no string representation. */
        eType = SQLITE_BLOB;
      }else if( (c=='b' && pVar->bytes==0 && strcmp(zType,"boolean")==0 )
             || (c=='b' && pVar->bytes==0 && strcmp(zType,"booleanString")==0 )
             || (c=='w' && strcmp(zType,"wideInt")==0)
             || (c=='i' && strcmp(zType,"int")==0)
      ){
        eType = SQLITE_INTEGER;
      }else if( c=='d' && strcmp(zType,"double")==0 ){
        eType = SQLITE_FLOAT;
      }else{
        eType = SQLITE_TEXT;
      }

struct DbEvalContext {
  SqliteDb *pDb;                  /* Database handle */
  Tcl_Obj *pSql;                  /* Object holding string zSql */
  const char *zSql;               /* Remaining SQL to execute */
  SqlPreparedStmt *pPreStmt;      /* Current statement */
  int nCol;                       /* Number of columns returned by pStmt */
  int evalFlags;                  /* Flags used */
  Tcl_Obj *pTgtName;              /* Name of target array/dict variable */
  Tcl_Obj **apColName;            /* Array of column names */
};

#define SQLITE_EVAL_WITHOUTNULLS  0x00001  /* Unset array(*) for NULL */
#define SQLITE_EVAL_ASDICT        0x00002  /* Use dict instead of array */

/*
** Release any cache of column names currently held as part of
** the DbEvalContext structure passed as the first argument.
*/
static void dbReleaseColumnNames(DbEvalContext *p){
  if( p->apColName ){
    int i;
    for(i=0; i<p->nCol; i++){
      Tcl_DecrRefCount(p->apColName[i]);
    }
    Tcl_Free((char *)p->apColName);
    p->apColName = 0;
  }
  p->nCol = 0;
}

/*
** Initialize a DbEvalContext structure.
**
** If pTgtName is not NULL, then it contains the name of a Tcl array
** variable. The "*" member of this array is set to a list containing
** the names of the columns returned by the statement as part of each
** call to dbEvalStep(), in order from left to right. e.g. if the names
** of the returned columns are a, b and c, it does the equivalent of the
** tcl command:
**
**     set ${pTgtName}(*) {a b c}
*/
static void dbEvalInit(
  DbEvalContext *p,               /* Pointer to structure to initialize */
  SqliteDb *pDb,                  /* Database handle */
  Tcl_Obj *pSql,                  /* Object containing SQL script */
  Tcl_Obj *pTgtName,              /* Name of Tcl array to set (*) element of */
  int evalFlags                   /* Flags controlling evaluation */
){
  memset(p, 0, sizeof(DbEvalContext));
  p->pDb = pDb;
  p->zSql = Tcl_GetString(pSql);
  p->pSql = pSql;
  Tcl_IncrRefCount(pSql);
  if( pTgtName ){
    p->pTgtName = pTgtName;
    Tcl_IncrRefCount(pTgtName);
  }
  p->evalFlags = evalFlags;
  addDatabaseRef(p->pDb);
}

/*
** Obtain information about the row that the DbEvalContext passed as the

  if( 0==p->apColName ){
    sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
    int i;                        /* Iterator variable */
    int nCol;                     /* Number of columns returned by pStmt */
    Tcl_Obj **apColName = 0;      /* Array of column names */

    p->nCol = nCol = sqlite3_column_count(pStmt);
    if( nCol>0 && (papColName || p->pTgtName) ){
      apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol );
      for(i=0; i<nCol; i++){
        apColName[i] = Tcl_NewStringObj(sqlite3_column_name(pStmt,i), -1);
        Tcl_IncrRefCount(apColName[i]);
      }
      p->apColName = apColName;
    }

    /* If results are being stored in a variable then create the
    ** array(*) or dict(*) entry for that variable.
    */
    if( p->pTgtName ){
      Tcl_Interp *interp = p->pDb->interp;
      Tcl_Obj *pColList = Tcl_NewObj();
      Tcl_Obj *pStar = Tcl_NewStringObj("*", -1);

      Tcl_IncrRefCount(pColList);
      Tcl_IncrRefCount(pStar);
      for(i=0; i<nCol; i++){
        Tcl_ListObjAppendElement(interp, pColList, apColName[i]);
      }
      if( 0==(SQLITE_EVAL_ASDICT & p->evalFlags) ){
        Tcl_ObjSetVar2(interp, p->pTgtName, pStar, pColList, 0);
      }else{
        Tcl_Obj * pDict = Tcl_ObjGetVar2(interp, p->pTgtName, NULL, 0);
        if( !pDict ){
          pDict = Tcl_NewDictObj();
        }else if( Tcl_IsShared(pDict) ){
          pDict = Tcl_DuplicateObj(pDict);
        }
        if( Tcl_DictObjPut(interp, pDict, pStar, pColList)==TCL_OK ){
          Tcl_ObjSetVar2(interp, p->pTgtName, NULL, pDict, 0);
        }
        Tcl_BounceRefCount(pDict);
      }
      Tcl_DecrRefCount(pStar);
      Tcl_DecrRefCount(pColList);
    }
  }

  if( papColName ){
    *papColName = p->apColName;
  }
  if( pnCol ){

      SqlPreparedStmt *pPreStmt = p->pPreStmt;
      sqlite3_stmt *pStmt = pPreStmt->pStmt;

      rcs = sqlite3_step(pStmt);
      if( rcs==SQLITE_ROW ){
        return TCL_OK;
      }
      if( p->pTgtName ){
        dbEvalRowInfo(p, 0, 0);
      }
      rcs = sqlite3_reset(pStmt);

      pDb->nStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_FULLSCAN_STEP,1);
      pDb->nSort = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_SORT,1);
      pDb->nIndex = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_AUTOINDEX,1);

*/
static void dbEvalFinalize(DbEvalContext *p){
  if( p->pPreStmt ){
    sqlite3_reset(p->pPreStmt->pStmt);
    dbReleaseStmt(p->pDb, p->pPreStmt, 0);
    p->pPreStmt = 0;
  }
  if( p->pTgtName ){
    Tcl_DecrRefCount(p->pTgtName);
    p->pTgtName = 0;
  }
  Tcl_DecrRefCount(p->pSql);
  dbReleaseColumnNames(p);
  delDatabaseRef(p->pDb);
}

/*

# define Tcl_NREvalObj(a,b,c) 0
# define Tcl_NRCreateCommand(a,b,c,d,e,f) (void)0
#endif

/*
** This function is part of the implementation of the command:
**
**   $db eval SQL ?TGT-NAME? SCRIPT
*/
static int SQLITE_TCLAPI DbEvalNextCmd(
  ClientData data[],                   /* data[0] is the (DbEvalContext*) */
  Tcl_Interp *interp,                  /* Tcl interpreter */
  int result                           /* Result so far */
){
  int rc = result;                     /* Return code */

  /* The first element of the data[] array is a pointer to a DbEvalContext
  ** structure allocated using Tcl_Alloc(). The second element of data[]
  ** is a pointer to a Tcl_Obj containing the script to run for each row
  ** returned by the queries encapsulated in data[0]. */
  DbEvalContext *p = (DbEvalContext *)data[0];
  Tcl_Obj * const pScript = (Tcl_Obj *)data[1];
  Tcl_Obj * const pTgtName = p->pTgtName;

  while( (rc==TCL_OK || rc==TCL_CONTINUE) && TCL_OK==(rc = dbEvalStep(p)) ){
    int i;
    int nCol;
    Tcl_Obj **apColName;
    dbEvalRowInfo(p, &nCol, &apColName);
    for(i=0; i<nCol; i++){
      if( pTgtName==0 ){
        Tcl_ObjSetVar2(interp, apColName[i], 0, dbEvalColumnValue(p,i), 0);
      }else if( (p->evalFlags & SQLITE_EVAL_WITHOUTNULLS)!=0
             && sqlite3_column_type(p->pPreStmt->pStmt, i)==SQLITE_NULL
      ){
        /* Remove NULL-containing column from the target container... */
        if( 0==(SQLITE_EVAL_ASDICT & p->evalFlags) ){
          /* Target is an array */
          Tcl_UnsetVar2(interp, Tcl_GetString(pTgtName),
                        Tcl_GetString(apColName[i]), 0);
        }else{
          /* Target is a dict */
          Tcl_Obj *pDict = Tcl_ObjGetVar2(interp, pTgtName, NULL, 0);
          if( pDict ){
            if( Tcl_IsShared(pDict) ){
              pDict = Tcl_DuplicateObj(pDict);
            }
            if( Tcl_DictObjRemove(interp, pDict, apColName[i])==TCL_OK ){
              Tcl_ObjSetVar2(interp, pTgtName, NULL, pDict, 0);
            }
            Tcl_BounceRefCount(pDict);
          }
        }
      }else if( 0==(SQLITE_EVAL_ASDICT & p->evalFlags) ){
        /* Target is an array: set target(colName) = colValue */
        Tcl_ObjSetVar2(interp, pTgtName, apColName[i],
                       dbEvalColumnValue(p,i), 0);
      }else{
        /* Target is a dict: set target(colName) = colValue */
        Tcl_Obj *pDict = Tcl_ObjGetVar2(interp, pTgtName, NULL, 0);
        if( !pDict ){
          pDict = Tcl_NewDictObj();
        }else if( Tcl_IsShared(pDict) ){
          pDict = Tcl_DuplicateObj(pDict);
        }
        if( Tcl_DictObjPut(interp, pDict, apColName[i],
                           dbEvalColumnValue(p,i))==TCL_OK ){
          Tcl_ObjSetVar2(interp, pTgtName, NULL, pDict, 0);
        }
        Tcl_BounceRefCount(pDict);
      }
    }

    /* The required interpreter variables are now populated with the data
    ** from the current row. If using NRE, schedule callbacks to evaluate
    ** script pScript, then to invoke this function again to fetch the next
    ** row (or clean up if there is no next row or the script throws an

    "interrupt",              "last_insert_rowid",     "nullvalue",
    "onecolumn",              "preupdate",             "profile",
    "progress",               "rekey",                 "restore",
    "rollback_hook",          "serialize",             "status",
    "timeout",                "total_changes",         "trace",
    "trace_v2",               "transaction",           "unlock_notify",
    "update_hook",            "version",               "wal_hook",
    0
  };
  enum DB_enum {
    DB_AUTHORIZER,            DB_BACKUP,               DB_BIND_FALLBACK,
    DB_BUSY,                  DB_CACHE,                DB_CHANGES,
    DB_CLOSE,                 DB_COLLATE,              DB_COLLATION_NEEDED,
    DB_COMMIT_HOOK,           DB_COMPLETE,             DB_CONFIG,
    DB_COPY,                  DB_DESERIALIZE,          DB_ENABLE_LOAD_EXTENSION,

    if( rc==TCL_BREAK ){
      rc = TCL_OK;
    }
    break;
  }

  /*
  **    $db eval ?options? $sql ?varName? ?{  ...code... }?
  **
  ** The SQL statement in $sql is evaluated.  For each row, the values
  ** are placed in elements of the array or dict named $varName and
  ** ...code... is executed.  If $varName and $code are omitted, then
  ** no callback is ever invoked.  If $varName is an empty string,
  ** then the values are placed in variables that have the same name
  ** as the fields extracted by the query, and those variables are
  ** accessible during the eval of $code.
  */
  case DB_EVAL: {
    int evalFlags = 0;
    const char *zOpt;
    while( objc>3 && (zOpt = Tcl_GetString(objv[2]))!=0 && zOpt[0]=='-' ){
      if( strcmp(zOpt, "-withoutnulls")==0 ){
        evalFlags |= SQLITE_EVAL_WITHOUTNULLS;
      }else if( strcmp(zOpt, "-asdict")==0 ){
        evalFlags |= SQLITE_EVAL_ASDICT;
      }else{
        Tcl_AppendResult(interp, "unknown option: \"", zOpt, "\"", (void*)0);
        return TCL_ERROR;
      }
      objc--;
      objv++;
    }
    if( objc<3 || objc>5 ){
      Tcl_WrongNumArgs(interp, 2, objv,
          "?OPTIONS? SQL ?VAR-NAME? ?SCRIPT?");
      return TCL_ERROR;
    }

    if( objc==3 ){
      DbEvalContext sEval;
      Tcl_Obj *pRet = Tcl_NewObj();
      Tcl_IncrRefCount(pRet);

        Tcl_SetObjResult(interp, pRet);
        rc = TCL_OK;
      }
      Tcl_DecrRefCount(pRet);
    }else{
      ClientData cd2[2];
      DbEvalContext *p;
      Tcl_Obj *pTgtName = 0;
      Tcl_Obj *pScript;

      if( objc>=5 && *(char *)Tcl_GetString(objv[3]) ){
        pTgtName = objv[3];
      }
      pScript = objv[objc-1];
      Tcl_IncrRefCount(pScript);

      p = (DbEvalContext *)Tcl_Alloc(sizeof(DbEvalContext));
      dbEvalInit(p, pDb, objv[2], pTgtName, evalFlags);

      cd2[0] = (void *)p;
      cd2[1] = (void *)pScript;
      rc = DbEvalNextCmd(cd2, interp, TCL_OK);
    }
    break;
  }

# 2001 September 15
#
# 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.
#
#***********************************************************************
# This file implements regression tests for TCL interface to the
# SQLite library.
#
# Actually, all tests are based on the TCL interface, so the main
# interface is pretty well tested.  This file contains some addition
# tests for fringe issues that the main test suite does not cover.
#
# $Id: tclsqlite.test,v 1.73 2009/03/16 13:19:36 danielk1977 Exp $

    set v [catch {db complete} msg]
    lappend v $msg
  } {1 {wrong # args: should be "db complete SQL"}}
}
do_test tcl-1.14 {
  set v [catch {db eval} msg]
  lappend v $msg
} {1 {wrong # args: should be "db eval ?OPTIONS? SQL ?VAR-NAME? ?SCRIPT?"}}
do_test tcl-1.15 {
  set v [catch {db function} msg]
  lappend v $msg
} {1 {wrong # args: should be "db function NAME ?SWITCHES? SCRIPT"}}
do_test tcl-1.16 {
  set v [catch {db last_insert_rowid xyz} msg]
  lappend v $msg

  db function ret_dbl {return [expr {rand()*0.5}]}
  execsql {SELECT typeof(ret_dbl())}
} {real}
do_test tcl-9.3 {
  db function ret_int {return [expr {int(rand()*200)}]}
  execsql {SELECT typeof(ret_int())}
} {integer}
proc breakAsNullUdf args {
  if {"1" eq [lindex $args 0]} {return -code break}
}
do_test tcl-9.4 {
  db function banu breakAsNullUdf
  execsql {SELECT typeof(banu()), typeof(banu(1))}
} {text null}
do_test tcl-9.5 {
  db nullvalue banunull
  db eval {SELECT banu(), banu(1)}
} {{} banunull}


# Recursive calls to the same user-defined function
#
ifcapable tclvar {
  do_test tcl-9.10 {
    proc userfunc_r1 {n} {
      if {$n<=0} {return 0}

    }
  }]
} {2}
do_test tcl-10.13 {
  db eval {SELECT * FROM t4}
} {1 2 5 6 7}

# Now test that [db transaction] commands may be nested with
# the expected results.
#
do_test tcl-10.14 {
  db transaction {
    db eval {
      DELETE FROM t4;
      INSERT INTO t4 VALUES('one');
    }

    catch {
      db transaction {
        db eval { INSERT INTO t4 VALUES('two') }
        db transaction {
          db eval { INSERT INTO t4 VALUES('three') }
          error "throw an error!"
        }
      }

  db exists {SELECT a FROM t1 WHERE a>2}
} {1}
do_test tcl-15.5 {
  db exists {SELECT a FROM t1 WHERE a>3}
} {0}


# 2017-06-26: The -withoutnulls flag to "db eval".
#
# In the "db eval -withoutnulls SQL TARGET" form, NULL results cause the
# corresponding target entry to be unset.  The default behavior (without
# the -withoutnulls flags) is for the corresponding target value to get
# the [db nullvalue] string.
#
catch {db close}
forcedelete test.db
sqlite3 db test.db
do_execsql_test tcl-16.100 {
  CREATE TABLE t1(a,b);

#-------------------------------------------------------------------------
# Test the -type option to [db function].
#
reset_db
proc add {a b} { return [expr $a + $b] }
proc ret {a} { return $a }

db function add_i -returntype integer add
db function add_r -ret        real    add
db function add_t -return     text    add
db function add_b -returntype blob    add
db function add_a -returntype any     add

db function ret_i -returntype int     ret
db function ret_r -returntype real    ret
db function ret_t -returntype text    ret
db function ret_b -returntype blob    ret
db function ret_a -r          any     ret

do_execsql_test 17.0 {
  SELECT quote( add_i(2, 3) );
  SELECT quote( add_r(2, 3) );
  SELECT quote( add_t(2, 3) );
  SELECT quote( add_b(2, 3) );
  SELECT quote( add_a(2, 3) );
} {5 5.0 '5' X'35' 5}

do_execsql_test 17.1 {
  SELECT quote( add_i(2.2, 3.3) );
  SELECT quote( add_r(2.2, 3.3) );
  SELECT quote( add_t(2.2, 3.3) );
  SELECT quote( add_b(2.2, 3.3) );
  SELECT quote( add_a(2.2, 3.3) );
} {5.5 5.5 '5.5' X'352E35' 5.5}

do_execsql_test 17.2 {
  SELECT quote( ret_i(2.5) );
  SELECT quote( ret_r(2.5) );
  SELECT quote( ret_t(2.5) );
  SELECT quote( ret_b(2.5) );
  SELECT quote( ret_a(2.5) );
} {2.5 2.5 '2.5' X'322E35' 2.5}

do_execsql_test 17.3 {
  SELECT quote( ret_i('2.5') );
  SELECT quote( ret_r('2.5') );
  SELECT quote( ret_t('2.5') );
  SELECT quote( ret_b('2.5') );
  SELECT quote( ret_a('2.5') );
} {2.5 2.5 '2.5' X'322E35' '2.5'}

do_execsql_test 17.4 {
  SELECT quote( ret_i('abc') );
  SELECT quote( ret_r('abc') );
  SELECT quote( ret_t('abc') );
  SELECT quote( ret_b('abc') );
  SELECT quote( ret_a('abc') );
} {'abc' 'abc' 'abc' X'616263' 'abc'}

do_execsql_test 17.5 {
  SELECT quote( ret_i(X'616263') );
  SELECT quote( ret_r(X'616263') );
  SELECT quote( ret_t(X'616263') );
  SELECT quote( ret_b(X'616263') );
  SELECT quote( ret_a(X'616263') );
} {'abc' 'abc' 'abc' X'616263' X'616263'}

do_test 17.6.1 {
  list [catch { db function xyz -return object ret } msg] $msg
} {1 {bad type "object": must be integer, real, text, blob, or any}}

do_test 17.6.2 {

  db bind_fallback bind_fallback_does_not_exist
} {}
do_catchsql_test 19.911 {
  SELECT $abc, typeof($abc), $def, typeof($def), $ghi, typeof($ghi);
} {1 {invalid command name "bind_fallback_does_not_exist"}}
db bind_fallback {}

# 2025-05-05: the -asdict eval flag
#
do_test 20.0 {
  execsql {CREATE TABLE tad(a,b)}
  execsql {INSERT INTO tad(a,b) VALUES('aa','bb'),('AA','BB')}
  db eval -asdict {
    SELECT a, b FROM tad WHERE 0
  } D {}
  set D
} {* {a b}}
do_test 20.1 {
  unset D
  set i 0
  set res {}
  set colNames {}
  db eval -asdict {
    SELECT a, b FROM tad ORDER BY a
  } D {
    dict set D i [incr i]
    lappend res $i [dict get $D a] [dict get $D b]
    if {1 == $i} {
      set colNames [dict get $D *]
    }
  }
  lappend res $colNames
  unset D
  set res
} {1 AA BB 2 aa bb {a b}}
do_test 20.2 {
  set res {}
  db eval -asdict -withoutnulls {
    SELECT n, a, b FROM (
      SELECT 1 as n, 'aa' as a, NULL as b
      UNION ALL
      SELECT 2 as n, NULL as a, 'bb' as b
    )
    ORDER BY n
  } D {
    dict unset D *
    lappend res [dict values $D]
  }
  unset D
  execsql {DROP TABLE tad}
  set res
} {{1 aa} {2 bb}}

#-------------------------------------------------------------------------
do_test 21.0 {
  db transaction {
    db close
  }
} {}

do_test 21.1 {
  sqlite3 db test.db
  set rc [catch {
    db eval {SELECT 1 UNION ALL SELECT 2 UNION ALL SELECT 3} { db close }
  } msg]
  list $rc $msg
} {1 {invalid command name "db"}}



proc closedb {} {
  db close
  return 10
}
proc func1 {} { return 1 }

sqlite3 db test.db
db func closedb closedb
db func func1 func1

do_test 21.2 {
  set rc [catch {
    db eval {
      SELECT closedb(),func1() UNION ALL SELECT 20,30 UNION ALL SELECT 30,40
    }
  } msg]
  list $rc $msg
} {0 {10 1 20 30 30 40}}

sqlite3 db :memory:
do_test 22.1 {
  catch {db eval {SELECT 1 2 3;}} msg
  db erroroffset
} {9}


finish_test