More work on the Tcl interface and tests for the sqlite3_trace_v2() API.

FossilOrigin-Name: f3c4aa97d8c10fdb69efc6405b5fa45781f45a61

diff --git a/manifest b/manifest
index b880ee391db6e1172996f8929719157122a2b6e0..ae6c2d0353677c62e35914a7b191f54ff483352a 100644 (file)
--- a/manifest
+++ b/manifest
@@ -1,5 +1,5 @@
-C Initial\swork\son\sthe\sTcl\sAPI\sinterface\sto\sthe\snew\ssqlite3_trace_v2()\sfunction.
-D 2016-07-14T21:26:09.090
+C More\swork\son\sthe\sTcl\sinterface\sand\stests\sfor\sthe\ssqlite3_trace_v2()\sAPI.
+D 2016-07-14T23:17:03.656
 F Makefile.in 6c20d44f72d4564f11652b26291a214c8367e5db
 F Makefile.linux-gcc 7bc79876b875010e8c8f9502eb935ca92aa3c434
 F Makefile.msc d66d0395c38571aab3804f8db0fa20707ae4609a
@@ -392,7 +392,7 @@ F src/sqliteInt.h 48cd97eb134665348393dfe277b4c14d1085bfc7
 F src/sqliteLimit.h c0373387c287c8d0932510b5547ecde31b5da247
 F src/status.c 5b18f9526900f61189ab0b83f1ef41d9f871a2ab
 F src/table.c 5226df15ab9179b9ed558d89575ea0ce37b03fc9
-F src/tclsqlite.c 361167055f0d0d9883b729f1db698edcd3b46065
+F src/tclsqlite.c 573e63c959b314d77486f3565fa79c60cda3df7e
 F src/test1.c 5124aff86fba753a6994e9621696ccfdc8bbf24e
 F src/test2.c 5586f43fcd9a1be0830793cf9d354082c261b25b
 F src/test3.c c75c8af0eadb335236c9e61b51044c58a8f7dd59
@@ -1285,6 +1285,7 @@ F test/tokenize.test ce430a7aed48fc98301611429595883fdfcab5d7
 F test/tpch01.test 04adbf8d8300fa60a222f28d901abd76e7be6dd4
 F test/trace.test 6f676313e3ebd2a50585036d2f212a3319dd5836
 F test/trace2.test f5cb67ad3bc09e0c58e8cca78dfd0b5639259983
+F test/trace3.test bc598719949e59b8ba5152cc42fea75e99766478
 F test/trans.test 6e1b4c6a42dba31bd65f8fa5e61a2708e08ddde6
 F test/trans2.test 62bd045bfc7a1c14c5ba83ba64d21ade31583f76
 F test/trans3.test 91a100e5412b488e22a655fe423a14c26403ab94
@@ -1505,7 +1506,7 @@ F vsixtest/vsixtest.tcl 6a9a6ab600c25a91a7acc6293828957a386a8a93
 F vsixtest/vsixtest.vcxproj.data 2ed517e100c66dc455b492e1a33350c1b20fbcdc
 F vsixtest/vsixtest.vcxproj.filters 37e51ffedcdb064aad6ff33b6148725226cd608e
 F vsixtest/vsixtest_TemporaryKey.pfx e5b1b036facdb453873e7084e1cae9102ccc67a0
-P e7d18c70d2b8f09c9f5b978fe3d69d1088e42322
-R 85912bc13f3699d6087855b14808f819
+P 7b59fa40a01c89cc98414d90a798169c26e04256
+R f3e8ed411550909534d86cfeab7a6746
 U mistachkin
-Z 312d6409632132f635d6a5f40333e628
+Z 5840e23d72dcfac70e0e20acc9abb290

