Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes to src/tclsqlite.c.

    49     49   #undef TCL_STORAGE_CLASS
    50     50   #define TCL_STORAGE_CLASS DLLEXPORT
    51     51   #endif /* BUILD_sqlite */
    52     52   
    53     53   #define NUM_PREPARED_STMTS 10
    54     54   #define MAX_PREPARED_STMTS 100
    55     55   
    56         -/*
    57         -** If TCL uses UTF-8 and SQLite is configured to use iso8859, then we
    58         -** have to do a translation when going between the two.  Set the 
    59         -** UTF_TRANSLATION_NEEDED macro to indicate that we need to do
    60         -** this translation.  
    61         -*/
    62         -#if defined(TCL_UTF_MAX) && !defined(SQLITE_UTF8)
    63         -# define UTF_TRANSLATION_NEEDED 1
    64         -#endif
           56  +/* Forward declaration */
           57  +typedef struct SqliteDb SqliteDb;
    65     58   
    66     59   /*
    67     60   ** New SQL functions can be created as TCL scripts.  Each such function
    68     61   ** is described by an instance of the following structure.
    69     62   */
    70     63   typedef struct SqlFunc SqlFunc;
    71     64   struct SqlFunc {
    72     65     Tcl_Interp *interp;   /* The TCL interpret to execute the function */
    73     66     Tcl_Obj *pScript;     /* The Tcl_Obj representation of the script */
           67  +  SqliteDb *pDb;        /* Database connection that owns this function */
    74     68     int useEvalObjv;      /* True if it is safe to use Tcl_EvalObjv */
    75     69     char *zName;          /* Name of this function */
    76     70     SqlFunc *pNext;       /* Next function on the list of them all */
    77     71   };
    78     72   
    79     73   /*
    80     74   ** New collation sequences function can be created as TCL scripts.  Each such
................................................................................
   109    103   ** that has been opened by the SQLite TCL interface.
   110    104   **
   111    105   ** If this module is built with SQLITE_TEST defined (to create the SQLite
   112    106   ** testfixture executable), then it may be configured to use either
   113    107   ** sqlite3_prepare_v2() or sqlite3_prepare() to prepare SQL statements.
   114    108   ** If SqliteDb.bLegacyPrepare is true, sqlite3_prepare() is used.
   115    109   */
   116         -typedef struct SqliteDb SqliteDb;
   117    110   struct SqliteDb {
   118    111     sqlite3 *db;               /* The "real" database structure. MUST BE FIRST */
   119    112     Tcl_Interp *interp;        /* The interpreter used for this database */
   120    113     char *zBusy;               /* The busy callback routine */
   121    114     char *zCommit;             /* The commit hook callback routine */
   122    115     char *zTrace;              /* The trace callback routine */
   123    116     char *zProfile;            /* The profile callback routine */
................................................................................
   427    420     for(p=pDb->pFunc; p; p=p->pNext){ 
   428    421       if( strcmp(p->zName, pNew->zName)==0 ){
   429    422         Tcl_Free((char*)pNew);
   430    423         return p;
   431    424       }
   432    425     }
   433    426     pNew->interp = pDb->interp;
          427  +  pNew->pDb = pDb;
   434    428     pNew->pScript = 0;
   435    429     pNew->pNext = pDb->pFunc;
   436    430     pDb->pFunc = pNew;
   437    431     return pNew;
   438    432   }
   439    433   
   440    434   /*
................................................................................
   474    468     SqliteDb *pDb = (SqliteDb*)db;
   475    469     flushStmtCache(pDb);
   476    470     closeIncrblobChannels(pDb);
   477    471     sqlite3_close(pDb->db);
   478    472     while( pDb->pFunc ){
   479    473       SqlFunc *pFunc = pDb->pFunc;
   480    474       pDb->pFunc = pFunc->pNext;
          475  +    assert( pFunc->pDb==pDb );
   481    476       Tcl_DecrRefCount(pFunc->pScript);
   482    477       Tcl_Free((char*)pFunc);
   483    478     }
   484    479     while( pDb->pCollate ){
   485    480       SqlCollate *pCollate = pDb->pCollate;
   486    481       pDb->pCollate = pCollate->pNext;
   487    482       Tcl_Free((char*)pCollate);
................................................................................
   790    785           }
   791    786           case SQLITE_FLOAT: {
   792    787             double r = sqlite3_value_double(pIn);
   793    788             pVal = Tcl_NewDoubleObj(r);
   794    789             break;
   795    790           }
   796    791           case SQLITE_NULL: {
   797         -          pVal = Tcl_NewStringObj("", 0);
          792  +          pVal = Tcl_NewStringObj(p->pDb->zNull, -1);
   798    793             break;
   799    794           }
   800    795           default: {
   801    796             int bytes = sqlite3_value_bytes(pIn);
   802    797             pVal = Tcl_NewStringObj((char *)sqlite3_value_text(pIn), bytes);
   803    798             break;
   804    799           }
................................................................................
   929    924     }else{
   930    925       rc = 999;
   931    926     }
   932    927     return rc;
   933    928   }
   934    929   #endif /* SQLITE_OMIT_AUTHORIZATION */
   935    930   
   936         -/*
   937         -** zText is a pointer to text obtained via an sqlite3_result_text()
   938         -** or similar interface. This routine returns a Tcl string object, 
   939         -** reference count set to 0, containing the text. If a translation
   940         -** between iso8859 and UTF-8 is required, it is preformed.
   941         -*/
   942         -static Tcl_Obj *dbTextToObj(char const *zText){
   943         -  Tcl_Obj *pVal;
   944         -#ifdef UTF_TRANSLATION_NEEDED
   945         -  Tcl_DString dCol;
   946         -  Tcl_DStringInit(&dCol);
   947         -  Tcl_ExternalToUtfDString(NULL, zText, -1, &dCol);
   948         -  pVal = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
   949         -  Tcl_DStringFree(&dCol);
   950         -#else
   951         -  pVal = Tcl_NewStringObj(zText, -1);
   952         -#endif
   953         -  return pVal;
   954         -}
   955         -
   956    931   /*
   957    932   ** This routine reads a line of text from FILE in, stores
   958    933   ** the text in memory obtained from malloc() and returns a pointer
   959    934   ** to the text.  NULL is returned at end of file, or if malloc()
   960    935   ** fails.
   961    936   **
   962    937   ** The interface is like "readline" but no command-line editing
................................................................................
  1136   1111     
  1137   1112     /* If no prepared statement was found. Compile the SQL text. Also allocate
  1138   1113     ** a new SqlPreparedStmt structure.  */
  1139   1114     if( pPreStmt==0 ){
  1140   1115       int nByte;
  1141   1116   
  1142   1117       if( SQLITE_OK!=dbPrepare(pDb, zSql, &pStmt, pzOut) ){
  1143         -      Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
         1118  +      Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
  1144   1119         return TCL_ERROR;
  1145   1120       }
  1146   1121       if( pStmt==0 ){
  1147   1122         if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){
  1148   1123           /* A compile-time error in the statement. */
  1149         -        Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
         1124  +        Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
  1150   1125           return TCL_ERROR;
  1151   1126         }else{
  1152   1127           /* The statement was a no-op.  Continue to the next statement
  1153   1128           ** in the SQL string.
  1154   1129           */
  1155   1130           return TCL_OK;
  1156   1131         }
................................................................................
  1361   1336       int nCol;                     /* Number of columns returned by pStmt */
  1362   1337       Tcl_Obj **apColName = 0;      /* Array of column names */
  1363   1338   
  1364   1339       p->nCol = nCol = sqlite3_column_count(pStmt);
  1365   1340       if( nCol>0 && (papColName || p->pArray) ){
  1366   1341         apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol );
  1367   1342         for(i=0; i<nCol; i++){
  1368         -        apColName[i] = dbTextToObj(sqlite3_column_name(pStmt,i));
         1343  +        apColName[i] = Tcl_NewStringObj(sqlite3_column_name(pStmt,i), -1);
  1369   1344           Tcl_IncrRefCount(apColName[i]);
  1370   1345         }
  1371   1346         p->apColName = apColName;
  1372   1347       }
  1373   1348   
  1374   1349       /* If results are being stored in an array variable, then create
  1375   1350       ** the array(*) entry for that array
................................................................................
  1448   1423             ** interface, retry prepare()/step() on the same SQL statement.
  1449   1424             ** This only happens once. If there is a second SQLITE_SCHEMA
  1450   1425             ** error, the error will be returned to the caller. */
  1451   1426             p->zSql = zPrevSql;
  1452   1427             continue;
  1453   1428           }
  1454   1429   #endif
  1455         -        Tcl_SetObjResult(pDb->interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
         1430  +        Tcl_SetObjResult(pDb->interp,
         1431  +                         Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
  1456   1432           return TCL_ERROR;
  1457   1433         }else{
  1458   1434           dbReleaseStmt(pDb, pPreStmt, 0);
  1459   1435         }
  1460   1436       }
  1461   1437     }
  1462   1438   
