sqlite/test/lock2.test

# 2001 September 15
#
# The author disclaims copyright to this source code.  In place of
# a legal notice, here is a blessing:
#
#    May you do good and not evil.
#    May you find forgiveness for yourself and forgive others.
#    May you share freely, never taking more than you give.
#
#***********************************************************************
# This file implements regression tests for SQLite library.  The
# focus of this script is database locks between competing processes.
#
# $Id: lock2.test,v 1.3 2004/07/22 15:02:26 drh Exp $


set testdir [file dirname $argv0]
source $testdir/tester.tcl

# Launch another testfixture process to be controlled by this one. A
# channel name is returned that may be passed as the first argument to proc
# 'testfixture' to execute a command. The child testfixture process is shut
# down by closing the channel.
proc launch_testfixture {} {
  set chan [open "|[file join . testfixture] tf_main.tcl" r+]
  fconfigure $chan -buffering line
  return $chan
}

# Execute a command in a child testfixture process, connected by two-way
# channel $chan. Return the result of the command, or an error message.
proc testfixture {chan cmd} {
  puts $chan $cmd
  puts $chan OVER
  set r ""
  while { 1 } {
    set line [gets $chan]
    if { $line == "OVER" } { 
      return $r
    }
    append r $line
  }
}

# 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 it's 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" } {
      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 " ; "
    }
  }
  close $l
}
close $f

# Simple locking test case:
#
# lock2-1.1: Connect a second process to the database.
# lock2-1.2: Establish a RESERVED lock with this process.
# lock2-1.3: Get a SHARED lock with the second process.
# lock2-1.4: Try for a RESERVED lock with process 2. This fails.
# lock2-1.5: Try to upgrade the first process to EXCLUSIVE, this fails so
#            it gets PENDING.
# lock2-1.6: Release the SHARED lock held by the second process. 
# lock2-1.7: Attempt to reaquire a SHARED lock with the second process.
#            this fails due to the PENDING lock.
# lock2-1.8: Ensure the first process can now upgrade to EXCLUSIVE.
#
do_test lock2-1.1 {
  set ::tf1 [launch_testfixture]
  testfixture $::tf1 {
    sqlite3 db test.db -key xyzzy
    db eval {select * from sqlite_master}
  }
} {}
do_test lock2-1.2 {
  execsql {
    BEGIN;
    CREATE TABLE abc(a, b, c);
  }
} {}
do_test lock2-1.3 {
  testfixture $::tf1 {
    db eval {
      BEGIN;
      SELECT * FROM sqlite_master;
    }
  }
} {}
do_test lock2-1.4 {
  testfixture $::tf1 {
    db eval {
      CREATE TABLE def(d, e, f)
    }
  }
} {database is locked}
do_test lock2-1.5 {
  catchsql {
    COMMIT;
  }
} {1 {database is locked}}
do_test lock2-1.6 {
  testfixture $::tf1 {
    db eval {
      SELECT * FROM sqlite_master;
      COMMIT;
    }
  }
} {}
do_test lock2-1.7 {
  testfixture $::tf1 {
    db eval {
      BEGIN;
      SELECT * FROM sqlite_master;
    }
  }
} {database is locked}
do_test lock2-1.8 {
  catchsql {
    COMMIT;
  }
} {0 {}}
do_test lock2-1.9 {
  execsql {
    SELECT * FROM sqlite_master;
  }
} {table abc abc 2 {CREATE TABLE abc(a, b, c)}}
do_test lock2-1.10 {
  testfixture $::tf1 {
    db eval {
      SELECT * FROM sqlite_master;
    }
  }
} {table abc abc 2 {CREATE TABLE abc(a, b, c)}}

catch {testfixture $::tf1 {db close}}
catch {close $::tf1}

finish_test