/ Check-in [9bf64b66]
Login

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

Overview
Comment:Fix the TCL interface so that SQL functions implemented in TCL honor the "nullvalue" setting. Also remove from the TCL interface some unused legacy UTF8 translation code left over from SQLite2.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | branch-3.7.14
Files: files | file ages | folders
SHA1:9bf64b6612c243ea66d04f502dc23f875ad45cd8
User & Date: drh 2012-10-03 11:11:01
Context
2012-10-04
15:36
Increase the version number to 3.7.14.1. The version of autoconf used is different from the previous release so there are huge differences in the generated "configure" script. check-in: 972dbd5f user: drh tags: branch-3.7.14
2012-10-03
11:11
Fix the TCL interface so that SQL functions implemented in TCL honor the "nullvalue" setting. Also remove from the TCL interface some unused legacy UTF8 translation code left over from SQLite2. check-in: 9bf64b66 user: drh tags: branch-3.7.14
2012-10-02
23:26
Work around an optimization issue with the MSVC compiler for ARM. check-in: 9fab9edd user: drh tags: branch-3.7.14
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

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}