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