Commit | Line | Data |
b3fe5a4c |
1 | #!/usr/bin/perl |
2 | |
3 | use POSIX 'SEEK_SET'; |
4 | my $file = "tf$$.txt"; |
5 | $/ = "blah"; |
6 | |
7 | print "1..5\n"; |
8 | |
9 | my $N = 1; |
10 | use Tie::File; |
11 | print "ok $N\n"; $N++; |
12 | |
13 | my $o = tie @a, 'Tie::File', $file; |
14 | print $o ? "ok $N\n" : "not ok $N\n"; |
15 | $N++; |
16 | |
17 | $a[0] = 'rec0'; |
18 | check_contents("rec0blah"); |
19 | $a[1] = "rec1blah"; |
20 | check_contents("rec0blahrec1blah"); |
21 | $a[2] = "rec2blahblah"; # should we detect this? |
22 | check_contents("rec0blahrec1blahrec2blahblah"); |
23 | |
24 | sub check_contents { |
25 | my $x = shift; |
26 | local *FH = $o->{fh}; |
27 | seek FH, 0, SEEK_SET; |
28 | my $a; |
29 | { local $/; $a = <FH> } |
30 | $a = "" unless defined $a; |
31 | if ($a eq $x) { |
32 | print "ok $N\n"; |
33 | } else { |
34 | my $msg = "not ok $N # expected <$x>, got <$a>"; |
35 | ctrlfix($msg); |
36 | print "$msg\n"; |
37 | } |
38 | $N++; |
39 | } |
40 | |
41 | sub ctrlfix { |
42 | for (@_) { |
43 | s/\n/\\n/g; |
44 | s/\r/\\r/g; |
45 | } |
46 | } |
47 | |
48 | END { |
49 | undef $o; |
50 | untie @a; |
51 | 1 while unlink $file; |
52 | } |
53 | |