Commit | Line | Data |
b5aed31e |
1 | #!/usr/bin/perl |
2 | # |
3 | # Make sure it works to open the file in read-only mode |
4 | # |
5 | |
6 | my $file = "tf$$.txt"; |
b3fe5a4c |
7 | $: = Tie::File::_default_recsep(); |
b5aed31e |
8 | |
27531ffb |
9 | print "1..13\n"; |
b5aed31e |
10 | |
11 | my $N = 1; |
12 | use Tie::File; |
13 | use Fcntl 'O_RDONLY'; |
14 | print "ok $N\n"; $N++; |
15 | |
16 | my @items = qw(Gold Frankincense Myrrh Ivory Apes Peacocks); |
b3fe5a4c |
17 | init_file(join $:, @items, ''); |
b5aed31e |
18 | |
0b28bc9a |
19 | my $o = tie @a, 'Tie::File', $file, mode => O_RDONLY, autochomp => 0; |
b5aed31e |
20 | print $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 | |
26 | for 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 | |
31 | sub 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 |
39 | undef $o; untie @a; |
40 | my $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? |
43 | if (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 | |
57 | sub 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 | |
74 | sub ctrlfix { |
75 | for (@_) { |
76 | s/\n/\\n/g; |
77 | s/\r/\\r/g; |
78 | } |
79 | } |
b5aed31e |
80 | |
81 | END { |
7b6b3db1 |
82 | undef $o; |
83 | untie @a; |
b5aed31e |
84 | 1 while unlink $file; |
85 | } |
86 | |