diff --git a/manifest.uuid b/manifest.uuid
index f5bb4e0461baea256e358a9d2a3850fd7fa0135c..0d1c4fc278247569058923aed410e78c40c58e3a 100644 (file)
--- a/manifest.uuid
+++ b/manifest.uuid
@@ -1 +1 @@
-7b59fa40a01c89cc98414d90a798169c26e04256
\ No newline at end of file
+f3c4aa97d8c10fdb69efc6405b5fa45781f45a61
\ No newline at end of file

diff --git a/src/tclsqlite.c b/src/tclsqlite.c
index bcae05d79599226af7b5fa9610cdcaa82f330dbe..43dfedb727ac62c86c52e9335056254ef07a262b 100644 (file)
--- a/src/tclsqlite.c
+++ b/src/tclsqlite.c
@@ -2939,15 +2939,50 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
         Tcl_AppendResult(interp, pDb->zTraceV2, (char*)0);
       }
     }else{
-      Tcl_WideInt wMask;
       char *zTraceV2;
       int len;
+      Tcl_WideInt wMask = 0;
       if( objc==4 ){
-        if( TCL_OK!=Tcl_GetWideIntFromObj(interp, objv[3], &wMask) ){
+        static const char *TTYPE_strs[] = {
+          "statement", "profile", "row", "close", 0
+        };
+        enum TTYPE_enum {
+          TTYPE_STMT, TTYPE_PROFILE, TTYPE_ROW, TTYPE_CLOSE
+        };
+        int i;
+        if( TCL_OK!=Tcl_ListObjLength(interp, objv[3], &len) ){
           return TCL_ERROR;
         }
+        for(i=0; i<len; i++){
+          Tcl_Obj *pObj;
+          int ttype;
+          if( TCL_OK!=Tcl_ListObjIndex(interp, objv[3], i, &pObj) ){
+            return TCL_ERROR;
+          }
+          if( Tcl_GetIndexFromObj(interp, pObj, TTYPE_strs, "trace type",
+                                  0, &ttype)!=TCL_OK ){
+            Tcl_WideInt wType;
+            Tcl_Obj *pError = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
+            Tcl_IncrRefCount(pError);
+            if( TCL_OK==Tcl_GetWideIntFromObj(interp, pObj, &wType) ){
+              Tcl_DecrRefCount(pError);
+              wMask |= wType;
+            }else{
+              Tcl_SetObjResult(interp, pError);
+              Tcl_DecrRefCount(pError);
+              return TCL_ERROR;
+            }
+          }else{
+            switch( (enum TTYPE_enum)ttype ){
+              case TTYPE_STMT:    wMask |= SQLITE_TRACE_STMT;    break;
+              case TTYPE_PROFILE: wMask |= SQLITE_TRACE_PROFILE; break;
+              case TTYPE_ROW:     wMask |= SQLITE_TRACE_ROW;     break;
+              case TTYPE_CLOSE:   wMask |= SQLITE_TRACE_CLOSE;   break;
+            }
+          }
+        }
       }else{
-        wMask = SQLITE_TRACE_STMT;
+        wMask = SQLITE_TRACE_STMT; /* use the "legacy" default */
       }
       if( pDb->zTraceV2 ){
         Tcl_Free(pDb->zTraceV2);

diff --git a/test/trace3.test b/test/trace3.test
new file mode 100644 (file)
index 0000000..b997717
--- /dev/null
+++ b/test/trace3.test
@@ -0,0 +1,124 @@
+# 2016 July 14
+#
+# 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 SQLite library.  The focus
+# of this test file is the "sqlite3_trace_v2()" API.
+#
+
+set testdir [file dirname $argv0]
+source $testdir/tester.tcl
+ifcapable !trace { finish_test ; return }
+set ::testprefix trace3
+
+proc trace_v2_error { args } {
+  lappend ::stmtlist(error) [string trim $args]
+  error "trace error"; # this will be ignored.
+}
+proc trace_v2_record { args } {
+  lappend ::stmtlist(record) [string trim $args]
+}
+proc trace_v2_nop { args } {}; # do nothing.
+
+do_test trace3-1.0 {
+  execsql {
+    CREATE TABLE t1(a,b);
+    INSERT INTO t1 VALUES(1,NULL);
+    INSERT INTO t1 VALUES(2,-1);
+    INSERT INTO t1 VALUES(3,0);
+    INSERT INTO t1 VALUES(4,1);
+    INSERT INTO t1 VALUES(5,-2147483648);
+    INSERT INTO t1 VALUES(6,2147483647);
+    INSERT INTO t1 VALUES(7,-9223372036854775808);
+    INSERT INTO t1 VALUES(8,9223372036854775807);
+    INSERT INTO t1 VALUES(9,-1.0);
+    INSERT INTO t1 VALUES(10,0.0);
+    INSERT INTO t1 VALUES(11,1.0);
+    INSERT INTO t1 VALUES(12,'');
+    INSERT INTO t1 VALUES(13,'1');
+    INSERT INTO t1 VALUES(14,'one');
+    INSERT INTO t1 VALUES(15,x'abcd0123');
+    INSERT INTO t1 VALUES(16,x'4567cdef');
+  }
+} {}
+
+do_test trace3-1.1 {
+  set rc [catch {db trace_v2 1 2 3} msg]
+  lappend rc $msg
+} {1 {wrong # args: should be "db trace_v2 ?CALLBACK? ?MASK?"}}
+do_test trace3-1.2 {
+  set rc [catch {db trace_v2 1 bad} msg]
+  lappend rc $msg
+} {1 {bad trace type "bad": must be statement, profile, row, or close}}
+
+do_test trace3-2.1 {
+  db trace_v2 trace_v2_nop
+  db trace_v2
+} {trace_v2_nop}
+
+do_test trace3-3.1 {
+  unset -nocomplain ::stmtlist
+  db trace_v2 trace_v2_nop
+  execsql {
+    SELECT a, b FROM t1 ORDER BY a;
+  }
+  array get ::stmtlist
+} {}
+do_test trace3-3.2 {
+  set ::stmtlist(error) {}
+  db trace_v2 trace_v2_error
+  execsql {
+    SELECT a, b FROM t1 ORDER BY a;
+  }
+  set ::stmtlist(error)
+} {/^\{-?\d+ \{SELECT a, b FROM t1 ORDER BY a;\}\}$/}
+do_test trace3-3.3 {
+  set ::stmtlist(record) {}
+  db trace_v2 trace_v2_record
+  execsql {
+    SELECT a, b FROM t1 ORDER BY a;
+  }
+  set ::stmtlist(record)
+} {/^\{-?\d+ \{SELECT a, b FROM t1 ORDER BY a;\}\}$/}
+
+do_test trace3-4.1 {
+  set ::stmtlist(record) {}
+  db trace_v2 trace_v2_record profile
+  execsql {
+    SELECT a, b FROM t1 ORDER BY a;
+  }
+  set ::stmtlist(record)
+} {/^\{-?\d+ -?\d+\}$/}
+
+do_test trace3-5.1 {
+  set ::stmtlist(record) {}
+  db trace_v2 trace_v2_record row
+  execsql {
+    SELECT a, b FROM t1 ORDER BY a;
+  }
+  set ::stmtlist(record)
+} "/^[string trim [string repeat {\d+ } 16]]\$/"
+
+do_test trace3-6.1 {
+  set ::stmtlist(record) {}
+  db trace_v2 trace_v2_record {profile row}
+  execsql {
+    SELECT a, b FROM t1 ORDER BY a;
+  }
+  set ::stmtlist(record)
+} "/^[string trim [string repeat {-?\d+ } 16]] \\\{-?\\d+ -?\\d+\\\}\$/"
+
+do_test trace3-7.1 {
+  set ::stmtlist(record) {}
+  db trace_v2 trace_v2_record close
+  db close
+  set ::stmtlist(record)
+} {/^-?\d+$/}
+
+finish_test