#
# flock.test
#
# Tests for the flock and funlock commands.
#---------------------------------------------------------------------------
# Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id: flock.test,v 1.2 2002/04/02 02:29:43 hobbs Exp $
#------------------------------------------------------------------------------
#

if {[cequal [info procs Test] {}]} {
    source [file join [file dirname [info script]] testlib.tcl]
}

if ![infox have_flock] {
    if [cequal $tcl_platform(platform) windows] {
        puts "File locking is not available on this Unix system, tests skipped"
    } else {
        puts "File locking is not available on this version of Windows"
    }
    return
}

TestRemove FLOCKR.TMP FLOCKRW.TMP FLOCKW.TMP FLOCK.PRG

#
# Create and open a read file and a write file.
#

foreach X {R W RW} {
    set fh [open FLOCK${X}.TMP w]
    puts $fh [replicate X 100]
    close $fh
}

set readFH  [open FLOCKR.TMP r]
set writeFH [open FLOCKW.TMP w]
set rdwrFH  [open FLOCKRW.TMP r+]


#
# Check flock argument checking
#
set flockWrongArgs {wrong # args: flock ?-read|-write? ?-nowait? fileId ?start? ?length? ?origin?}

Test flock-1.1 {flock argument checking} {
    flock
} 1 $flockWrongArgs

Test flock-1.2 {flock argument checking} {
    flock $readFH 0 0 0 0
} 1 $flockWrongArgs

Test flock-1.3 {flock argument checking} {
    flock -writx $readFH
} 1 {invalid option "-writx" expected one of "-read", "-write", or "-nowait"}

Test flock-1.4 {flock argument checking} {
    flock -nowait
} 1 $flockWrongArgs

Test flock-1.5 {flock argument checking} {
    flock foofile
} 1 {can not find channel named "foofile"}

Test flock-1.6 {flock argument checking} {
    flock -read $readFH x
} 1 {expected integer but got "x"}

Test flock-1.7 {flock argument checking} {
    flock -read $readFH 1 x
} 1 {expected integer but got "x"}

Test flock-1.8 {flock argument checking} {
    flock -read $readFH {} x
} 1 {expected integer but got "x"}

Test flock-1.9 {flock argument checking} {
    flock -read $readFH {} 1 bad
} 1 {bad origin "bad": should be "start", "current", or "end"}

Test flock-1.10 {flock argument checking} {
    flock -read -write $rdwrFH 
} 1 {can not specify both "-read" and "-write"}


#
# Check funlock argument checking
#

set funlockWrongArgs {wrong # args: funlock fileId ?start? ?length? ?origin?}

Test flock-2.1 {funlock argument checking} {
    funlock
} 1 $funlockWrongArgs

Test flock-2.2 {funlock argument checking} {
    funlock $readFH 0 0 0 0
} 1 $funlockWrongArgs

Test flock-2.3 {funlock argument checking} {
    funlock -write $readFH
} 1  {can not find channel named "-write"}

Test flock-2.4 {funlock argument checking} {
    funlock foofile
} 1 {can not find channel named "foofile"}

Test flock-2.5 {funlock argument checking} {
    funlock $readFH x
} 1 {expected integer but got "x"}

Test flock-2.6 {funlock argument checking} {
    funlock $readFH 1 x
} 1 {expected integer but got "x"}

Test flock-2.7 {funlock argument checking} {
    funlock $readFH {} x
} 1 {expected integer but got "x"}

Test flock-2.8 {funlock argument checking} {
    funlock $readFH {} 1 bad
} 1 {bad origin "bad": should be "start", "current", or "end"}

#
# If problems with acquiring locks, bail out now, as some tests may hang.
# Suns are especially bad at hanging. It appears that having some data in
# a file and only locking part of it will cause this test to fail rather
# than hang on a confused system.
#
if [cequal $tcl_platform(platform) "unix"] { ;# FIX: port to win
alarm 10
}
puts $writeFH "This is some silly text to help prevent hangs"
flush $writeFH
if {[catch {flock $writeFH 0 8} msg] != 0} {
    if [cequal $tcl_platform(platform) "unix"] { ;# FIX: port to win
    alarm 0
    }
    puts "*************************************************************"
    puts "Error acquiring file lock.  This is probably caused by an"
    puts "incorrectly configured system or bug in the system software."
    puts "If NFS is involved, make sure lockd is correctly configured"
    puts "The error message returned was:"
    puts "    $msg"
    puts "*************************************************************"
    catch {close $writeFH}
    catch {close $readFH}
    catch {close $rdwrFH}
    TestRemove FLOCKR.TMP FLOCKW.TMP FLOCKRW.TMP FLOCK.PRG
    return
}
if [cequal $tcl_platform(platform) "unix"] { ;# FIX: port to win
alarm 0
}
funlock $writeFH 0 8

#
# Check locking read/write access checking.
#

Test flock-3.1 {flock argument checking} {
    flock $readFH
} 1 "channel \"$readFH\" wasn't opened for writing"
Test flock-3.2 {flock argument checking} {
    flock -write $readFH 
} 1 "channel \"$readFH\" wasn't opened for writing"

Test flock-3.3 {flock argument checking} {
    flock -read $writeFH 
} 1 "channel \"$writeFH\" wasn't opened for reading"

#
# Check locking of a file that is not locked
#

Test flock-4.1 {flock/unlock of a file that is not locked} {
   flock $writeFH
   funlock $writeFH
} 0 {}

Test flock-4.2 {flock/unlock of a file that is not locked} {
   flock -write $writeFH
   funlock $writeFH
} 0 {}

Test flock-4.3 {flock/unlock of a file that is not locked} {
   flock -write $rdwrFH
   funlock $rdwrFH
} 0 {}

Test flock-4.4 {flock/unlock of a file that is not locked} {
   flock -read $readFH
   funlock $readFH
} 0 {}

#
# Start a process to lock a file.  Write something to stdout to indicate
# that the process is running.  Wait for something on stdin to exit.
#
set fh [open FLOCK.PRG w]
puts $fh {
    package require Tclx
    fconfigure stdout -buffering line
    set writeFH [open FLOCKW.TMP WRONLY]
    set rdwrFH [open FLOCKRW.TMP RDWR]
    flock $writeFH
    flock $rdwrFH 0 10
    puts "*I am ready*"
    if {[gets stdin line] < 0} {
        puts stderr "unexpected EOF in flock child"
        exit 1
    }
    if ![cequal $line "*STOP, Please*"] {
        puts stderr "unexpected input in flock child: \"$line\""
        exit 1
    }
    exit 0
}
close $fh

set childFH [open "|[list $::tcltest::tcltest FLOCK.PRG]" r+]

if {[gets $childFH line] < 0} {
    error "Unexpected EOF from flock test child"
}
if ![cequal $line "*I am ready*"] {
    error "Unexpected response from flock test child: $line"
}

Test flock-5.1 {flock of file locked by child process} {
   flock -nowait $writeFH
} 0 0

Test flock-5.2 {flock of file locked by child process} {
   flock -nowait $rdwrFH 0 5
} 0 0

Test flock-5.3 {flock of file locked by child process} {
   flock -nowait $rdwrFH 0 5 start
} 0 0

set rdwrSize [fstat $rdwrFH size]

Test flock-5.4 {flock of file locked by child process} {
   flock -nowait $rdwrFH -$rdwrSize 5 end
} 0 0

Test flock-5.4 {flock of file locked by child process} {
   set stat [flock -nowait $rdwrFH 10 12 start]
   funlock $rdwrFH 10 12 start
   set stat
} 0 1

puts $childFH "*STOP, Please*"
flush $childFH
close $childFH

catch {close $readFH}
catch {close $writeFH}
catch {close $rdwrFH}
TestRemove FLOCKR.TMP FLOCKW.TMP FLOCKRW.TMP FLOCK.PRG