15821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 2007 September 10 25821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 35821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# The author disclaims copyright to this source code. In place of 45821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# a legal notice, here is a blessing: 55821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 65821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# May you do good and not evil. 75821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# May you find forgiveness for yourself and forgive others. 85821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# May you share freely, never taking more than you give. 95821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#*********************************************************************** 115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# $Id: thread_common.tcl,v 1.5 2009/03/26 14:48:07 danielk1977 Exp $ 135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)if {[info exists ::thread_procs]} { 155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 0 165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# The following script is sourced by every thread spawned using 195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# [sqlthread spawn]: 205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)set thread_procs { 215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) # Execute the supplied SQL using database handle $::DB. 235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) # 245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) proc execsql {sql} { 255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set rc SQLITE_LOCKED 275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while {$rc eq "SQLITE_LOCKED" 285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) || $rc eq "SQLITE_BUSY" 295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) || $rc eq "SQLITE_SCHEMA"} { 305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set res [list] 315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) enter_db_mutex $::DB 335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set err [catch { 345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set ::STMT [sqlite3_prepare_v2 $::DB $sql -1 dummy_tail] 355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } msg] 365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$err == 0} { 385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while {[set rc [sqlite3_step $::STMT]] eq "SQLITE_ROW"} { 395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for {set i 0} {$i < [sqlite3_column_count $::STMT]} {incr i} { 405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) lappend res [sqlite3_column_text $::STMT 0] 415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set rc [sqlite3_finalize $::STMT] 445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } else { 455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {[lindex $msg 0]=="(6)"} { 465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set rc SQLITE_LOCKED 475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } else { 485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set rc SQLITE_ERROR 495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {[string first locked [sqlite3_errmsg $::DB]]>=0} { 535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set rc SQLITE_LOCKED 545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$rc ne "SQLITE_OK"} { 565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set errtxt "$rc - [sqlite3_errmsg $::DB] (debug1)" 575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) leave_db_mutex $::DB 595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$rc eq "SQLITE_LOCKED" || $rc eq "SQLITE_BUSY"} { 615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) #sqlthread parent "puts \"thread [sqlthread id] is busy. rc=$rc\"" 625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) after 200 635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } else { 645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) #sqlthread parent "puts \"thread [sqlthread id] ran $sql\"" 655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$rc ne "SQLITE_OK"} { 695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) error $errtxt 705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set res 725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) proc do_test {name script result} { 755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set res [eval $script] 765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$res ne $result} { 775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) error "$name failed: expected \"$result\" got \"$res\"" 785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)proc thread_spawn {varname args} { 835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) sqlthread spawn $varname [join $args {;}] 845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# Return true if this build can run the multi-threaded tests. 875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)proc run_thread_tests {{print_warning 0}} { 895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ifcapable !mutex { 905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set zProblem "SQLite build is not threadsafe" 915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ifcapable mutex_noop { 935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set zProblem "SQLite build uses SQLITE_MUTEX_NOOP" 945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {[info commands sqlthread] eq ""} { 965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set zProblem "SQLite build is not threadsafe" 975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {![info exists ::tcl_platform(threaded)]} { 995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set zProblem "Linked against a non-threadsafe Tcl build" 1005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {[info exists zProblem]} { 1025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) puts "WARNING: Multi-threaded tests skipped: $zProblem" 1035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 0 1045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set ::run_thread_tests_called 1 1065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 1; 1075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 1085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)return 0 1105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 111