The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

BEGIN { $| = 1; print "1..13\n"; }
END { print "not ok 1\n" unless $loaded;}

use IO::LockedFile;
use diagnostics;
$loaded = 1;
print "ok 1\n";
use Fcntl;
use Cwd;

my $file_path = cwd()."/locked1.txt";

### check opening the file using the Perl mode ###

# create an exclussive locked file
my $file1 = new IO::LockedFile(">".$file_path);

# check that the file is locked exclussively
# try to open it to read
if (my $pid = fork()) {
    wait;
}
else { # in the child process
    my $file2 = new IO::LockedFile({ block => 0 },
				   ">".$file_path);
    print_ok(!$file2, 2, "the file is locked exclussivly, ".
	     "so we could not open it to write");
    $file2 = new IO::LockedFile({ block => 0 },
				   $file_path);
    print_ok(!$file2, 3, "the file is locked exclussivly, ".
	     "so we could not open it to read");
    exit 0; # exit from that process and continue in the "wait" above    
}

# close (and unlock) the file
$file1 = undef;

# create a shared locked file
$file1 = new IO::LockedFile($file_path);

# check that the file has a shared locked 
# try to open it to write
if (my $pid = fork()) {
    wait;
}
else { # in the child process
    my $file2 = new IO::LockedFile({ block => 0 },
				   ">".$file_path);
    print_ok(!$file2, 4, "the file has a shared lock, ".
	     "so we could not open it to write");
    $file2 = new IO::LockedFile({ block => 0 },
				$file_path);
    print_ok($file2, 5, "the file has a shared lock, ".
	     "so we could open it to read");
    exit 0; # exit from that process and continue in the "wait" above
}

# close (and unlock) the file
$file1 = undef;

### check opening the file using Numeric mode ###

# create an exclussive locked file
$file1 = new IO::LockedFile($file_path, O_CREAT | O_TRUNC);

# check that the file is locked exclussively
# try to open it to read
if (my $pid = fork()) {
    wait;
}
else { # in the child process
    my $file2 = new IO::LockedFile({ block => 0 },
				   $file_path, O_CREAT | O_TRUNC);
    print_ok(!$file2, 6, "the file is locked exclussivly, ".
	     "so we could not open it to write");
    $file2 = new IO::LockedFile({ block => 0 },
				   $file_path);
    print_ok(!$file2, 7, "the file is locked exclussivly, ".
	     "so we could not open it to read");
    exit 0; # exit from that process and continue in the "wait" above    
}

# close (and unlock) the file
$file1 = undef;

# create a shared locked file
$file1 = new IO::LockedFile($file_path);

# check that the file has a shared locked 
# try to open it to write
if (my $pid = fork()) {
    wait;
}
else { # in the child process
    my $file2 = new IO::LockedFile({ block => 0 },
				   $file_path, O_CREAT | O_TRUNC);
    print_ok(!$file2, 8, "the file has a shared lock, ".
	     "so we could not open it to write");
    $file2 = new IO::LockedFile({ block => 0 },
				$file_path);
    print_ok($file2, 9, "the file has a shared lock, ".
	     "so we could open it to read");
    exit 0; # exit from that process and continue in the "wait" above
}

# close (and unlock) the file
$file1 = undef;

### check opening the file using POSIX mode ###

# create an exclussive locked file
$file1 = new IO::LockedFile($file_path, "w");

# check that the file is locked exclussively
# try to open it to read
if (my $pid = fork()) {
    wait;
}
else { # in the child process
    my $file2 = new IO::LockedFile({ block => 0 },
				   $file_path, "w");
    print_ok(!$file2, 10, "the file is locked exclussivly, ".
	     "so we could not open it to write");
    $file2 = new IO::LockedFile({ block => 0 },
				   $file_path, "r");
    print_ok(!$file2, 11, "the file is locked exclussivly, ".
	     "so we could not open it to read");
    exit 0; # exit from that process and continue in the "wait" above    
}

# close (and unlock) the file
$file1 = undef;

# create a shared locked file
$file1 = new IO::LockedFile($file_path, "r");

# check that the file has a shared locked 
# try to open it to write
if (my $pid = fork()) {
    wait;
}
else { # in the child process
    my $file2 = new IO::LockedFile({ block => 0 },
				   $file_path, "w");
    print_ok(!$file2, 12, "the file has a shared lock, ".
	     "so we could not open it to write");
    $file2 = new IO::LockedFile({ block => 0 },
				$file_path, "r");
    print_ok($file2, 13, "the file has a shared lock, ".
	     "so we could open it to read");
    exit 0; # exit from that process and continue in the "wait" above
}

# close (and unlock) the file
$file1 = undef;

# remove the file
unlink($file_path);

#############################################
# print_ok ($expression, $number, $comment)
#############################################
sub print_ok {
    my $expression = shift;
    my $number =shift;
    my $string = shift || "";

    $string = "ok " . $number . " " . $string . "\n";
    if (! $expression) {
        $string = "not " . $string;
    }
    print $string;
} # print_ok