/ Check-in [b606263d]
Login

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

Overview
Comment:Avoid using (clock seconds) in thread003.test. It is not available if testfixture is linked to tcl 8.5. (CVS 5634)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:b606263d0868aed267bcec623b9fe4d142099145
User & Date: danielk1977 2008-08-28 13:55:10
Context
2008-08-28
17:46
Partial fix for a bug in recovery from xStress failures in pcache. (CVS 5635) check-in: 44193b92 user: drh tags: trunk
13:55
Avoid using (clock seconds) in thread003.test. It is not available if testfixture is linked to tcl 8.5. (CVS 5634) check-in: b606263d user: danielk1977 tags: trunk
13:15
Use ckfree() instead of sqlite3_free() to free an allocation made by ckalloc() in test_thread.c (test code only). (CVS 5633) check-in: 677ac144 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
..
47
48
49
50
51
52
53

54
55
56
57
58
59
60
..
95
96
97
98
99
100
101

102
103
104
105
106
107
108
...
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
...
313
314
315
316
317
318
319



















320
321
322
323
324
325

326
327
328
329
330
331
332
**
*************************************************************************
**
** 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.7 2008/08/28 13:15:50 danielk1977 Exp $
*/

#include "sqliteInt.h"
#include <tcl.h>

#if SQLITE_THREADSAFE && defined(TCL_THREADS)

................................................................................
struct EvalEvent {
  Tcl_Event base;          /* Base class of type Tcl_Event */
  char *zScript;           /* The script to execute. */
  Tcl_Interp *interp;      /* The interpreter to execute it in. */
};

static Tcl_ObjCmdProc sqlthread_proc;

int Sqlitetest1_Init(Tcl_Interp *);

/*
** Handler for events of type EvalEvent.
*/
static int tclScriptEvent(Tcl_Event *evPtr, int flags){
  int rc;
................................................................................
  Tcl_Obj *pRes;
  Tcl_Obj *pList;
  int rc;

  SqlThread *p = (SqlThread *)pSqlThread;

  interp = Tcl_CreateInterp();

  Tcl_CreateObjCommand(interp, "sqlthread", sqlthread_proc, pSqlThread, 0);
  Sqlitetest1_Init(interp);

  rc = Tcl_Eval(interp, p->zScript);
  pRes = Tcl_GetObjResult(interp);
  pList = Tcl_NewObj();
  Tcl_IncrRefCount(pList);
................................................................................
  memcpy(pNew->zScript, zScript, nScript+1);
  pNew->parent = Tcl_GetCurrentThread();
  pNew->interp = interp;

  rc = Tcl_CreateThread(&x, tclScriptThread, (void *)pNew, nStack, flags);
  if( rc!=TCL_OK ){
    Tcl_AppendResult(interp, "Error in Tcl_CreateThread()", 0);
    ckfree(pNew);
    return TCL_ERROR;
  }

  return TCL_OK;
}

/*
................................................................................
  if( objc!=(pSub->nArg+2) ){
    Tcl_WrongNumArgs(interp, 2, objv, pSub->zUsage);
    return TCL_ERROR;
  }

  return pSub->xProc(clientData, interp, objc, objv);
}




















/*
** Register commands with the TCL interpreter.
*/
int SqlitetestThread_Init(Tcl_Interp *interp){
  Tcl_CreateObjCommand(interp, "sqlthread", sqlthread_proc, 0, 0);

  return TCL_OK;
}
#else
int SqlitetestThread_Init(Tcl_Interp *interp){
  return TCL_OK;
}
#endif







|







 







>







 







>







 







|







 







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






>







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
..
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
..
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
...
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
...
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
**
*************************************************************************
**
** 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.8 2008/08/28 13:55:10 danielk1977 Exp $
*/

#include "sqliteInt.h"
#include <tcl.h>

#if SQLITE_THREADSAFE && defined(TCL_THREADS)

................................................................................
struct EvalEvent {
  Tcl_Event base;          /* Base class of type Tcl_Event */
  char *zScript;           /* The script to execute. */
  Tcl_Interp *interp;      /* The interpreter to execute it in. */
};

static Tcl_ObjCmdProc sqlthread_proc;
static Tcl_ObjCmdProc clock_seconds_proc;
int Sqlitetest1_Init(Tcl_Interp *);

