|
1 # 2007 September 10 |
|
2 # |
|
3 # The author disclaims copyright to this source code. In place of |
|
4 # a legal notice, here is a blessing: |
|
5 # |
|
6 # May you do good and not evil. |
|
7 # May you find forgiveness for yourself and forgive others. |
|
8 # May you share freely, never taking more than you give. |
|
9 # |
|
10 #*********************************************************************** |
|
11 # |
|
12 # $Id: thread_common.tcl,v 1.2 2007/09/10 10:53:02 danielk1977 Exp $ |
|
13 |
|
14 set testdir [file dirname $argv0] |
|
15 source $testdir/tester.tcl |
|
16 |
|
17 if {[info commands sqlthread] eq ""} { |
|
18 puts -nonewline "Skipping thread-safety tests - " |
|
19 puts " not running a threadsafe sqlite/tcl build" |
|
20 puts -nonewline "Both SQLITE_THREADSAFE and TCL_THREADS must be defined when" |
|
21 puts " building testfixture" |
|
22 finish_test |
|
23 return |
|
24 } |
|
25 |
|
26 # The following script is sourced by every thread spawned using |
|
27 # [sqlthread spawn]: |
|
28 set thread_procs { |
|
29 |
|
30 # Execute the supplied SQL using database handle $::DB. |
|
31 # |
|
32 proc execsql {sql} { |
|
33 |
|
34 set rc SQLITE_LOCKED |
|
35 while {$rc eq "SQLITE_LOCKED" |
|
36 || $rc eq "SQLITE_BUSY" |
|
37 || $rc eq "SQLITE_SCHEMA"} { |
|
38 set res [list] |
|
39 |
|
40 set err [catch { |
|
41 set ::STMT [sqlite3_prepare_v2 $::DB $sql -1 dummy_tail] |
|
42 } msg] |
|
43 |
|
44 if {$err == 0} { |
|
45 while {[set rc [sqlite3_step $::STMT]] eq "SQLITE_ROW"} { |
|
46 for {set i 0} {$i < [sqlite3_column_count $::STMT]} {incr i} { |
|
47 lappend res [sqlite3_column_text $::STMT 0] |
|
48 } |
|
49 } |
|
50 set rc [sqlite3_finalize $::STMT] |
|
51 } else { |
|
52 if {[string first (6) $msg]} { |
|
53 set rc SQLITE_LOCKED |
|
54 } else { |
|
55 set rc SQLITE_ERROR |
|
56 } |
|
57 } |
|
58 |
|
59 if {[string first locked [sqlite3_errmsg $::DB]]>=0} { |
|
60 set rc SQLITE_LOCKED |
|
61 } |
|
62 |
|
63 if {$rc eq "SQLITE_LOCKED" || $rc eq "SQLITE_BUSY"} { |
|
64 #puts -nonewline "([sqlthread id] $rc)" |
|
65 #flush stdout |
|
66 after 20 |
|
67 } |
|
68 } |
|
69 |
|
70 if {$rc ne "SQLITE_OK"} { |
|
71 error "$rc - [sqlite3_errmsg $::DB]" |
|
72 } |
|
73 set res |
|
74 } |
|
75 |
|
76 proc do_test {name script result} { |
|
77 set res [eval $script] |
|
78 if {$res ne $result} { |
|
79 error "$name failed: expected \"$result\" got \"$res\"" |
|
80 } |
|
81 } |
|
82 } |
|
83 |
|
84 proc thread_spawn {varname args} { |
|
85 sqlthread spawn $varname [join $args ;] |
|
86 } |
|
87 |
|
88 return 0 |