08_ro.t revision 1.1.1.3
1#!/usr/bin/perl 2# 3# Make sure it works to open the file in read-only mode 4# 5 6use strict; 7use warnings; 8 9my $file = "tf08-$$.txt"; 10$: = Tie::File::_default_recsep(); 11 12print "1..13\n"; 13 14my $N = 1; 15use Tie::File; 16use Fcntl 'O_RDONLY'; 17print "ok $N\n"; $N++; 18 19my @items = qw(Gold Frankincense Myrrh Ivory Apes Peacocks); 20init_file(join $:, @items, ''); 21 22my @a; 23my $o = tie @a, 'Tie::File', $file, mode => O_RDONLY, autochomp => 0; 24print $o ? "ok $N\n" : "not ok $N\n"; 25$N++; 26 27$#a == $#items ? print "ok $N\n" : print "not ok $N\n"; 28$N++; 29 30for my $i (0..$#items) { 31 ("$items[$i]$:" eq $a[$i]) ? print "ok $N\n" : print "not ok $N\n"; 32 $N++; 33} 34 35sub init_file { 36 my $data = shift; 37 open F, '>', $file or die $!; 38 binmode F; 39 print F $data; 40 close F; 41} 42 43undef $o; untie @a; 44my $badrec = "Malformed"; 45# (10-13) When a record lacks the record seprator, we sneakily try 46# to fix it. How does that work when the file is read-only? 47if (setup_badly_terminated_file(4)) { 48 my $good = 1; 49 my $warn; 50 local $SIG{__WARN__} = sub { $good = 0; ctrlfix($warn = shift); }; 51 local $^W = 1; 52 my $o = tie @a, 'Tie::File', $file, mode => O_RDONLY, autochomp => 0 53 or die "Couldn't tie $file: $!"; 54 55 print $a[0] eq "Malformed$:" ? "ok $N\n" : "not ok $N\n"; $N++; 56 print $good ? "ok $N\n" : "not ok $N # $warn\n"; $good = 1; $N++; 57 print $a[0] eq "Malformed$:" ? "ok $N\n" : "not ok $N\n"; $N++; 58 print $good ? "ok $N\n" : "not ok $N # $warn\n"; $good = 1; $N++; 59} 60 61sub setup_badly_terminated_file { 62 my $NTESTS = shift; 63 open F, '>', $file or die "Couldn't open $file: $!"; 64 binmode F; 65 print F $badrec; 66 close F; 67 unless (-s $file == length $badrec) { 68 for (1 .. $NTESTS) { 69 print "ok $N \# skipped - can't create improperly terminated file\n"; 70 $N++; 71 } 72 return; 73 } 74 return 1; 75} 76 77 78sub ctrlfix { 79 for (@_) { 80 s/\n/\\n/g; 81 s/\r/\\r/g; 82 } 83} 84 85END { 86 undef $o; 87 untie @a; 88 1 while unlink $file; 89} 90 91