................................................................................
  1505   1481           return Tcl_NewWideIntObj(v);
  1506   1482         }
  1507   1483       }
  1508   1484       case SQLITE_FLOAT: {
  1509   1485         return Tcl_NewDoubleObj(sqlite3_column_double(pStmt, iCol));
  1510   1486       }
  1511   1487       case SQLITE_NULL: {
  1512         -      return dbTextToObj(p->pDb->zNull);
         1488  +      return Tcl_NewStringObj(p->pDb->zNull, -1);
  1513   1489       }
  1514   1490     }
  1515   1491   
  1516         -  return dbTextToObj((char *)sqlite3_column_text(pStmt, iCol));
         1492  +  return Tcl_NewStringObj(sqlite3_column_text(pStmt, iCol), -1);
  1517   1493   }
  1518   1494   
  1519   1495   /*
  1520   1496   ** If using Tcl version 8.6 or greater, use the NR functions to avoid
  1521   1497   ** recursive evalution of scripts by the [db eval] and [db trans]
  1522   1498   ** commands. Even if the headers used while compiling the extension
  1523   1499   ** are 8.6 or newer, the code still tests the Tcl version at runtime.
................................................................................
  2429   2405           pDb->zNull = Tcl_Alloc( len + 1 );
  2430   2406           memcpy(pDb->zNull, zNull, len);
  2431   2407           pDb->zNull[len] = '\0';
  2432   2408         }else{
  2433   2409           pDb->zNull = 0;
  2434   2410         }
  2435   2411       }
  2436         -    Tcl_SetObjResult(interp, dbTextToObj(pDb->zNull));
         2412  +    Tcl_SetObjResult(interp, Tcl_NewStringObj(pDb->zNull, -1));
  2437   2413       break;
  2438   2414     }
  2439   2415   
  2440   2416     /*
  2441   2417     **     $db last_insert_rowid 
  2442   2418     **
  2443   2419     ** Return an integer which is the ROWID for the most recent insert.

Changes to test/tclsqlite.test.

   315    315   # modify and reset the NULL representation
   316    316   #
   317    317   do_test tcl-8.1 {
   318    318     db nullvalue NaN
   319    319     execsql {INSERT INTO t1 VALUES(30,NULL)}
   320    320     db eval {SELECT * FROM t1 WHERE b IS NULL}
   321    321   } {30 NaN}
          322  +proc concatFunc args {return [join $args {}]}
   322    323   do_test tcl-8.2 {
          324  +  db function concat concatFunc
          325  +  db eval {SELECT concat('a', b, 'z') FROM t1 WHERE b is NULL}
          326  +} {aNaNz}
          327  +do_test tcl-8.3 {
   323    328     db nullvalue NULL
   324    329     db nullvalue
   325    330   } {NULL}
   326         -do_test tcl-8.3 {
          331  +do_test tcl-8.4 {
   327    332     db nullvalue {}
   328    333     db eval {SELECT * FROM t1 WHERE b IS NULL}
   329    334   } {30 {}}
          335  +do_test tcl-8.5 {
          336  +  db function concat concatFunc
          337  +  db eval {SELECT concat('a', b, 'z') FROM t1 WHERE b is NULL}
          338  +} {az}
   330    339   
   331    340   # Test the return type of user-defined functions
   332    341   #
   333    342   do_test tcl-9.1 {
   334    343     db function ret_str {return "hi"}
   335    344     execsql {SELECT typeof(ret_str())}
   336    345   } {text}