SQLite

Check-in [6f7d55aced]
Login

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

Overview
Comment:Change the TCL bindings so that @aaa always treats the variable aaa as a bytearray and binds the value as a BLOB. This change is backwards compatible since the $ behavior is unchanged and @ was not accepted until the current round of changes. (CVS 4094)
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 6f7d55acedc92eeaf988425c719addd56209187f
User & Date: drh 2007-06-19 23:01:42.000
Context
2007-06-20
06:23
Fix snippet generation when the left-most column of an fts2 table is used in the MATCH clause. Fix for ticket #2429. (CVS 4095) (check-in: fec56ad2ed user: danielk1977 tags: trunk)
2007-06-19
23:01
Change the TCL bindings so that @aaa always treats the variable aaa as a bytearray and binds the value as a BLOB. This change is backwards compatible since the $ behavior is unchanged and @ was not accepted until the current round of changes. (CVS 4094) (check-in: 6f7d55aced user: drh tags: trunk)
17:48
Cleanup the TCL interface source code and add documentation for recently added methods on the SQLite object of TCL. (CVS 4093) (check-in: d88b79818a user: drh tags: trunk)
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/tclsqlite.c.
︙︙
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

**    May you find forgiveness for yourself and forgive others.
**    May you share freely, never taking more than you give.
**
*************************************************************************
** A TCL Interface to SQLite.  Append this file to sqlite3.c and
** compile the whole thing to build a TCL-enabled version of SQLite.
**
** $Id: tclsqlite.c,v 1.191 2007/06/19 17:48:57 drh Exp $
*/
#include "tcl.h"
#include <errno.h>

/*
** Some additional include files are needed if this file is not
** appended to the amalgamation.








|








8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

**    May you find forgiveness for yourself and forgive others.
**    May you share freely, never taking more than you give.
**
*************************************************************************
** A TCL Interface to SQLite.  Append this file to sqlite3.c and
** compile the whole thing to build a TCL-enabled version of SQLite.
**
** $Id: tclsqlite.c,v 1.192 2007/06/19 23:01:42 drh Exp $
*/
#include "tcl.h"
#include <errno.h>

/*
** Some additional include files are needed if this file is not
** appended to the amalgamation.
︙︙
1589
1590
1591
1592
1593
1594
1595

1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606

        if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){
          Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0);
          if( pVar ){
            int n;
            u8 *data;
            char *zType = pVar->typePtr ? pVar->typePtr->name : "";
            char c = zType[0];

            if( c=='b' && strcmp(zType,"bytearray")==0 
                 && (pVar->bytes==0 || zVar[0]=='@') ){
              /* Only load a BLOB type if the Tcl variable is a bytearray and
              ** either it has no string representation or the host
              ** parameter name begins with "@". */
              data = Tcl_GetByteArrayFromObj(pVar, &n);
              sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC);
              Tcl_IncrRefCount(pVar);
              apParm[nParm++] = pVar;
            }else if( (c=='b' && strcmp(zType,"boolean")==0) ||
                  (c=='i' && strcmp(zType,"int")==0) ){








>
|
<
|
|








1589
1590
1591
1592
1593
1594
1595
1596
1597

1598
1599
1600
1601
1602
1603
1604
1605
1606

        if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){
          Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0);
          if( pVar ){
            int n;
            u8 *data;
            char *zType = pVar->typePtr ? pVar->typePtr->name : "";
            char c = zType[0];
            if( zVar[0]=='@' ||
               (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){

              /* Load a BLOB type if the Tcl variable is a bytearray and
              ** it has no string representation or the host
              ** parameter name begins with "@". */
              data = Tcl_GetByteArrayFromObj(pVar, &n);
              sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC);
              Tcl_IncrRefCount(pVar);
              apParm[nParm++] = pVar;
            }else if( (c=='b' && strcmp(zType,"boolean")==0) ||
                  (c=='i' && strcmp(zType,"int")==0) ){
︙︙
Changes to test/tclsqlite.test.
︙︙
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

# 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.58 2007/06/19 17:15:47 drh Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {








|








11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

# 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.59 2007/06/19 23:01:42 drh Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {
︙︙
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483






484



485

  set version [db version]
  scan $version "%d.%d.%d" a b c
  expr $a*1000000 + $b*1000 + $c
} [sqlite3_libversion_number]


# Check to see that when bindings of the form @aaa are used instead
# of $aaa, that objects with a bytearray representation are inserted
# as BLOBs even if they also have a string representation.
#
do_test tcl-13.1 {
  db eval {CREATE TABLE t5(x BLOB)}
  set x abc123
  db eval {INSERT INTO t5 VALUES($x)}
  db eval {SELECT typeof(x) FROM t5}
} {text}
do_test tcl-13.2 {
  binary scan $x H notUsed
  db eval {
    DELETE FROM t5;
    INSERT INTO t5 VALUES($x);
    SELECT typeof(x) FROM t5;
  }
} {text}
do_test tcl-13.3 {
btree_breakpoint
  db eval {
    DELETE FROM t5;
    INSERT INTO t5 VALUES(@x);
    SELECT typeof(x) FROM t5;
  }
} {blob}










finish_test








|
|
















<






>
>
>
>
>
>
|
>
>
>


452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476

477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493

  set version [db version]
  scan $version "%d.%d.%d" a b c
  expr $a*1000000 + $b*1000 + $c
} [sqlite3_libversion_number]


# Check to see that when bindings of the form @aaa are used instead
# of $aaa, that objects are treated as bytearray and are inserted
# as BLOBs.
#
do_test tcl-13.1 {
  db eval {CREATE TABLE t5(x BLOB)}
  set x abc123
  db eval {INSERT INTO t5 VALUES($x)}
  db eval {SELECT typeof(x) FROM t5}
} {text}
do_test tcl-13.2 {
  binary scan $x H notUsed
  db eval {
    DELETE FROM t5;
    INSERT INTO t5 VALUES($x);
    SELECT typeof(x) FROM t5;
  }
} {text}
do_test tcl-13.3 {

  db eval {
    DELETE FROM t5;
    INSERT INTO t5 VALUES(@x);
    SELECT typeof(x) FROM t5;
  }
} {blob}
do_test tcl-13.4 {
  set y 1234
  db eval {
    DELETE FROM t5;
    INSERT INTO t5 VALUES(@y);
    SELECT hex(x), typeof(x) FROM t5
  }
} {31323334 blob}


finish_test