/ Check-in [6ee2b8ff]
Login
SQLite training in Houston TX on 2019-11-05 (details)
Part of the 2019 Tcl Conference

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

Overview
Comment:Upgrade thread001.test to test with multiple database handles. (CVS 4417)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 6ee2b8ffc4310c8e329f634f3ade058b33c53a2a
User & Date: danielk1977 2007-09-10 06:23:54
Context
2007-09-10
07:35
Enhance thread001.test again, this time to also test in shared-cache mode. (CVS 4418) check-in: 54f87899 user: danielk1977 tags: trunk
06:23
Upgrade thread001.test to test with multiple database handles. (CVS 4417) check-in: 6ee2b8ff user: danielk1977 tags: trunk
06:12
Fix an undeclared identifier in an IOTRACE (debugging) block. (CVS 4416) check-in: 48e59c74 user: danielk1977 tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/test_thread.c.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
104
105
106
107
108
109
110
111
112
113
114
115

116
117
118



119
120
121
122
123
124
125
...
211
212
213
214
215
216
217































218
219
220
221
222
223
224
...
229
230
231
232
233
234
235

236
237
238
239
240
241
242
**
*************************************************************************
**
** This file contains the implementation of some Tcl commands used to
** test that sqlite3 database handles may be concurrently accessed by 
** multiple threads. Right now this only works on unix.
**
** $Id: test_thread.c,v 1.2 2007/09/07 18:40:38 danielk1977 Exp $
*/

#include "sqliteInt.h"

#if SQLITE_THREADSAFE && defined(TCL_THREADS)

#include <tcl.h>
................................................................................

  rc = Tcl_Eval(interp, p->zScript);
  pRes = Tcl_GetObjResult(interp);
  pList = Tcl_NewObj();
  Tcl_IncrRefCount(pList);
  Tcl_IncrRefCount(pRes);

  if( rc==TCL_OK ){
    Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj("set", -1));
    Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj(p->zVarname, -1));
  }else{
    Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj("error", -1));

  }
  Tcl_ListObjAppendElement(interp, pList, pRes);




  postToParent(p, pList);

  ckfree((void *)p);
  Tcl_DecrRefCount(pList);
  Tcl_DecrRefCount(pRes);
  Tcl_DeleteInterp(interp);
  return;
................................................................................
  memcpy(pEvent->zScript, zMsg, nMsg+1);
  pEvent->interp = p->interp;
  Tcl_ThreadQueueEvent(p->parent, (Tcl_Event *)pEvent, TCL_QUEUE_TAIL);
  Tcl_ThreadAlert(p->parent);

  return TCL_OK;
}
































/*
** Dispatch routine for the sub-commands of [sqlthread].
*/
static int sqlthread_proc(
  ClientData clientData,
  Tcl_Interp *interp,
................................................................................
    char *zName;
    Tcl_ObjCmdProc *xProc;
    int nArg;
    char *zUsage;
  } aSub[] = {
    {"parent", sqlthread_parent, 1, "SCRIPT"},
    {"spawn",  sqlthread_spawn,  2, "VARNAME SCRIPT"},

    {0, 0, 0}
  };
  struct SubCommand *pSub;
  int rc;
  int iIndex;

  if( objc<2 ){







|







 







|
|
|
|
|
>

<

>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
104
105
106
107
108
109
110
111
112
113
114
115
116
117

118
119
120
121
122
123
124
125
126
127
128
...
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
...
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
**
*************************************************************************
**
** This file contains the implementation of some Tcl commands used to
** test that sqlite3 database handles may be concurrently accessed by 
** multiple threads. Right now this only works on unix.
**
** $Id: test_thread.c,v 1.3 2007/09/10 06:23:54 danielk1977 Exp $
*/

#include "sqliteInt.h"

#if SQLITE_THREADSAFE && defined(TCL_THREADS)

#include <tcl.h>
................................................................................

  rc = Tcl_Eval(interp, p->zScript);
  pRes = Tcl_GetObjResult(interp);
  pList = Tcl_NewObj();
  Tcl_IncrRefCount(pList);
  Tcl_IncrRefCount(pRes);

  if( rc!=TCL_OK ){
    Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj("error", -1));
    Tcl_ListObjAppendElement(interp, pList, pRes);
    postToParent(p, pList);
    Tcl_DecrRefCount(pList);
    pList = Tcl_NewObj();
  }


  Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj("set", -1));
  Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj(p->zVarname, -1));
  Tcl_ListObjAppendElement(interp, pList, pRes);
  postToParent(p, pList);

  ckfree((void *)p);
  Tcl_DecrRefCount(pList);
  Tcl_DecrRefCount(pRes);
  Tcl_DeleteInterp(interp);
  return;
................................................................................
  memcpy(pEvent->zScript, zMsg, nMsg+1);
  pEvent->interp = p->interp;
  Tcl_ThreadQueueEvent(p->parent, (Tcl_Event *)pEvent, TCL_QUEUE_TAIL);
  Tcl_ThreadAlert(p->parent);

  return TCL_OK;
}

