SQLite

static Tcl_ObjCmdProc sqlthread_proc;
static Tcl_ObjCmdProc clock_seconds_proc;
#if defined(SQLITE_OS_UNIX) && defined(SQLITE_ENABLE_UNLOCK_NOTIFY)
static Tcl_ObjCmdProc blocking_step_proc;
static Tcl_ObjCmdProc blocking_prepare_v2_proc;
#endif
int Sqlitetest1_Init(Tcl_Interp *);
int Sqlite3_Init(Tcl_Interp *);

/* Functions from test1.c */
void *sqlite3TestTextToPtr(const char *);
const char *sqlite3TestErrorName(int);
int getDbPointer(Tcl_Interp *, const char *, sqlite3 **);
int sqlite3TestMakePointerStr(Tcl_Interp *, char *, void *);
int sqlite3TestErrCode(Tcl_Interp *, sqlite3 *, int);

  Tcl_CreateObjCommand(interp, 
      "sqlite3_blocking_prepare_v2", blocking_prepare_v2_proc, (void *)1, 0);
  Tcl_CreateObjCommand(interp, 
      "sqlite3_nonblocking_prepare_v2", blocking_prepare_v2_proc, 0, 0);
#endif
  Sqlitetest1_Init(interp);
  Sqlitetest_mutex_Init(interp);
  Sqlite3_Init(interp);

  rc = Tcl_Eval(interp, p->zScript);
  pRes = Tcl_GetObjResult(interp);
  pList = Tcl_NewObj();
  Tcl_IncrRefCount(pList);
  Tcl_IncrRefCount(pRes);

  if( pLog->isLocked ){
    assert( pLog->isLocked==LOG_REGION_A || pLog->isLocked==LOG_REGION_D );
    logLockRegion(pLog, pLog->isLocked, LOG_UNLOCK);
  }
  pLog->isLocked = 0;
}

/*
** Read a page from the log, if it is present. 
*/
int sqlite3WalRead(Log *pLog, Pgno pgno, int *pInLog, u8 *pOut){
  LogSummary *pSummary = pLog->pSummary;
  u32 iRead = 0;
  u32 *aData; 
  int iFrame = (pLog->hdr.iLastPg & 0xFFFFFF00);

    }
    if {[eof $chan]} {
      return "ERROR: Child process hung up"
    }
    append r $line
  }
}

proc testfixture_nb_cb {varname chan} {
  set line [gets $chan]
  if { $line == "OVER" } {
    set $varname $::tfnb($chan)
    unset ::tfnb($chan)
    close $chan
  } else {
    append ::tfnb($chan) $line
  }
}

proc testfixture_nb {varname cmd} {
  set chan [launch_testfixture]
  set ::tfnb($chan) ""
  fconfigure $chan -blocking 0 -buffering none
  puts $chan $cmd
  puts $chan OVER
  fileevent $chan readable [list testfixture_nb_cb $varname $chan]
  return ""
}

# Write the main loop for the child testfixture processes into file
# tf_main.tcl. The parent (this script) interacts with the child processes
# via a two way pipe. The parent writes a script to the stdin of the child
# process, followed by the word "OVER" on a line of its own. The child
# process evaluates the script and writes the results to stdout, followed
# by an "OVER" of its own.
set f [open tf_main.tcl w]
puts $f {
  set l [open log w]
  set script ""
  while {![eof stdin]} {
    flush stdout
    set line [gets stdin]
    puts $l "READ $line"
    if { $line == "OVER" } {
      set rc [catch {eval $script} result]
      puts $result
      puts $l "WRITE $result"
      puts OVER
      puts $l "WRITE OVER"
      flush stdout
      set script ""
    } else {
      append script $line
      append script "\n"
    }
  }
  close $l
}
close $f

# focus of this file is testing the operation of the library in
# "PRAGMA journal_mode=WAL" mode with multiple threads.
#

set testdir [file dirname $argv0]

source $testdir/tester.tcl
source $testdir/lock_common.tcl
if {[run_thread_tests]==0} { finish_test ; return }

set sqlite_walsummary_mmap_incr 64

# The number of threads to start. And the amount of time to run the test
# for. Respectively.
#
set NTHREAD 10
set SECONDS 5

# The parameter is the name of a variable in the callers context. The
# variable may or may not exist when this command is invoked.
#
# If the variable does exist, its value is returned. Otherwise, this
# command uses [vwait] to wait until it is set, then returns the value.
# In other words, this is a version of the [set VARNAME] command that
# blocks until a variable exists.
#
proc wait_for_var {varname} {
  if {0==[uplevel [list info exists $varname]]} {
    uplevel [list vwait $varname]
  }
  uplevel [list set $varname]
}

proc lshift {lvar} {
  upvar $lvar L
  set ret [lindex $L 0]
  set L [lrange $L 1 end]


  return $ret
}


