Commit | Line | Data |
fa408a35 |
1 | #!/usr/bin/perl |
2 | # |
3 | # Check miscellaneous tied-array interface methods |
4 | # EXTEND, CLEAR, DELETE, EXISTS |
5 | # |
6 | |
7 | use lib '/home/mjd/src/perl/Tie-File2/lib'; |
8 | my $file = "tf$$.txt"; |
9 | 1 while unlink $file; |
10 | |
11 | print "1..24\n"; |
12 | |
13 | my $N = 1; |
14 | use Tie::File; |
15 | print "ok $N\n"; $N++; |
16 | |
17 | my $o = tie @a, 'Tie::File', $file; |
18 | print $o ? "ok $N\n" : "not ok $N\n"; |
19 | $N++; |
20 | |
21 | # (3-8) EXTEND |
22 | $o->EXTEND(3); |
23 | check_contents("$/$/$/"); |
24 | $o->EXTEND(4); |
25 | check_contents("$/$/$/$/"); |
26 | $o->EXTEND(3); |
27 | check_contents("$/$/$/$/"); |
28 | |
29 | # (9-10) CLEAR |
30 | @a = (); |
31 | check_contents(""); |
32 | |
33 | # (11-16) EXISTS |
34 | print !exists $a[0] ? "ok $N\n" : "not ok $N\n"; |
35 | $N++; |
36 | $a[0] = "I like pie."; |
37 | print exists $a[0] ? "ok $N\n" : "not ok $N\n"; |
38 | $N++; |
39 | print !exists $a[1] ? "ok $N\n" : "not ok $N\n"; |
40 | $N++; |
41 | $a[2] = "GIVE ME PIE"; |
42 | print exists $a[0] ? "ok $N\n" : "not ok $N\n"; |
43 | $N++; |
44 | # exists $a[1] is not defined by this module under these circumstances |
45 | print exists $a[1] ? "ok $N\n" : "ok $N\n"; |
46 | $N++; |
47 | print exists $a[2] ? "ok $N\n" : "not ok $N\n"; |
48 | $N++; |
49 | |
50 | # (17-24) DELETE |
51 | delete $a[0]; |
52 | check_contents("$/$/GIVE ME PIE$/"); |
53 | delete $a[2]; |
54 | check_contents("$/$/"); |
55 | delete $a[0]; |
56 | check_contents("$/$/"); |
57 | delete $a[1]; |
58 | check_contents("$/"); |
59 | |
60 | |
61 | use POSIX 'SEEK_SET'; |
62 | sub check_contents { |
63 | my $x = shift; |
64 | local *FH = $o->{fh}; |
65 | seek FH, 0, SEEK_SET; |
66 | my $a; |
67 | { local $/; $a = <FH> } |
68 | $a = "" unless defined $a; |
69 | if ($a eq $x) { |
70 | print "ok $N\n"; |
71 | } else { |
72 | s{$/}{\\n}g for $a, $x; |
73 | print "not ok $N\n# expected <$x>, got <$a>\n"; |
74 | } |
75 | $N++; |
76 | print $o->_check_integrity($file, $ENV{INTEGRITY}) ? "ok $N\n" : "not ok $N\n"; |
77 | $N++; |
78 | } |
79 | |
80 | END { |
81 | undef $o; |
82 | untie @a; |
83 | 1 while unlink $file; |
84 | } |
85 | |
86 | |