/ Check-in [c758cc1d]
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:Add another test file to help verify thread-safety. (CVS 4419)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: c758cc1d885b4528c0b0ef6382119f20956d4816
User & Date: danielk1977 2007-09-10 10:53:02
Context
2007-09-10
16:13
Fix a problem in the noop-mutexes used for testing. (CVS 4420) check-in: 4dbeb915 user: danielk1977 tags: trunk
10:53
Add another test file to help verify thread-safety. (CVS 4419) check-in: c758cc1d user: danielk1977 tags: trunk
07:35
Enhance thread001.test again, this time to also test in shared-cache mode. (CVS 4418) check-in: 54f87899 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
...
220
221
222
223
224
225
226






227
228
229
230
231
232
233
...
245
246
247
248
249
250
251


















252
253
254
255
256
257
258
...
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>
................................................................................
}

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);
................................................................................
  
  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,
................................................................................
    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 ){







|







 







>
>
>
>
>
>







 







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







 







>







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
...
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
...
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
**
*************************************************************************
**
** 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.4 2007/09/10 10:53:02 danielk1977 Exp $
*/

#include "sqliteInt.h"

#if SQLITE_THREADSAFE && defined(TCL_THREADS)

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

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

/*
** sqlthread open
**
**     Open a database handle and return the string representation of
**     the pointer value.
*/
static int sqlthread_open(
  ClientData clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  int sqlite3TestMakePointerStr(Tcl_Interp *interp, char *zPtr, void *p);
................................................................................
  
  if( sqlite3TestMakePointerStr(interp, zBuf, db) ) return TCL_ERROR;
  Tcl_AppendResult(interp, zBuf, 0);

  return TCL_OK;
}


/*
** sqlthread open
**
**     Return the current thread-id (Tcl_GetCurrentThread()) cast to
**     an integer.
*/
static int sqlthread_id(
  ClientData clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  Tcl_ThreadId id = Tcl_GetCurrentThread();
  Tcl_SetObjResult(interp, Tcl_NewIntObj((int)id));
  return TCL_OK;
}


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

  if( objc<2 ){

Changes to test/quick.test.

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
..
61
62
63
64
65
66
67



68
69
70
71
72
73
74
#    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 runs all tests.
#
# $Id: quick.test,v 1.62 2007/08/23 16:27:21 danielk1977 Exp $

proc lshift {lvar} {
  upvar $lvar l
  set ret [lindex $l 0]
  set l [lrange $l 1 end]
  return $ret
}
................................................................................
  misc7.test
  misuse.test
  quick.test
  soak.test
  speed1.test
  speed2.test
  sqllimits1.test




  incrvacuum_ioerr.test
  autovacuum_crash.test
  btree8.test
  utf16.test
  shared_err.test
  vtab_err.test







|







 







>
>
>







2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
..
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
#    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 runs all tests.
#
# $Id: quick.test,v 1.63 2007/09/10 10:53:02 danielk1977 Exp $

proc lshift {lvar} {
  upvar $lvar l
  set ret [lindex $l 0]
  set l [lrange $l 1 end]
  return $ret
}
................................................................................
  misc7.test
  misuse.test
  quick.test
  soak.test
  speed1.test
  speed2.test
  sqllimits1.test

  thread001.test
  thread002.test

  incrvacuum_ioerr.test
  autovacuum_crash.test
  btree8.test
  utf16.test
  shared_err.test
  vtab_err.test

Added test/thread002.test.



















































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
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
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
# 2007 September 10
#
# 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 test attempts to deadlock SQLite in shared-cache mode.
#     
#
# $Id: thread002.test,v 1.1 2007/09/10 10:53:02 danielk1977 Exp $

set testdir [file dirname $argv0]

source $testdir/tester.tcl
source $testdir/thread_common.tcl
if {[info commands sqlthread] eq ""} {
  return
}

db close
sqlite3_enable_shared_cache 1

set ::NTHREAD 10

do_test thread002.1 {
  # Create 3 databases with identical schemas:
  for {set ii 0} {$ii < 3} {incr ii} {
    file delete -force test${ii}.db
    sqlite3 db test${ii}.db
    execsql {
      CREATE TABLE t1(k, v);
      CREATE INDEX t1_i ON t1(v);
      INSERT INTO t1(v) VALUES(1.0);
    }
    db close
  }
} {}

set thread_program {
  set ::DB [sqlite3_open test.db]
  for {set ii 1} {$ii <= 3} {incr ii} {
    set T [lindex $order [expr $ii-1]]
    execsql "ATTACH 'test${T}.db' AS aux${ii}"
  }

  for {set ii 0} {$ii < 100} {incr ii} {
    execsql { SELECT * FROM aux1.t1 }
    execsql { INSERT INTO aux1.t1(v) SELECT sum(v) FROM aux2.t1 }
  
    execsql { SELECT * FROM aux2.t1 }
    execsql { INSERT INTO aux2.t1(v) SELECT sum(v) FROM aux3.t1 }
  
    execsql { SELECT * FROM aux3.t1 }
    execsql { INSERT INTO aux3.t1(v) SELECT sum(v) FROM aux1.t1 }

    execsql { CREATE TABLE aux1.t2(a,b) }
    execsql { DROP TABLE aux1.t2 }

    # if {($ii%10)==0} {puts -nonewline . ; flush stdout}
    puts -nonewline . ; flush stdout
  }

  sqlite3_close $::DB
  list OK
}

set order_list [list {0 1 2} {0 2 1} {1 0 2} {1 2 0} {2 0 1} {2 1 0}]

array unset finished
for {set ii 0} {$ii < $::NTHREAD} {incr ii} {
  set order [lindex $order_list [expr $ii%6]]
  thread_spawn finished($ii) $thread_procs "set order {$order}" $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.2.$i {
    set ::finished($i)
  } OK
}

# Check all three databases are Ok.
for {set ii 0} {$ii < 3} {incr ii} {
  do_test thread002.3.$ii {
    sqlite3 db test${ii}.db
    set res [list                         \
      [execsql {SELECT count(*) FROM t1}] \
      [execsql {PRAGMA integrity_check}]  \
    ]
    db close
    set res
  } [list [expr 1 + $::NTHREAD*100] ok]
}

finish_test

Changes to test/thread_common.tcl.

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
#
#    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: thread_common.tcl,v 1.1 2007/09/10 07:35:47 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 rc SQLITE_LOCKED
    while {$rc eq "SQLITE_LOCKED"} {


      set res [list]


      set ::STMT [sqlite3_prepare $::DB $sql -1 dummy_tail]



      while {[set rc [sqlite3_step $::STMT]] eq "SQLITE_ROW"} {
        for {set i 0} {$i < [sqlite3_column_count $::STMT]} {incr i} {
          lappend res [sqlite3_column_text $::STMT 0]
        }
      }

      set rc [sqlite3_finalize $::STMT]












      if {$rc eq "SQLITE_LOCKED"} {


        after 20
      }
    }

    if {$rc ne "SQLITE_OK"} {
      error "$rc - [sqlite3_errmsg $::DB]"
    }







|













<
<









|
>
>

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







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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
#
#    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: thread_common.tcl,v 1.2 2007/09/10 10:53:02 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
}



# 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 rc SQLITE_LOCKED
    while {$rc eq "SQLITE_LOCKED" 
        || $rc eq "SQLITE_BUSY" 
        || $rc eq "SQLITE_SCHEMA"} {
      set res [list]

      set err [catch {
        set ::STMT [sqlite3_prepare_v2 $::DB $sql -1 dummy_tail]
      } msg]

      if {$err == 0} {
        while {[set rc [sqlite3_step $::STMT]] eq "SQLITE_ROW"} {
          for {set i 0} {$i < [sqlite3_column_count $::STMT]} {incr i} {
            lappend res [sqlite3_column_text $::STMT 0]
          }
        }

        set rc [sqlite3_finalize $::STMT]
      } else {
        if {[string first (6) $msg]} {
          set rc SQLITE_LOCKED
        } else {
          set rc SQLITE_ERROR
        }
      }

      if {[string first locked [sqlite3_errmsg $::DB]]>=0} {
        set rc SQLITE_LOCKED
      }

      if {$rc eq "SQLITE_LOCKED" || $rc eq "SQLITE_BUSY"} {
 #puts -nonewline "([sqlthread id] $rc)"
 #flush stdout
        after 20
      }
    }

    if {$rc ne "SQLITE_OK"} {
      error "$rc - [sqlite3_errmsg $::DB]"
    }