/*
** Handler for events of type EvalEvent.
*/
static int tclScriptEvent(Tcl_Event *evPtr, int flags){
  int rc;
................................................................................
  Tcl_Obj *pRes;
  Tcl_Obj *pList;
  int rc;

  SqlThread *p = (SqlThread *)pSqlThread;

  interp = Tcl_CreateInterp();
  Tcl_CreateObjCommand(interp, "clock_seconds", clock_seconds_proc, 0, 0);
  Tcl_CreateObjCommand(interp, "sqlthread", sqlthread_proc, pSqlThread, 0);
  Sqlitetest1_Init(interp);

  rc = Tcl_Eval(interp, p->zScript);
  pRes = Tcl_GetObjResult(interp);
  pList = Tcl_NewObj();
  Tcl_IncrRefCount(pList);
................................................................................
  memcpy(pNew->zScript, zScript, nScript+1);
  pNew->parent = Tcl_GetCurrentThread();
  pNew->interp = interp;

  rc = Tcl_CreateThread(&x, tclScriptThread, (void *)pNew, nStack, flags);
  if( rc!=TCL_OK ){
    Tcl_AppendResult(interp, "Error in Tcl_CreateThread()", 0);
    ckfree((char *)pNew);
    return TCL_ERROR;
  }

  return TCL_OK;
}

/*
................................................................................
  if( objc!=(pSub->nArg+2) ){
    Tcl_WrongNumArgs(interp, 2, objv, pSub->zUsage);
    return TCL_ERROR;
  }

  return pSub->xProc(clientData, interp, objc, objv);
}

/*
** The [clock_seconds] command. This is more or less the same as the
** regular tcl [clock seconds], except that it is available in testfixture
** when linked against both Tcl 8.4 and 8.5. Because [clock seconds] is
** implemented as a script in Tcl 8.5, it is not usually available to
** testfixture.
*/ 
static int clock_seconds_proc(
  ClientData clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  Tcl_Time now;
  Tcl_GetTime(&now);
  Tcl_SetObjResult(interp, Tcl_NewIntObj(now.sec));
  return TCL_OK;
}

/*
** Register commands with the TCL interpreter.
*/
int SqlitetestThread_Init(Tcl_Interp *interp){
  Tcl_CreateObjCommand(interp, "sqlthread", sqlthread_proc, 0, 0);
  Tcl_CreateObjCommand(interp, "clock_seconds", clock_seconds_proc, 0, 0);
  return TCL_OK;
}
#else
int SqlitetestThread_Init(Tcl_Interp *interp){
  return TCL_OK;
}
#endif

Changes to test/thread003.test.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
..
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
...
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
...
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
#    May you share freely, never taking more than you give.
#
#***********************************************************************
#
#   This file contains tests that attempt to break the pcache module
#   by bombarding it with simultaneous requests from multiple threads.
#     
# $Id: thread003.test,v 1.2 2008/08/28 10:21:17 danielk1977 Exp $

set testdir [file dirname $argv0]

