15_pushpop.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#
# Check PUSH, POP, SHIFT, and UNSHIFT
#
# Each call to 'check_contents' actually performs two tests.
# First, it calls the tied object's own 'check_integrity' method,
# which makes sure that the contents of the read cache and offset tables
# accurately reflect the contents of the file.
# Then, it checks the actual contents of the file against the expected
# contents.
use POSIX 'SEEK_SET';
my $file = "tf$$.txt";
my $data = "rec0$:rec1$:rec2$:";
print "1..38\n";
my $N = 1;
print "ok $N\n"; $N++; # partial credit just for showing up
print $o ? "ok $N\n" : "not ok $N\n";
$N++;
my ($n, @r);
# (3-11) PUSH tests
print $n == 3 ? "ok $N\n" : "not ok $N # size is $n, should be 3\n";
$N++;
print $n == 5 ? "ok $N\n" : "not ok $N # size is $n, should be 5\n";
$N++;
# Trivial push
$n = push @a, ();
print $n == 5 ? "ok $N\n" : "not ok $N # size is $n, should be 5\n";
$N++;
# (12-20) POP tests
$n = pop @a;
$N++;
# Presumably we have already tested this to death
splice(@a, 1, 3);
$n = pop @a;
$N++;
$n = pop @a;
$N++;
# (21-29) UNSHIFT tests
print $n == 3 ? "ok $N\n" : "not ok $N # size is $n, should be 3\n";
$N++;
print $n == 5 ? "ok $N\n" : "not ok $N # size is $n, should be 5\n";
$N++;
# Trivial unshift
$n = unshift @a, ();
print $n == 5 ? "ok $N\n" : "not ok $N # size is $n, should be 5\n";
$N++;
# (30-38) SHIFT tests
$n = shift @a;
$N++;
# Presumably we have already tested this to death
splice(@a, 1, 3);
$n = shift @a;
$N++;
$n = shift @a;
$N++;
sub check_contents {
my $x = shift;
$N++;
my $a;
{ local $/; $a = <FH> }
print "ok $N\n";
} else {
}
$N++;
}
sub ctrlfix {
for (@_) {
s/\n/\\n/g;
s/\r/\\r/g;
}
}
END {
undef $o;
untie @a;
}