Home | History | Annotate | Download | only in test 
      1 # 2008 October 6
      2 #
      3 # The author disclaims copyright to this source code.  In place of
      4 # a legal notice, here is a blessing:
      5 #
      6 #    May you do good and not evil.
      7 #    May you find forgiveness for yourself and forgive others.
      8 #    May you share freely, never taking more than you give.
      9 #
     10 #***********************************************************************
     11 # This file implements regression tests for SQLite library.  The
     12 # focus of this script is database locks.
     13 #
     14 # $Id: lock6.test,v 1.3 2009/02/05 16:31:46 drh Exp $
     15 
     16 
     17 set testdir [file dirname $argv0]
     18 source $testdir/tester.tcl
     19 
     20 # Launch another testfixture process to be controlled by this one. A
     21 # channel name is returned that may be passed as the first argument to proc
     22 # 'testfixture' to execute a command. The child testfixture process is shut
     23 # down by closing the channel.
     24 proc launch_testfixture {} {
     25   set prg [info nameofexec]
     26   if {$prg eq ""} {
     27     set prg [file join . testfixture]
     28   }
     29   set chan [open "|$prg tf_main2.tcl" r+]
     30   fconfigure $chan -buffering line
     31   return $chan
     32 }
     33 
     34 # Execute a command in a child testfixture process, connected by two-way
     35 # channel $chan. Return the result of the command, or an error message.
     36 proc testfixture {chan cmd} {
     37   puts $chan $cmd
     38   puts $chan OVER
     39   set r ""
     40   while { 1 } {
     41     set line [gets $chan]
     42     if { $line == "OVER" } { 
     43       return $r
     44     }
     45     append r $line
     46   }
     47 }
     48 
     49 # Write the main loop for the child testfixture processes into file
     50 # tf_main2.tcl. The parent (this script) interacts with the child processes
     51 # via a two way pipe. The parent writes a script to the stdin of the child
     52 # process, followed by the word "OVER" on a line of its own. The child
     53 # process evaluates the script and writes the results to stdout, followed
     54 # by an "OVER" of its own.
     55 set f [open tf_main2.tcl w]
     56 puts $f {
     57   set l [open log w]
     58   set script ""
     59   while {![eof stdin]} {
     60     flush stdout
     61     set line [gets stdin]
     62     puts $l "READ $line"
     63     if { $line == "OVER" } {
     64       catch {eval $script} result
     65       puts $result
     66       puts $l "WRITE $result"
     67       puts OVER
     68       puts $l "WRITE OVER"
     69       flush stdout
     70       set script ""
     71     } else {
     72       append script $line
     73       append script " ; "
     74     }
     75   }
     76   close $l
     77 }
     78 close $f
     79 
     80 
     81 ifcapable lock_proxy_pragmas&&prefer_proxy_locking {
     82   set sqlite_hostid_num 1
     83 
     84   set using_proxy 0
     85   foreach {name value} [array get env SQLITE_FORCE_PROXY_LOCKING] {
     86     set using_proxy $value
     87   }
     88 
     89   # Test the lock_proxy_file pragmas.
     90   #
     91   set env(SQLITE_FORCE_PROXY_LOCKING) "1"
     92 
     93   do_test lock6-1.1 {
     94     set ::tf1 [launch_testfixture]
     95     testfixture $::tf1 "sqlite3_test_control_pending_byte $::sqlite_pending_byte"
     96     testfixture $::tf1 {
     97       set sqlite_hostid_num 2    
     98       sqlite3 db test.db -key xyzzy
     99       set lockpath [db eval {
    100         PRAGMA lock_proxy_file=":auto:";
    101         select * from sqlite_master;
    102         PRAGMA lock_proxy_file;
    103       }]
    104       string match "*test.db:auto:" $lockpath
    105     }
    106   } {1}
    107   
    108   set sqlite_hostid_num 3   
    109   do_test lock6-1.2 {
    110     execsql {pragma lock_status}
    111   } {main unlocked temp closed}
    112 
    113   sqlite3_soft_heap_limit 0
    114   do_test lock6-1.3 {
    115     list [catch {
    116       sqlite3 db test.db
    117       execsql { select * from sqlite_master } 
    118     } msg] $msg
    119   } {1 {database is locked}}
    120 
    121   do_test lock6-1.4 {
    122     set lockpath [execsql {
    123       PRAGMA lock_proxy_file=":auto:";
    124       PRAGMA lock_proxy_file;
    125     } db]
    126     set lockpath
    127   } {{:auto: (not held)}}
    128 
    129   do_test lock6-1.4.1 {
    130     catchsql {
    131       PRAGMA lock_proxy_file="notmine";
    132       select * from sqlite_master;
    133     } db
    134   } {1 {database is locked}}
    135 
    136   do_test lock6-1.4.2 {
    137     execsql {
    138       PRAGMA lock_proxy_file;
    139     } db
    140   } {notmine}
    141     
    142   do_test lock6-1.5 {
    143     testfixture $::tf1 {
    144       db eval {
    145         BEGIN;
    146         SELECT * FROM sqlite_master;
    147       }
    148     }
    149   } {}
    150 
    151   catch {testfixture $::tf1 {db close}}
    152 
    153   do_test lock6-1.6 {
    154     execsql {
    155       PRAGMA lock_proxy_file="mine";
    156       select * from sqlite_master;
    157     } db
    158   } {}
    159   
    160   catch {close $::tf1}
    161   set env(SQLITE_FORCE_PROXY_LOCKING) $using_proxy
    162   set sqlite_hostid_num 0
    163 
    164   sqlite3_soft_heap_limit $cmdlinearg(soft-heap-limit)
    165 }
    166       
    167 finish_test
    168