1b39c5158Smillert#!perl -w 2b39c5158Smillert# Test O_EXLOCK 3b39c5158Smillert 4b39c5158Smillertuse Test::More; 5b39c5158Smillertuse strict; 6b39c5158Smillertuse Fcntl; 7b39c5158Smillert 8b39c5158SmillertBEGIN { 9b39c5158Smillert# see if we have O_EXLOCK 10b39c5158Smillert eval { &Fcntl::O_EXLOCK; }; 11b39c5158Smillert if ($@) { 12b39c5158Smillert plan skip_all => 'Do not seem to have O_EXLOCK'; 13b39c5158Smillert } else { 14b39c5158Smillert plan tests => 4; 15b39c5158Smillert use_ok( "File::Temp" ); 16b39c5158Smillert } 17b39c5158Smillert} 18b39c5158Smillert 19b39c5158Smillert# Need Symbol package for lexical filehandle on older perls 20b39c5158Smillertrequire Symbol if $] < 5.006; 21b39c5158Smillert 22b39c5158Smillert# Get a tempfile with O_EXLOCK 23f3efcd01Safresh1my $fh = File::Temp->new(EXLOCK => 1); 24b39c5158Smillertok( -e "$fh", "temp file is present" ); 25b39c5158Smillert 26b39c5158Smillert# try to open it with a lock 27b39c5158Smillertmy $flags = O_CREAT | O_RDWR | O_EXLOCK; 28b39c5158Smillert 29b39c5158Smillertmy $timeout = 5; 30b39c5158Smillertmy $status; 31b39c5158Smillerteval { 32b39c5158Smillert local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required 33b39c5158Smillert alarm $timeout; 34b39c5158Smillert my $newfh; 35b39c5158Smillert $newfh = &Symbol::gensym if $] < 5.006; 36b39c5158Smillert $status = sysopen($newfh, "$fh", $flags, 0600); 37b39c5158Smillert alarm 0; 38b39c5158Smillert}; 39b39c5158Smillertif ($@) { 40b39c5158Smillert die unless $@ eq "alarm\n"; # propagate unexpected errors 41b39c5158Smillert # timed out 42b39c5158Smillert} 43b39c5158Smillertok( !$status, "File $fh is locked" ); 44b39c5158Smillert 45b39c5158Smillert# Now get a tempfile with locking disabled 46*256a93a4Safresh1$fh = File::Temp->new( EXLOCK => 0 ); 47b39c5158Smillert 48b39c5158Smillerteval { 49b39c5158Smillert local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required 50b39c5158Smillert alarm $timeout; 51b39c5158Smillert my $newfh; 52b39c5158Smillert $newfh = &Symbol::gensym if $] < 5.006; 53b39c5158Smillert $status = sysopen($newfh, "$fh", $flags, 0600); 54b39c5158Smillert alarm 0; 55b39c5158Smillert}; 56b39c5158Smillertif ($@) { 57b39c5158Smillert die unless $@ eq "alarm\n"; # propagate unexpected errors 58b39c5158Smillert # timed out 59b39c5158Smillert} 60b39c5158Smillertok( $status, "File $fh is not locked"); 61