1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TclScript/thread_common.tcl	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,88 @@
     1.4 +# 2007 September 10
     1.5 +#
     1.6 +# The author disclaims copyright to this source code.  In place of
     1.7 +# a legal notice, here is a blessing:
     1.8 +#
     1.9 +#    May you do good and not evil.
    1.10 +#    May you find forgiveness for yourself and forgive others.
    1.11 +#    May you share freely, never taking more than you give.
    1.12 +#
    1.13 +#***********************************************************************
    1.14 +#
    1.15 +# $Id: thread_common.tcl,v 1.2 2007/09/10 10:53:02 danielk1977 Exp $
    1.16 +
    1.17 +set testdir [file dirname $argv0]
    1.18 +source $testdir/tester.tcl
    1.19 +
    1.20 +if {[info commands sqlthread] eq ""} {
    1.21 +  puts -nonewline "Skipping thread-safety tests - "
    1.22 +  puts            " not running a threadsafe sqlite/tcl build"
    1.23 +  puts -nonewline "Both SQLITE_THREADSAFE and TCL_THREADS must be defined when"
    1.24 +  puts            " building testfixture"
    1.25 +  finish_test
    1.26 +  return
    1.27 +}
    1.28 +
    1.29 +# The following script is sourced by every thread spawned using 
    1.30 +# [sqlthread spawn]:
    1.31 +set thread_procs {
    1.32 +
    1.33 +  # Execute the supplied SQL using database handle $::DB.
    1.34 +  #
    1.35 +  proc execsql {sql} {
    1.36 +
    1.37 +    set rc SQLITE_LOCKED
    1.38 +    while {$rc eq "SQLITE_LOCKED" 
    1.39 +        || $rc eq "SQLITE_BUSY" 
    1.40 +        || $rc eq "SQLITE_SCHEMA"} {
    1.41 +      set res [list]
    1.42 +
    1.43 +      set err [catch {
    1.44 +        set ::STMT [sqlite3_prepare_v2 $::DB $sql -1 dummy_tail]
    1.45 +      } msg]
    1.46 +
    1.47 +      if {$err == 0} {
    1.48 +        while {[set rc [sqlite3_step $::STMT]] eq "SQLITE_ROW"} {
    1.49 +          for {set i 0} {$i < [sqlite3_column_count $::STMT]} {incr i} {
    1.50 +            lappend res [sqlite3_column_text $::STMT 0]
    1.51 +          }
    1.52 +        }
    1.53 +        set rc [sqlite3_finalize $::STMT]
    1.54 +      } else {
    1.55 +        if {[string first (6) $msg]} {
    1.56 +          set rc SQLITE_LOCKED
    1.57 +        } else {
    1.58 +          set rc SQLITE_ERROR
    1.59 +        }
    1.60 +      }
    1.61 +
    1.62 +      if {[string first locked [sqlite3_errmsg $::DB]]>=0} {
    1.63 +        set rc SQLITE_LOCKED
    1.64 +      }
    1.65 +
    1.66 +      if {$rc eq "SQLITE_LOCKED" || $rc eq "SQLITE_BUSY"} {
    1.67 + #puts -nonewline "([sqlthread id] $rc)"
    1.68 + #flush stdout
    1.69 +        after 20
    1.70 +      }
    1.71 +    }
    1.72 +
    1.73 +    if {$rc ne "SQLITE_OK"} {
    1.74 +      error "$rc - [sqlite3_errmsg $::DB]"
    1.75 +    }
    1.76 +    set res
    1.77 +  }
    1.78 +
    1.79 +  proc do_test {name script result} {
    1.80 +    set res [eval $script]
    1.81 +    if {$res ne $result} {
    1.82 +      error "$name failed: expected \"$result\" got \"$res\""
    1.83 +    }
    1.84 +  }
    1.85 +}
    1.86 +
    1.87 +proc thread_spawn {varname args} {
    1.88 +  sqlthread spawn $varname [join $args ;]
    1.89 +}
    1.90 +
    1.91 +return 0