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