source $testdir/tester.tcl
source $testdir/thread_common.tcl
if {[info commands sqlthread] eq ""} {
  finish_test
................................................................................
# failure may eventually occur.
#
set nSecond 30
puts "Starting thread003.2 (should run for ~$nSecond seconds)"
do_test thread003.2 {
  foreach zFile {test.db test2.db} {
    set SCRIPT [format {
      set iStart [clock seconds]
      set iEnd [expr {[clock seconds] + %d}]
      set ::DB [sqlthread open %s]
  
      # Set the cache size to 15 pages per cache. 30 available globally.
      execsql { PRAGMA cache_size = 15 }
  
      while {[clock seconds] < $iEnd} {
        set iQuery [expr {int(rand()*5000)}]
        execsql " SELECT * FROM t1 WHERE a = $iQuery "
      }
  
      sqlite3_close $::DB
      expr 1
    } $nSecond $zFile]
................................................................................
# opportunity for a thread-related bug to present itself.
#
set nSecond 30
puts "Starting thread003.3 (should run for ~$nSecond seconds)"
do_test thread003.3 {
  foreach zFile {test.db test2.db} {
    set SCRIPT [format {
      set iStart [clock seconds]
      set iEnd [expr {[clock seconds] + %d}]
      set ::DB [sqlthread open %s]
  
      # Set the cache size to 15 pages per cache. 30 available globally.
      execsql { PRAGMA cache_size = 15 }
  
      while {[clock seconds] < $iEnd} {
        set iQuery [expr {int(rand()*5000)}]
        execsql "SELECT * FROM t1 WHERE a = $iQuery"
        execsql "UPDATE t1 SET b = randomblob(200) 
                 WHERE a < $iQuery AND a > $iQuery + 20
        "
      }
  
................................................................................
# The other thread does not have a database connection, but calls
# sqlite3_release_memory() over and over again.
#
set nSecond 30
puts "Starting thread003.3 (should run for ~$nSecond seconds)"
do_test thread003.4 {
  thread_spawn finished(1) $thread_procs [format {
    set iEnd [expr {[clock seconds] + %d}]
    set ::DB [sqlthread open test.db]

    # Set the cache size to 15 pages per cache. 30 available globally.
    execsql { PRAGMA cache_size = 15 }

    while {[clock seconds] < $iEnd} {
      set iQuery [expr {int(rand()*5000)}]
      execsql "SELECT * FROM t1 WHERE a = $iQuery"
    }

    sqlite3_close $::DB
    expr 1
  } $nSecond] 
  thread_spawn finished(2) [format {
    set iEnd [expr {[clock seconds] + %d}]

    while {[clock seconds] < $iEnd} {
      sqlite3_release_memory 1000
    }
  } $nSecond]
  
  foreach ii {1 2} {
    if {![info exists finished($ii)]} {
      vwait finished($ii)







|







 







<
|





|







 







|
|





|







 







|





|








|

|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
..
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93
94
95
96
97
98
99
...
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
...
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
#    May you share freely, never taking more than you give.
#
#***********************************************************************
#
#   This file contains tests that attempt to break the pcache module
#   by bombarding it with simultaneous requests from multiple threads.
#     
# $Id: thread003.test,v 1.3 2008/08/28 13:55:10 danielk1977 Exp $

set testdir [file dirname $argv0]

source $testdir/tester.tcl
source $testdir/thread_common.tcl
if {[info commands sqlthread] eq ""} {
  finish_test
................................................................................
# failure may eventually occur.
#
set nSecond 30
puts "Starting thread003.2 (should run for ~$nSecond seconds)"
do_test thread003.2 {
  foreach zFile {test.db test2.db} {
    set SCRIPT [format {

      set iEnd [expr {[clock_seconds] + %d}]
      set ::DB [sqlthread open %s]
  
      # Set the cache size to 15 pages per cache. 30 available globally.
      execsql { PRAGMA cache_size = 15 }
  
      while {[clock_seconds] < $iEnd} {
        set iQuery [expr {int(rand()*5000)}]
        execsql " SELECT * FROM t1 WHERE a = $iQuery "
      }
  
      sqlite3_close $::DB
      expr 1
    } $nSecond $zFile]
................................................................................
# opportunity for a thread-related bug to present itself.
#
set nSecond 30
puts "Starting thread003.3 (should run for ~$nSecond seconds)"
do_test thread003.3 {
  foreach zFile {test.db test2.db} {
    set SCRIPT [format {
      set iStart [clock_seconds]
      set iEnd [expr {[clock_seconds] + %d}]
      set ::DB [sqlthread open %s]
  
      # Set the cache size to 15 pages per cache. 30 available globally.
      execsql { PRAGMA cache_size = 15 }
  
      while {[clock_seconds] < $iEnd} {
        set iQuery [expr {int(rand()*5000)}]
        execsql "SELECT * FROM t1 WHERE a = $iQuery"
        execsql "UPDATE t1 SET b = randomblob(200) 
                 WHERE a < $iQuery AND a > $iQuery + 20
        "
      }
  
................................................................................
# The other thread does not have a database connection, but calls
# sqlite3_release_memory() over and over again.
#
set nSecond 30
puts "Starting thread003.3 (should run for ~$nSecond seconds)"
do_test thread003.4 {
  thread_spawn finished(1) $thread_procs [format {
    set iEnd [expr {[clock_seconds] + %d}]
    set ::DB [sqlthread open test.db]

    # Set the cache size to 15 pages per cache. 30 available globally.
    execsql { PRAGMA cache_size = 15 }

    while {[clock_seconds] < $iEnd} {
      set iQuery [expr {int(rand()*5000)}]
      execsql "SELECT * FROM t1 WHERE a = $iQuery"
    }

    sqlite3_close $::DB
    expr 1
  } $nSecond] 
  thread_spawn finished(2) [format {
    set iEnd [expr {[clock_seconds] + %d}]

    while {[clock_seconds] < $iEnd} {
      sqlite3_release_memory 1000
    }
  } $nSecond]
  
  foreach ii {1 2} {
    if {![info exists finished($ii)]} {
      vwait finished($ii)