Commit | Line | Data |
b5aed31e |
1 | #!/usr/bin/perl |
2 | # |
3 | # Check FETCHSIZE and SETSIZE functions |
4 | # PUSH POP SHIFT UNSHIFT |
5 | # |
6 | |
7b6b3db1 |
7 | use POSIX 'SEEK_SET'; |
8 | |
b5aed31e |
9 | my $file = "tf$$.txt"; |
10 | my $data = "rec0blahrec1blahrec2blah"; |
11 | my ($o, $n); |
12 | |
13 | print "1..10\n"; |
14 | |
15 | my $N = 1; |
16 | use Tie::File; |
17 | print "ok $N\n"; $N++; |
18 | |
19 | # 2-3 FETCHSIZE 0-length file |
20 | open F, "> $file" or die $!; |
21 | close F; |
22 | $o = tie @a, 'Tie::File', $file, recsep => 'blah'; |
23 | print $o ? "ok $N\n" : "not ok $N\n"; |
24 | $N++; |
25 | $n = @a; |
26 | print $n == 0 ? "ok $N\n" : "not ok $N # $n, s/b 0\n"; |
27 | $N++; |
28 | |
29 | # Reset everything |
30 | undef $o; |
31 | untie @a; |
32 | |
33 | # 4-5 FETCHSIZE positive-length file |
34 | open F, "> $file" or die $!; |
35 | print F $data; |
36 | close F; |
37 | $o = tie @a, 'Tie::File', $file, recsep => 'blah'; |
38 | print $o ? "ok $N\n" : "not ok $N\n"; |
39 | $N++; |
40 | $n = @a; |
41 | print $n == 3 ? "ok $N\n" : "not ok $N # $n, s/b 0\n"; |
42 | $N++; |
43 | |
44 | # STORESIZE |
45 | # 6 Make it longer: |
46 | $#a = 4; |
47 | check_contents("${data}blahblah"); |
48 | |
49 | # 7 Make it longer again: |
50 | $#a = 6; |
51 | check_contents("${data}blahblahblahblah"); |
52 | |
53 | # 8 Make it shorter: |
54 | $#a = 4; |
55 | check_contents("${data}blahblah"); |
56 | |
57 | # 9 Make it shorter again: |
58 | $#a = 2; |
59 | check_contents($data); |
60 | |
61 | # 10 Get rid of it completely: |
62 | $#a = -1; |
63 | check_contents(''); |
64 | |
65 | |
66 | sub check_contents { |
67 | my $x = shift; |
7b6b3db1 |
68 | local *FH = $o->{fh}; |
69 | seek FH, 0, SEEK_SET; |
b5aed31e |
70 | my $a; |
71 | { local $/; $a = <FH> } |
7b6b3db1 |
72 | $a = "" unless defined $a; |
73 | if ($a eq $x) { |
74 | print "ok $N\n"; |
75 | } else { |
b3fe5a4c |
76 | ctrlfix(my $msg = "# expected <$x>, got <$a>"); |
77 | print "not ok $N\n$msg\n"; |
7b6b3db1 |
78 | } |
b5aed31e |
79 | $N++; |
80 | } |
81 | |
82 | |
b3fe5a4c |
83 | sub ctrlfix { |
84 | for (@_) { |
85 | s/\n/\\n/g; |
86 | s/\r/\\r/g; |
87 | } |
88 | } |
89 | |
b5aed31e |
90 | END { |
7b6b3db1 |
91 | undef $o; |
92 | untie @a; |
b5aed31e |
93 | 1 while unlink $file; |
94 | } |
95 | |