Return to lock6.test CVS log

Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / test

Annotation of embedaddon/sqlite3/test/lock6.test, revision 1.1

1.1     ! misho       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