diff options
Diffstat (limited to 'ext/Tie-File/t/08_ro.t')
-rw-r--r-- | ext/Tie-File/t/08_ro.t | 86 |
1 files changed, 0 insertions, 86 deletions
diff --git a/ext/Tie-File/t/08_ro.t b/ext/Tie-File/t/08_ro.t deleted file mode 100644 index 5fd8933bf8..0000000000 --- a/ext/Tie-File/t/08_ro.t +++ /dev/null @@ -1,86 +0,0 @@ -#!/usr/bin/perl -# -# Make sure it works to open the file in read-only mode -# - -my $file = "tf$$.txt"; -$: = Tie::File::_default_recsep(); - -print "1..13\n"; - -my $N = 1; -use Tie::File; -use Fcntl 'O_RDONLY'; -print "ok $N\n"; $N++; - -my @items = qw(Gold Frankincense Myrrh Ivory Apes Peacocks); -init_file(join $:, @items, ''); - -my $o = tie @a, 'Tie::File', $file, mode => O_RDONLY, autochomp => 0; -print $o ? "ok $N\n" : "not ok $N\n"; -$N++; - -$#a == $#items ? print "ok $N\n" : print "not ok $N\n"; -$N++; - -for my $i (0..$#items) { - ("$items[$i]$:" eq $a[$i]) ? print "ok $N\n" : print "not ok $N\n"; - $N++; -} - -sub init_file { - my $data = shift; - open F, "> $file" or die $!; - binmode F; - print F $data; - close F; -} - -undef $o; untie @a; -my $badrec = "Malformed"; -# (10-13) When a record lacks the record seprator, we sneakily try -# to fix it. How does that work when the file is read-only? -if (setup_badly_terminated_file(4)) { - my $good = 1; - my $warn; - local $SIG{__WARN__} = sub { $good = 0; ctrlfix($warn = shift); }; - local $^W = 1; - my $o = tie @a, 'Tie::File', $file, mode => O_RDONLY, autochomp => 0 - or die "Couldn't tie $file: $!"; - - print $a[0] eq "Malformed$:" ? "ok $N\n" : "not ok $N\n"; $N++; - print $good ? "ok $N\n" : "not ok $N # $warn\n"; $good = 1; $N++; - print $a[0] eq "Malformed$:" ? "ok $N\n" : "not ok $N\n"; $N++; - print $good ? "ok $N\n" : "not ok $N # $warn\n"; $good = 1; $N++; -} - -sub setup_badly_terminated_file { - my $NTESTS = shift; - open F, "> $file" or die "Couldn't open $file: $!"; - binmode F; - print F $badrec; - close F; - unless (-s $file == length $badrec) { - for (1 .. $NTESTS) { - print "ok $N \# skipped - can't create improperly terminated file\n"; - $N++; - } - return; - } - return 1; -} - - -sub ctrlfix { - for (@_) { - s/\n/\\n/g; - s/\r/\\r/g; - } -} - -END { - undef $o; - untie @a; - 1 while unlink $file; -} - |