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