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