/ Hex Artifact Content
Login

Artifact 334639cadcb9f912bf82aa73f49efd5282e6cadd:


0000: 23 20 32 30 30 37 20 53 65 70 74 65 6d 62 65 72  # 2007 September
0010: 20 31 30 0a 23 0a 23 20 54 68 65 20 61 75 74 68   10.#.# The auth
0020: 6f 72 20 64 69 73 63 6c 61 69 6d 73 20 63 6f 70  or disclaims cop
0030: 79 72 69 67 68 74 20 74 6f 20 74 68 69 73 20 73  yright to this s
0040: 6f 75 72 63 65 20 63 6f 64 65 2e 20 20 49 6e 20  ource code.  In 
0050: 70 6c 61 63 65 20 6f 66 0a 23 20 61 20 6c 65 67  place of.# a leg
0060: 61 6c 20 6e 6f 74 69 63 65 2c 20 68 65 72 65 20  al notice, here 
0070: 69 73 20 61 20 62 6c 65 73 73 69 6e 67 3a 0a 23  is a blessing:.#
0080: 0a 23 20 20 20 20 4d 61 79 20 79 6f 75 20 64 6f  .#    May you do
0090: 20 67 6f 6f 64 20 61 6e 64 20 6e 6f 74 20 65 76   good and not ev
00a0: 69 6c 2e 0a 23 20 20 20 20 4d 61 79 20 79 6f 75  il..#    May you
00b0: 20 66 69 6e 64 20 66 6f 72 67 69 76 65 6e 65 73   find forgivenes
00c0: 73 20 66 6f 72 20 79 6f 75 72 73 65 6c 66 20 61  s for yourself a
00d0: 6e 64 20 66 6f 72 67 69 76 65 20 6f 74 68 65 72  nd forgive other
00e0: 73 2e 0a 23 20 20 20 20 4d 61 79 20 79 6f 75 20  s..#    May you 
00f0: 73 68 61 72 65 20 66 72 65 65 6c 79 2c 20 6e 65  share freely, ne
0100: 76 65 72 20 74 61 6b 69 6e 67 20 6d 6f 72 65 20  ver taking more 
0110: 74 68 61 6e 20 79 6f 75 20 67 69 76 65 2e 0a 23  than you give..#
0120: 0a 23 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a  .#**************
0130: 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a  ****************
0140: 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a  ****************
0150: 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a  ****************
0160: 2a 2a 2a 2a 2a 2a 2a 2a 2a 0a 23 0a 23 20 24 49  *********.#.# $I
0170: 64 3a 20 74 68 72 65 61 64 5f 63 6f 6d 6d 6f 6e  d: thread_common
0180: 2e 74 63 6c 2c 76 20 31 2e 35 20 32 30 30 39 2f  .tcl,v 1.5 2009/
0190: 30 33 2f 32 36 20 31 34 3a 34 38 3a 30 37 20 64  03/26 14:48:07 d
01a0: 61 6e 69 65 6c 6b 31 39 37 37 20 45 78 70 20 24  anielk1977 Exp $
01b0: 0a 0a 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73  ..if {[info exis
01c0: 74 73 20 3a 3a 74 68 72 65 61 64 5f 70 72 6f 63  ts ::thread_proc
01d0: 73 5d 7d 20 7b 0a 20 20 72 65 74 75 72 6e 20 30  s]} {.  return 0
01e0: 0a 7d 0a 0a 23 20 54 68 65 20 66 6f 6c 6c 6f 77  .}..# The follow
01f0: 69 6e 67 20 73 63 72 69 70 74 20 69 73 20 73 6f  ing script is so
0200: 75 72 63 65 64 20 62 79 20 65 76 65 72 79 20 74  urced by every t
0210: 68 72 65 61 64 20 73 70 61 77 6e 65 64 20 75 73  hread spawned us
0220: 69 6e 67 20 0a 23 20 5b 73 71 6c 74 68 72 65 61  ing .# [sqlthrea
0230: 64 20 73 70 61 77 6e 5d 3a 0a 73 65 74 20 74 68  d spawn]:.set th
0240: 72 65 61 64 5f 70 72 6f 63 73 20 7b 0a 0a 20 20  read_procs {..  
0250: 23 20 45 78 65 63 75 74 65 20 74 68 65 20 73 75  # Execute the su
0260: 70 70 6c 69 65 64 20 53 51 4c 20 75 73 69 6e 67  pplied SQL using
0270: 20 64 61 74 61 62 61 73 65 20 68 61 6e 64 6c 65   database handle
0280: 20 24 3a 3a 44 42 2e 0a 20 20 23 0a 20 20 70 72   $::DB..  #.  pr
0290: 6f 63 20 65 78 65 63 73 71 6c 20 7b 73 71 6c 7d  oc execsql {sql}
02a0: 20 7b 0a 0a 20 20 20 20 73 65 74 20 72 63 20 53   {..    set rc S
02b0: 51 4c 49 54 45 5f 4c 4f 43 4b 45 44 0a 20 20 20  QLITE_LOCKED.   
02c0: 20 77 68 69 6c 65 20 7b 24 72 63 20 65 71 20 22   while {$rc eq "
02d0: 53 51 4c 49 54 45 5f 4c 4f 43 4b 45 44 22 20 0a  SQLITE_LOCKED" .
02e0: 20 20 20 20 20 20 20 20 7c 7c 20 24 72 63 20 65          || $rc e
02f0: 71 20 22 53 51 4c 49 54 45 5f 42 55 53 59 22 20  q "SQLITE_BUSY" 
0300: 0a 20 20 20 20 20 20 20 20 7c 7c 20 24 72 63 20  .        || $rc 
0310: 65 71 20 22 53 51 4c 49 54 45 5f 53 43 48 45 4d  eq "SQLITE_SCHEM
0320: 41 22 7d 20 7b 0a 20 20 20 20 20 20 73 65 74 20  A"} {.      set 
0330: 72 65 73 20 5b 6c 69 73 74 5d 0a 0a 20 20 20 20  res [list]..    
0340: 20 20 65 6e 74 65 72 5f 64 62 5f 6d 75 74 65 78    enter_db_mutex
0350: 20 24 3a 3a 44 42 0a 20 20 20 20 20 20 73 65 74   $::DB.      set
0360: 20 65 72 72 20 5b 63 61 74 63 68 20 7b 0a 20 20   err [catch {.  
0370: 20 20 20 20 20 20 73 65 74 20 3a 3a 53 54 4d 54        set ::STMT
0380: 20 5b 73 71 6c 69 74 65 33 5f 70 72 65 70 61 72   [sqlite3_prepar
0390: 65 5f 76 32 20 24 3a 3a 44 42 20 24 73 71 6c 20  e_v2 $::DB $sql 
03a0: 2d 31 20 64 75 6d 6d 79 5f 74 61 69 6c 5d 0a 20  -1 dummy_tail]. 
03b0: 20 20 20 20 20 7d 20 6d 73 67 5d 0a 0a 20 20 20       } msg]..   
03c0: 20 20 20 69 66 20 7b 24 65 72 72 20 3d 3d 20 30     if {$err == 0
03d0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 77 68 69 6c  } {.        whil
03e0: 65 20 7b 5b 73 65 74 20 72 63 20 5b 73 71 6c 69  e {[set rc [sqli
03f0: 74 65 33 5f 73 74 65 70 20 24 3a 3a 53 54 4d 54  te3_step $::STMT
0400: 5d 5d 20 65 71 20 22 53 51 4c 49 54 45 5f 52 4f  ]] eq "SQLITE_RO
0410: 57 22 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20  W"} {.          
0420: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24  for {set i 0} {$
0430: 69 20 3c 20 5b 73 71 6c 69 74 65 33 5f 63 6f 6c  i < [sqlite3_col
0440: 75 6d 6e 5f 63 6f 75 6e 74 20 24 3a 3a 53 54 4d  umn_count $::STM
0450: 54 5d 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 20  T]} {incr i} {. 
0460: 20 20 20 20 20 20 20 20 20 20 20 6c 61 70 70 65             lappe
0470: 6e 64 20 72 65 73 20 5b 73 71 6c 69 74 65 33 5f  nd res [sqlite3_
0480: 63 6f 6c 75 6d 6e 5f 74 65 78 74 20 24 3a 3a 53  column_text $::S
0490: 54 4d 54 20 30 5d 0a 20 20 20 20 20 20 20 20 20  TMT 0].         
04a0: 20 7d 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20   }.        }.   
04b0: 20 20 20 20 20 73 65 74 20 72 63 20 5b 73 71 6c       set rc [sql
04c0: 69 74 65 33 5f 66 69 6e 61 6c 69 7a 65 20 24 3a  ite3_finalize $:
04d0: 3a 53 54 4d 54 5d 0a 20 20 20 20 20 20 7d 20 65  :STMT].      } e
04e0: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 69 66  lse {.        if
04f0: 20 7b 5b 6c 69 6e 64 65 78 20 24 6d 73 67 20 30   {[lindex $msg 0
0500: 5d 3d 3d 22 28 36 29 22 7d 20 7b 0a 20 20 20 20  ]=="(6)"} {.    
0510: 20 20 20 20 20 20 73 65 74 20 72 63 20 53 51 4c        set rc SQL
0520: 49 54 45 5f 4c 4f 43 4b 45 44 0a 20 20 20 20 20  ITE_LOCKED.     
0530: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20     } else {.    
0540: 20 20 20 20 20 20 73 65 74 20 72 63 20 53 51 4c        set rc SQL
0550: 49 54 45 5f 45 52 52 4f 52 0a 20 20 20 20 20 20  ITE_ERROR.      
0560: 20 20 7d 0a 20 20 20 20 20 20 7d 0a 0a 20 20 20    }.      }..   
0570: 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 66     if {[string f
0580: 69 72 73 74 20 6c 6f 63 6b 65 64 20 5b 73 71 6c  irst locked [sql
0590: 69 74 65 33 5f 65 72 72 6d 73 67 20 24 3a 3a 44  ite3_errmsg $::D
05a0: 42 5d 5d 3e 3d 30 7d 20 7b 0a 20 20 20 20 20 20  B]]>=0} {.      
05b0: 20 20 73 65 74 20 72 63 20 53 51 4c 49 54 45 5f    set rc SQLITE_
05c0: 4c 4f 43 4b 45 44 0a 20 20 20 20 20 20 7d 0a 20  LOCKED.      }. 
05d0: 20 20 20 20 20 69 66 20 7b 24 72 63 20 6e 65 20       if {$rc ne 
05e0: 22 53 51 4c 49 54 45 5f 4f 4b 22 7d 20 7b 0a 20  "SQLITE_OK"} {. 
05f0: 20 20 20 20 20 20 20 73 65 74 20 65 72 72 74 78         set errtx
0600: 74 20 22 24 72 63 20 2d 20 5b 73 71 6c 69 74 65  t "$rc - [sqlite
0610: 33 5f 65 72 72 6d 73 67 20 24 3a 3a 44 42 5d 20  3_errmsg $::DB] 
0620: 28 64 65 62 75 67 31 29 22 0a 20 20 20 20 20 20  (debug1)".      
0630: 7d 0a 20 20 20 20 20 20 6c 65 61 76 65 5f 64 62  }.      leave_db
0640: 5f 6d 75 74 65 78 20 24 3a 3a 44 42 0a 0a 20 20  _mutex $::DB..  
0650: 20 20 20 20 69 66 20 7b 24 72 63 20 65 71 20 22      if {$rc eq "
0660: 53 51 4c 49 54 45 5f 4c 4f 43 4b 45 44 22 20 7c  SQLITE_LOCKED" |
0670: 7c 20 24 72 63 20 65 71 20 22 53 51 4c 49 54 45  | $rc eq "SQLITE
0680: 5f 42 55 53 59 22 7d 20 7b 0a 20 20 20 20 20 20  _BUSY"} {.      
0690: 20 20 23 73 71 6c 74 68 72 65 61 64 20 70 61 72    #sqlthread par
06a0: 65 6e 74 20 22 70 75 74 73 20 5c 22 74 68 72 65  ent "puts \"thre
06b0: 61 64 20 5b 73 71 6c 74 68 72 65 61 64 20 69 64  ad [sqlthread id
06c0: 5d 20 69 73 20 62 75 73 79 2e 20 20 72 63 3d 24  ] is busy.  rc=$
06d0: 72 63 5c 22 22 0a 20 20 20 20 20 20 20 20 61 66  rc\"".        af
06e0: 74 65 72 20 32 30 30 0a 20 20 20 20 20 20 7d 20  ter 200.      } 
06f0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 23  else {.        #
0700: 73 71 6c 74 68 72 65 61 64 20 70 61 72 65 6e 74  sqlthread parent
0710: 20 22 70 75 74 73 20 5c 22 74 68 72 65 61 64 20   "puts \"thread 
0720: 5b 73 71 6c 74 68 72 65 61 64 20 69 64 5d 20 72  [sqlthread id] r
0730: 61 6e 20 24 73 71 6c 5c 22 22 0a 20 20 20 20 20  an $sql\"".     
0740: 20 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 69 66   }.    }..    if
0750: 20 7b 24 72 63 20 6e 65 20 22 53 51 4c 49 54 45   {$rc ne "SQLITE
0760: 5f 4f 4b 22 7d 20 7b 0a 20 20 20 20 20 20 65 72  _OK"} {.      er
0770: 72 6f 72 20 24 65 72 72 74 78 74 0a 20 20 20 20  ror $errtxt.    
0780: 7d 0a 20 20 20 20 73 65 74 20 72 65 73 0a 20 20  }.    set res.  
0790: 7d 0a 0a 20 20 70 72 6f 63 20 64 6f 5f 74 65 73  }..  proc do_tes
07a0: 74 20 7b 6e 61 6d 65 20 73 63 72 69 70 74 20 72  t {name script r
07b0: 65 73 75 6c 74 7d 20 7b 0a 20 20 20 20 73 65 74  esult} {.    set
07c0: 20 72 65 73 20 5b 65 76 61 6c 20 24 73 63 72 69   res [eval $scri
07d0: 70 74 5d 0a 20 20 20 20 69 66 20 7b 24 72 65 73  pt].    if {$res
07e0: 20 6e 65 20 24 72 65 73 75 6c 74 7d 20 7b 0a 20   ne $result} {. 
07f0: 20 20 20 20 20 65 72 72 6f 72 20 22 24 6e 61 6d       error "$nam
0800: 65 20 66 61 69 6c 65 64 3a 20 65 78 70 65 63 74  e failed: expect
0810: 65 64 20 5c 22 24 72 65 73 75 6c 74 5c 22 20 67  ed \"$result\" g
0820: 6f 74 20 5c 22 24 72 65 73 5c 22 22 0a 20 20 20  ot \"$res\"".   
0830: 20 7d 0a 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 74   }.  }.}..proc t
0840: 68 72 65 61 64 5f 73 70 61 77 6e 20 7b 76 61 72  hread_spawn {var
0850: 6e 61 6d 65 20 61 72 67 73 7d 20 7b 0a 20 20 73  name args} {.  s
0860: 71 6c 74 68 72 65 61 64 20 73 70 61 77 6e 20 24  qlthread spawn $
0870: 76 61 72 6e 61 6d 65 20 5b 6a 6f 69 6e 20 24 61  varname [join $a
0880: 72 67 73 20 7b 3b 7d 5d 0a 7d 0a 0a 23 20 52 65  rgs {;}].}..# Re
0890: 74 75 72 6e 20 74 72 75 65 20 69 66 20 74 68 69  turn true if thi
08a0: 73 20 62 75 69 6c 64 20 63 61 6e 20 72 75 6e 20  s build can run 
08b0: 74 68 65 20 6d 75 6c 74 69 2d 74 68 72 65 61 64  the multi-thread
08c0: 65 64 20 74 65 73 74 73 2e 0a 23 0a 70 72 6f 63  ed tests..#.proc
08d0: 20 72 75 6e 5f 74 68 72 65 61 64 5f 74 65 73 74   run_thread_test
08e0: 73 20 7b 7b 70 72 69 6e 74 5f 77 61 72 6e 69 6e  s {{print_warnin
08f0: 67 20 30 7d 7d 20 7b 0a 20 20 69 66 63 61 70 61  g 0}} {.  ifcapa
0900: 62 6c 65 20 21 6d 75 74 65 78 20 7b 20 0a 20 20  ble !mutex { .  
0910: 20 20 73 65 74 20 7a 50 72 6f 62 6c 65 6d 20 22    set zProblem "
0920: 53 51 4c 69 74 65 20 62 75 69 6c 64 20 69 73 20  SQLite build is 
0930: 6e 6f 74 20 74 68 72 65 61 64 73 61 66 65 22 0a  not threadsafe".
0940: 20 20 7d 0a 20 20 69 66 63 61 70 61 62 6c 65 20    }.  ifcapable 
0950: 6d 75 74 65 78 5f 6e 6f 6f 70 20 7b 20 0a 20 20  mutex_noop { .  
0960: 20 20 73 65 74 20 7a 50 72 6f 62 6c 65 6d 20 22    set zProblem "
0970: 53 51 4c 69 74 65 20 62 75 69 6c 64 20 75 73 65  SQLite build use
0980: 73 20 53 51 4c 49 54 45 5f 4d 55 54 45 58 5f 4e  s SQLITE_MUTEX_N
0990: 4f 4f 50 22 0a 20 20 7d 0a 20 20 69 66 20 7b 5b  OOP".  }.  if {[
09a0: 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 73 71  info commands sq
09b0: 6c 74 68 72 65 61 64 5d 20 65 71 20 22 22 7d 20  lthread] eq ""} 
09c0: 7b 0a 20 20 20 20 73 65 74 20 7a 50 72 6f 62 6c  {.    set zProbl
09d0: 65 6d 20 22 53 51 4c 69 74 65 20 62 75 69 6c 64  em "SQLite build
09e0: 20 69 73 20 6e 6f 74 20 74 68 72 65 61 64 73 61   is not threadsa
09f0: 66 65 22 0a 20 20 7d 0a 20 20 69 66 20 7b 21 5b  fe".  }.  if {![
0a00: 69 6e 66 6f 20 65 78 69 73 74 73 20 3a 3a 74 63  info exists ::tc
0a10: 6c 5f 70 6c 61 74 66 6f 72 6d 28 74 68 72 65 61  l_platform(threa
0a20: 64 65 64 29 5d 7d 20 7b 0a 20 20 20 20 73 65 74  ded)]} {.    set
0a30: 20 7a 50 72 6f 62 6c 65 6d 20 22 4c 69 6e 6b 65   zProblem "Linke
0a40: 64 20 61 67 61 69 6e 73 74 20 61 20 6e 6f 6e 2d  d against a non-
0a50: 74 68 72 65 61 64 73 61 66 65 20 54 63 6c 20 62  threadsafe Tcl b
0a60: 75 69 6c 64 22 0a 20 20 7d 0a 20 20 69 66 20 7b  uild".  }.  if {
0a70: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 7a 50 72  [info exists zPr
0a80: 6f 62 6c 65 6d 5d 7d 20 7b 0a 20 20 20 20 70 75  oblem]} {.    pu
0a90: 74 73 20 22 57 41 52 4e 49 4e 47 3a 20 4d 75 6c  ts "WARNING: Mul
0aa0: 74 69 2d 74 68 72 65 61 64 65 64 20 74 65 73 74  ti-threaded test
0ab0: 73 20 73 6b 69 70 70 65 64 3a 20 24 7a 50 72 6f  s skipped: $zPro
0ac0: 62 6c 65 6d 22 0a 20 20 20 20 72 65 74 75 72 6e  blem".    return
0ad0: 20 30 0a 20 20 7d 0a 20 20 73 65 74 20 3a 3a 72   0.  }.  set ::r
0ae0: 75 6e 5f 74 68 72 65 61 64 5f 74 65 73 74 73 5f  un_thread_tests_
0af0: 63 61 6c 6c 65 64 20 31 0a 20 20 72 65 74 75 72  called 1.  retur
0b00: 6e 20 31 3b 0a 7d 0a 0a 72 65 74 75 72 6e 20 30  n 1;.}..return 0
0b10: 0a 0a                                            ..