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 = "rec0$/rec1$/rec2$/"; | |
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 $!; | |
1768807e | 19 | binmode F; |
b5aed31e AMS |
20 | close F; |
21 | $o = tie @a, 'Tie::File', $file; | |
22 | print $o ? "ok $N\n" : "not ok $N\n"; | |
23 | $N++; | |
24 | $n = @a; | |
25 | print $n == 0 ? "ok $N\n" : "not ok $N # $n, s/b 0\n"; | |
26 | $N++; | |
27 | ||
28 | # Reset everything | |
29 | undef $o; | |
30 | untie @a; | |
31 | ||
32 | # 4-5 FETCHSIZE positive-length file | |
33 | open F, "> $file" or die $!; | |
1768807e | 34 | binmode F; |
b5aed31e AMS |
35 | print F $data; |
36 | close F; | |
37 | $o = tie @a, 'Tie::File', $file; | |
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$/$/"); | |
48 | ||
49 | # 7 Make it longer again: | |
50 | $#a = 6; | |
51 | check_contents("$data$/$/$/$/"); | |
52 | ||
53 | # 8 Make it shorter: | |
54 | $#a = 4; | |
55 | check_contents("$data$/$/"); | |
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; | |
68 | local *FH; | |
69 | my $open = open FH, "< $file"; | |
1768807e | 70 | binmode FH; |
b5aed31e AMS |
71 | my $a; |
72 | { local $/; $a = <FH> } | |
73 | print (($open && $a eq $x) ? "ok $N\n" : "not ok $N\n"); | |
74 | $N++; | |
75 | } | |
76 | ||
77 | ||
78 | END { | |
79 | 1 while unlink $file; | |
80 | } | |
81 |