home *** CD-ROM | disk | FTP | other *** search
/ Serving the Web / ServingTheWeb1995.disc1of1.iso / linux / slacksrce / tcl / tcl+tk+t / tclx7.3bl / tclx7 / tclX7.3b / tests / flock.test < prev    next >
Encoding:
Text File  |  1994-07-16  |  6.8 KB  |  260 lines
  1. #
  2. # filecmds.test
  3. #
  4. # Tests for the flock and funlock commands.
  5. #---------------------------------------------------------------------------
  6. # Copyright 1992-1994 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: flock.test,v 4.0 1994/07/16 05:24:50 markd Rel $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. if {[info procs test] != "test"} then {source testlib.tcl}
  20.  
  21. if ![infox have_flock] {
  22.     puts "File locking is not available on this system, tests skipped"
  23.     return
  24. }
  25.  
  26. unlink -nocomplain {FLOCKR.TMP FLOCKRW.TMP FLOCKW.TMP}
  27.  
  28.  
  29. #
  30. # Fork without exec will not work under Tk, skip this test
  31. #
  32. if ![lempty [info commands button]] {
  33.     puts "*************************************************************"
  34.     puts "Flock tests are constructed in a way that does not work"
  35.     puts "under Tk.  Test skipped."
  36.     puts "*************************************************************"
  37.     puts ""
  38.     return
  39. }
  40.  
  41. #
  42. # Create and open a read file and a write file.
  43. #
  44. unlink -nocomplain {FLOCKR.TMP FLOCKW.TMP}
  45.  
  46. foreach X {R W RW} {
  47.     set fh [open FLOCK${X}.TMP w]
  48.     puts $fh [replicate X 100]
  49.     close $fh
  50. }
  51.  
  52. set readFH  [open FLOCKR.TMP r]
  53. set writeFH [open FLOCKW.TMP w]
  54. set rdwrFH  [open FLOCKRW.TMP r+]
  55.  
  56. #
  57. # Check flock argument checking
  58. #
  59.  
  60. set flockWrongArgs {wrong # args: flock ?-read|-write? ?-nowait? fileId ?start? ?length? ?origin?}
  61.  
  62. Test flock-1.1 {flock argument checking} {
  63.     flock
  64. } 1 $flockWrongArgs
  65.  
  66. Test flock-1.2 {flock argument checking} {
  67.     flock $readFH 0 0 0 0
  68. } 1 $flockWrongArgs
  69.  
  70. Test flock-1.3 {flock argument checking} {
  71.     flock -writx $readFH
  72. } 1 {invalid option "-writx" expected one of "-read", "-write", or "-nowait"}
  73.  
  74. Test flock-1.4 {flock argument checking} {
  75.     flock -nowait
  76. } 1 $flockWrongArgs
  77.  
  78. Test flock-1.5 {flock argument checking} {
  79.     flock foofile
  80. } 1 {bad file identifier "foofile"}
  81.  
  82. Test flock-1.6 {flock argument checking} {
  83.     flock $readFH x
  84. } 1 {expected integer but got "x"}
  85.  
  86. Test flock-1.7 {flock argument checking} {
  87.     flock $readFH 1 x
  88. } 1 {expected integer but got "x"}
  89.  
  90. Test flock-1.8 {flock argument checking} {
  91.     flock $readFH {} x
  92. } 1 {expected integer but got "x"}
  93.  
  94. Test flock-1.9 {flock argument checking} {
  95.     flock $readFH {} 1 bad
  96. } 1 {bad origin "bad": should be "start", "current", or "end"}
  97.  
  98. Test flock-1.10 {flock argument checking} {
  99.     flock -read -write $rdwrFH 
  100. } 1 {can not specify both "-read" and "-write"}
  101.  
  102.  
  103. #
  104. # Check funlock argument checking
  105. #
  106.  
  107. set funlockWrongArgs {wrong # args: funlock fileId ?start? ?length? ?origin?}
  108.  
  109. Test flock-2.1 {funlock argument checking} {
  110.     funlock
  111. } 1 $funlockWrongArgs
  112.  
  113. Test flock-2.2 {funlock argument checking} {
  114.     funlock $readFH 0 0 0 0
  115. } 1 $funlockWrongArgs
  116.  
  117. Test flock-2.3 {funlock argument checking} {
  118.     funlock -write $readFH
  119. } 1  {bad file identifier "-write"}
  120.  
  121. Test flock-2.4 {funlock argument checking} {
  122.     funlock foofile
  123. } 1 {bad file identifier "foofile"}
  124.  
  125. Test flock-2.5 {funlock argument checking} {
  126.     funlock $readFH x
  127. } 1 {expected integer but got "x"}
  128.  
  129. Test flock-2.6 {funlock argument checking} {
  130.     funlock $readFH 1 x
  131. } 1 {expected integer but got "x"}
  132.  
  133. Test flock-2.7 {funlock argument checking} {
  134.     funlock $readFH {} x
  135. } 1 {expected integer but got "x"}
  136.  
  137. Test flock-2.8 {funlock argument checking} {
  138.     funlock $readFH {} 1 bad
  139. } 1 {bad origin "bad": should be "start", "current", or "end"}
  140.  
  141. #
  142. # If problems with acquiring locks, bail out now, as some tests may hang.
  143. # Suns are especially bad at hanging. It appears that having some data in
  144. # a file and only locking part of it will cause this test to fail rather
  145. # than hang on a confused system.
  146. #
  147. alarm 10
  148. puts $writeFH "This is some silly text to help prevent hangs"
  149. flush $writeFH
  150. if {[catch {flock $writeFH 0 8} msg] != 0} {
  151.     alarm 0
  152.     puts "*************************************************************"
  153.     puts "Error acquiring file lock.  This is probably caused by an"
  154.     puts "incorrectly configured system or bug in the system software."
  155.     puts "If NFS is involved, make sure lockd is correctly configured"
  156.     puts "The error message returned was:"
  157.     puts "    $msg"
  158.     puts "*************************************************************"
  159.     catch {close $writeFH}
  160.     catch {close $readFH}
  161.     catch {close $rdwrFH}
  162.     unlink -nocomplain {FLOCKR.TMP FLOCKRW.TMP FLOCKW.TMP}
  163.     return
  164. }
  165. alarm 0
  166. funlock $writeFH
  167.  
  168. #
  169. # Check locking read/write access checking.
  170. #
  171.  
  172. Test flock-3.1 {flock argument checking} {
  173.     flock $readFH
  174. } 1 {file not open for writing}
  175.  
  176. Test flock-3.2 {flock argument checking} {
  177.     flock -write $readFH 
  178. } 1 {file not open for writing}
  179.  
  180. Test flock-3.3 {flock argument checking} {
  181.     flock -read $writeFH 
  182. } 1 {file not open for reading}
  183.  
  184. #
  185. # Check locking of a file that is not locked
  186. #
  187.  
  188. Test flock-4.1 {flock/unlock of a file that is not locked} {
  189.    flock $writeFH
  190.    funlock $writeFH
  191. } 0 {}
  192.  
  193. Test flock-4.2 {flock/unlock of a file that is not locked} {
  194.    flock -write $writeFH
  195.    funlock $writeFH
  196. } 0 {}
  197.  
  198. Test flock-4.3 {flock/unlock of a file that is not locked} {
  199.    flock -write $rdwrFH
  200.    funlock $rdwrFH
  201. } 0 {}
  202.  
  203. Test flock-4.4 {flock/unlock of a file that is not locked} {
  204.    flock -read $readFH
  205.    funlock $readFH
  206. } 0 {}
  207.  
  208. #
  209. # Start a process to lock a file.  A pipe will be used to report when its
  210. # locked.
  211.  
  212. pipe fromChild toParent
  213. flush stdout
  214. flush stderr
  215. set lockerPid [fork]
  216. if {$lockerPid == 0} {
  217.    flock $writeFH
  218.    flock $rdwrFH 0 10
  219.    puts $toParent "*I am ready*"
  220.    flush $toParent
  221.    while 1 {sleep 20}
  222.    exit 0
  223. }
  224. if {([gets $fromChild line] < 0) || ([set line] != "*I am ready*")} {
  225.    error "Unexpected response from flock test child: $line"}
  226.  
  227. Test flock-5.1 {flock of file locked by child process} {
  228.    flock -nowait $writeFH
  229. } 0 0
  230.  
  231. Test flock-5.2 {flock of file locked by child process} {
  232.    flock -nowait $rdwrFH 0 5
  233. } 0 0
  234.  
  235. Test flock-5.3 {flock of file locked by child process} {
  236.    flock -nowait $rdwrFH 0 5 start
  237. } 0 0
  238.  
  239. set rdwrSize [fstat $rdwrFH size]
  240.  
  241. Test flock-5.4 {flock of file locked by child process} {
  242.    flock -nowait $rdwrFH -$rdwrSize 5 end
  243. } 0 0
  244.  
  245. Test flock-5.4 {flock of file locked by child process} {
  246.    set stat [flock -nowait $rdwrFH 10 12 start]
  247.    funlock $rdwrFH 10 12 start
  248.    set stat
  249. } 0 1
  250.  
  251. kill $lockerPid
  252. wait $lockerPid
  253.  
  254. catch {close $readFH}
  255. catch {close $writeFH}
  256. catch {close $rdwrFH}
  257. catch {close $fromChild}
  258. catch {close $toParent}
  259. unlink -nocomplain {FLOCKR.TMP FLOCKRW.TMP FLOCKW.TMP}
  260.