static int xBusy(void *pArg, int nBusy){
  sqlite3_sleep(50);
  return 1;             /* Try again... */
}

static int sqlthread_open(
  ClientData clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  int sqlite3TestMakePointerStr(Tcl_Interp *interp, char *zPtr, void *p);

  const char *zFilename;
  sqlite3 *db;
  int rc;
  char zBuf[100];
  extern void Md5_Register(sqlite3*);

  zFilename = Tcl_GetString(objv[2]);
  rc = sqlite3_open(zFilename, &db);
  Md5_Register(db);
  sqlite3_busy_handler(db, xBusy, 0);
  
  if( sqlite3TestMakePointerStr(interp, zBuf, db) ) return TCL_ERROR;
  Tcl_AppendResult(interp, zBuf, 0);

  return TCL_OK;
}


/*
** Dispatch routine for the sub-commands of [sqlthread].
*/
static int sqlthread_proc(
  ClientData clientData,
  Tcl_Interp *interp,
................................................................................
    char *zName;
    Tcl_ObjCmdProc *xProc;
    int nArg;
    char *zUsage;
  } aSub[] = {
    {"parent", sqlthread_parent, 1, "SCRIPT"},
    {"spawn",  sqlthread_spawn,  2, "VARNAME SCRIPT"},
    {"open",   sqlthread_open,   1, "DBNAME"},
    {0, 0, 0}
  };
  struct SubCommand *pSub;
  int rc;
  int iIndex;

  if( objc<2 ){

Changes to test/thread001.test.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49


50
51
52
53
54
55
56
57
58
..
69
70
71
72
73
74
75
76


















































77
78
79
80
81
82
83
84
85
86
87
88
89
90




91
92
93

94
95
96
97
98
99
100


101
102
103
104
105
106
107
108
109


110
111
112

113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
#
#    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.
#
#***********************************************************************
#
# $Id: thread001.test,v 1.2 2007/09/07 18:40:38 danielk1977 Exp $

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

if {[info commands sqlthread] eq ""} {
  puts -nonewline "Skipping thread-safety tests - "
  puts            " not running a threadsafe sqlite/tcl build"
  puts -nonewline "Both SQLITE_THREADSAFE and TCL_THREADS must be defined when"
  puts            " building testfixture"
  finish_test
  return
}

# Set up a database and a schema. The database contains a single
# table with two columns. The first column ("a") is an INTEGER PRIMARY 
# KEY. The second contains the md5sum of all rows in the table with
# a smaller value stored in column "a".
#
do_test thread001.1 {
  execsql {
    CREATE TABLE ab(a INTEGER PRIMARY KEY, b);
    CREATE INDEX ab_i ON ab(b);
    INSERT INTO ab SELECT NULL, md5sum(a, b) FROM ab;
    SELECT count(*) FROM ab;
  }
} {1}
do_test thread001.2 {
  execsql {
    SELECT 
      (SELECT md5sum(a, b) FROM ab WHERE a < (SELECT max(a) FROM ab)) ==
      (SELECT b FROM ab WHERE a = (SELECT max(a) FROM ab))
  }
} {1}
do_test thread001.3 {
  execsql { PRAGMA integrity_check }
} {ok}



set thread_program [format {
  set ::DB %s

  # Execute the supplied SQL using database handle $::DB.
  #
  proc execsql {sql} {
    set res [list]
    set ::STMT [sqlite3_prepare $::DB $sql -1 dummy_tail]
    while {[sqlite3_step $::STMT] eq "SQLITE_ROW"} {
................................................................................

  proc do_test {name script result} {
    set res [eval $script]
    if {$res ne $result} {
      error "$name failed: expected \"$result\" got \"$res\""
    }
  }



















































  for {set i 0} {$i < 100} {incr i} {
    # Test that the invariant is true.
    do_test t1 {
      execsql {
        SELECT 
          (SELECT md5sum(a, b) FROM ab WHERE a < (SELECT max(a) FROM ab)) ==
          (SELECT b FROM ab WHERE a = (SELECT max(a) FROM ab))
      }
    } {1}

    # Add another row to the database.
    execsql { INSERT INTO ab SELECT NULL, md5sum(a, b) FROM ab }
  }





  list OK
} [sqlite3_connection_pointer db]]


# Kick off 10 threads:
#
array unset finished
for {set i 0} {$i < 10} {incr i} {
  sqlthread spawn finished($i) $thread_program
}



for {set i 0} {$i < 10} {incr i} {
  if {![info exists finished($i)]} {
    vwait finished($i)
  }
  do_test thread001.4.$i {
    set ::finished($i)
  } OK
}



do_test thread001.5 {
  execsql { SELECT count(*) FROM ab; }
} {1001}

do_test thread001.6 {
  execsql {
    SELECT 
      (SELECT md5sum(a, b) FROM ab WHERE a < (SELECT max(a) FROM ab)) ==
      (SELECT b FROM ab WHERE a = (SELECT max(a) FROM ab))
  }
} {1}
do_test thread001.7 {
  execsql { PRAGMA integrity_check }
} {ok}

# Give the event-handlers a chance to close any open parent-child pipes.
# Otherwise, the test is reported as leaking memory (it has not - it's 
# just that the memory is freed asynchronously).
#
after 250 {set abit 0}
vwait abit

finish_test








|













|
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>
>
|
<







 







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
|
<
|
>
|
|
|
|
|
|
|
>
>
|
|
|
|
|
|
|
|
|
>
>
|
|
<
>
|
|
|
|
|
|
|
|
|
|
|
<
<
<
|
<
<
<


5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26



27



















28
29
30

31
32
33
34
35
36
37
..
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124

125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148

149
150
151
152
153
154
155
156
157
158
159
160



161



162
163
#
#    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.
#
#***********************************************************************
#
# $Id: thread001.test,v 1.3 2007/09/10 06:23:54 danielk1977 Exp $

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

if {[info commands sqlthread] eq ""} {
  puts -nonewline "Skipping thread-safety tests - "
  puts            " not running a threadsafe sqlite/tcl build"
  puts -nonewline "Both SQLITE_THREADSAFE and TCL_THREADS must be defined when"
  puts            " building testfixture"
  finish_test
  return
}

set ::NTHREAD 10























# The following script is sourced by every thread spawned using 
# [sqlthread spawn]:
set thread_procs {


  # Execute the supplied SQL using database handle $::DB.
  #
  proc execsql {sql} {
    set res [list]
    set ::STMT [sqlite3_prepare $::DB $sql -1 dummy_tail]
    while {[sqlite3_step $::STMT] eq "SQLITE_ROW"} {
................................................................................

  proc do_test {name script result} {
    set res [eval $script]
    if {$res ne $result} {
      error "$name failed: expected \"$result\" got \"$res\""
    }
  }
}

proc thread_spawn {varname args} {
  sqlthread spawn $varname [join $args ;]
}

#########################################################################
# End of infrastruture. Start of test cases.
#########################################################################


# Run this test twice: Once with all threads using the same database
# connection, and once with each using it's own connection.
#
foreach {dbconfig tn} [list "set ::DB $::DB" 1 "" 2] {

  # Empty the database.
  #
  catchsql { DROP TABLE ab; }

  # Set up a database and a schema. The database contains a single
  # table with two columns. The first column ("a") is an INTEGER PRIMARY 
  # KEY. The second contains the md5sum of all rows in the table with
  # a smaller value stored in column "a".
  #
  do_test thread001.$tn.1 {
    execsql {
      CREATE TABLE ab(a INTEGER PRIMARY KEY, b);
      CREATE INDEX ab_i ON ab(b);
      INSERT INTO ab SELECT NULL, md5sum(a, b) FROM ab;
      SELECT count(*) FROM ab;
    }
  } {1}
  do_test thread001.$tn.2 {
    execsql {
      SELECT 
        (SELECT md5sum(a, b) FROM ab WHERE a < (SELECT max(a) FROM ab)) ==
        (SELECT b FROM ab WHERE a = (SELECT max(a) FROM ab))
    }
  } {1}
  do_test thread001.$tn.3 {
    execsql { PRAGMA integrity_check }
  } {ok}
  
  set thread_program {
    set needToClose 0
    if {![info exists ::DB]} {
      set ::DB [sqlthread open test.db]
      set needToClose 1
    }
  
    for {set i 0} {$i < 100} {incr i} {
      # Test that the invariant is true.
      do_test t1 {
        execsql {
          SELECT 
            (SELECT md5sum(a, b) FROM ab WHERE a < (SELECT max(a) FROM ab)) ==
            (SELECT b FROM ab WHERE a = (SELECT max(a) FROM ab))
        }
      } {1}
  
      # Add another row to the database.
      execsql { INSERT INTO ab SELECT NULL, md5sum(a, b) FROM ab }
    }
  
    if {$needToClose} {
      sqlite3_close $::DB
    }
  
    list OK

  }
  
  # Kick off $::NTHREAD threads:
  #
  array unset finished
  for {set i 0} {$i < $::NTHREAD} {incr i} {
    thread_spawn finished($i) $dbconfig $thread_procs $thread_program
  }
  
  # Wait for all threads to finish,  then check they all returned "OK".
  #
  for {set i 0} {$i < $::NTHREAD} {incr i} {
    if {![info exists finished($i)]} {
      vwait finished($i)
    }
    do_test thread001.$tn.4.$i {
      set ::finished($i)
    } OK
  }
  
  # Check the database still looks Ok.
  #
  do_test thread001.$tn.5 {
    execsql { SELECT count(*) FROM ab; }

  } [expr {1 + $::NTHREAD*100}]
  do_test thread001.$tn.6 {
    execsql {
      SELECT 
        (SELECT md5sum(a, b) FROM ab WHERE a < (SELECT max(a) FROM ab)) ==
        (SELECT b FROM ab WHERE a = (SELECT max(a) FROM ab))
    }
  } {1}
  do_test thread001.$tn.7 {
    execsql { PRAGMA integrity_check }
  } {ok}
}







finish_test