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