#-------------------------------------------------------------------------
#   do_thread_test TESTNAME OPTIONS...
# 
# where OPTIONS are: 
#
#   -seconds   SECONDS                How many seconds to run the test for
#   -init      SCRIPT                 Script to run before test.
#   -thread    NAME COUNT SCRIPT      Scripts to run in threads (or processes).
#   -processes BOOLEAN                True to use processes instead of threads.
#
proc do_thread_test {args} {
  set A $args


  set P(testname) [lshift A]
  set P(seconds) 5
  set P(init) ""
  set P(threads) [list]
  set P(processes) 0

  unset -nocomplain ::done

  while {[llength $A]>0} {
    set a [lshift A]
    switch -glob -- $a {
      -seconds {
        set P(seconds) [lshift A]
      }

      -init {
        set P(init) [lshift A]
      }

      -processes {
        set P(processes) [lshift A]
      }

      -thread {
        set name  [lshift A]
        set count [lshift A]
        set prg   [lshift A]
        lappend P(threads) [list $name $count $prg]
      }

      default {
        error "Unknown option: $a"
      }
    }
  }

  puts "Running $P(testname) for $P(seconds) seconds..."

  catch { db close }
  file delete -force test.db test.db-journal test.db-wal

  sqlite3 db test.db
  eval $P(init)
  db close

  foreach T $P(threads) {
    set name  [lindex $T 0]
    set count [lindex $T 1]
    set prg   [lindex $T 2]

    for {set i 1} {$i <= $count} {incr i} {
      set program [string map [list %TEST% $prg %SECONDS% $P(seconds) %I% $i] {

        set tid %I%

        proc usleep {ms} {
          set ::usleep 0
          after $ms {set ::usleep 1}
          vwait ::usleep
        }
        proc busyhandler {n} { usleep 10 ; return 0 }

        sqlite3 db test.db
        db busy busyhandler
        db eval { SELECT randomblob($tid*5) }

        set ::finished 0
        after [expr %SECONDS% * 1000] {set ::finished 1}
        proc tt_continue {} { expr ($::finished==0) }

        set rc [catch { %TEST% } msg]

        db close
        list $rc $msg
      }]

      if {$P(processes)==0} {
        sqlthread spawn ::done($name,$i) $program
      } else {
        testfixture_nb ::done($name,$i) $program
      }
    }
  }

  set report "  Results:"
  foreach T $P(threads) {
    set name  [lindex $T 0]
    set count [lindex $T 1]
    set prg   [lindex $T 2]

    set reslist [list]
    for {set i 1} {$i <= $count} {incr i} {
      set res [wait_for_var ::done($name,$i)]
      lappend reslist [lindex $res 1]
      do_test $P(testname).$name.$i [list lindex $res 0] 0
    }

    append report "   $name $reslist"
  }
  puts $report
}

#--------------------------------------------------------------------------
# Start NTHREAD threads. Each thread performs both read and write 
# transactions. Each read transaction consists of:
#
#   1) Reading the md5sum of all but the last table row,
#   2) Running integrity check.
#   3) Reading the value stored in the last table row,
#   4) Check that the values read in steps 1 and 3 are the same, and that
#      the md5sum of all but the last table row has not changed.
#
# Each write transaction consists of:
#
#   1) Modifying the contents of t1 (inserting, updating, deleting rows).
#   2) Appending a new row to the table containing the md5sum() of all
#      rows in the table.
#
# Each of the N threads runs N read transactions followed by a single write
# transaction in a loop as fast as possible.
#
# Ther is also a single checkpointer thread. It runs the following loop:
#
#   1) Execute "PRAGMA checkpoint"
#   2) Sleep for 500 ms.
#






foreach {mode name} {
      0 walthread-1-threads 
      1 walthread-1-processes





} {

  do_thread_test $name -processes $mode -seconds $SECONDS -init {

    execsql {

      PRAGMA journal_mode = WAL;

      CREATE TABLE t1(x PRIMARY KEY);


      PRAGMA lock_status;
      INSERT INTO t1 VALUES(randomblob(100));
      INSERT INTO t1 VALUES(randomblob(100));
      INSERT INTO t1 SELECT md5sum(x) FROM t1;
    }




  } -thread main $NTHREAD {
  
    proc read_transaction {} {
      set results [db eval {
        BEGIN;
          PRAGMA integrity_check;
          SELECT md5sum(x) FROM t1 WHERE rowid != (SELECT max(rowid) FROM t1);
          SELECT x FROM t1 WHERE rowid = (SELECT max(rowid) FROM t1);


          SELECT md5sum(x) FROM t1 WHERE rowid != (SELECT max(rowid) FROM t1);
        COMMIT;
      }]
  

      if {[llength $results]!=4
       || [lindex $results 0] != "ok"


       || [lindex $results 1] != [lindex $results 2]
       || [lindex $results 2] != [lindex $results 3]
      } {
        error "Failed read transaction: $results"
      }
    }
















  



    proc write_transaction {} {
      db eval {


        BEGIN;


          INSERT INTO t1 VALUES(randomblob(100));


          INSERT INTO t1 VALUES(randomblob(100));
          INSERT INTO t1 SELECT md5sum(x) FROM t1;




        COMMIT;

      }


    }
  
    set nRun 0

    while {[tt_continue]} {


      read_transaction
      write_transaction 
      usleep 1
      incr nRun
    }
    set nRun


  
  } -thread ckpt 1 {
    set nRun 0
    while {[tt_continue]} {







      db eval "PRAGMA checkpoint"
      usleep 500




      incr nRun
    }
    set nRun
  }



}


finish_test