04_splice.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#
# Check SPLICE function's effect on the file
# (07_rv_splice.t checks its return value)
#
# 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.
$| = 1;
my $file = "tf$$.txt";
my $data = "rec0$:rec1$:rec2$:";
print "1..118\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++;
$: = $o->{recsep};
my $n;
# (3-22) splicing at the beginning
# (23-42) splicing in the middle
# (43-62) splicing at the end
# (63-82) splicing with negative subscript
# (83-84) scrub it all out
splice(@a, 0, 3);
# (85-86) put some back in
# (87-88) what if we remove too many records?
splice(@a, 0, 17);
# (89-92) In the past, splicing past the end was not correctly detected
# (1.14)
splice(@a, 89, 3);
splice(@a, @a, 3);
# (93-96) Also we did not emulate splice's freaky behavior when inserting
# past the end of the array (1.14)
# (97) Splicing with too large a negative number should be fatal
# This test ignored because it causes 5.6.1 and 5.7.3 to dump core
# It also garbles the stack under 5.005_03 (20020401)
# NOT MY FAULT
if ($] > 5.007003) {
? "ok $N\n" : "not ok $N \# \$\@ was '$@'\n";
} else {
print "ok $N \# skipped (versions through 5.7.3 dump core here.)\n";
}
$N++;
# (98-101) Test default arguments
splice @a, 4;
splice @a;
# (102-103) I think there's a bug here---it will fail to clear the EOF flag
@a = (0..11);
splice @a, -1, 1000;
# (104-106) make sure that undefs are treated correctly---they should
# be converted to empty records, and should not raise any warnings.
# (Some of these failed in 0.90. The change to _fixrec fixed them.)
# 20020331
{
# If any of these raise warnings, we have a problem.
local $^W = 1;
@a = (1);
$N++; $good = 1;
$N++; $good = 1;
my @r = splice @a, 2;
$N++; $good = 1;
}
# (107-118) splice with negative length was treated wrong
# 20020402 Reported by Juerd Waalboer
@a = (0..8) ;
splice @a, 0, -3;
@a = (0..8) ;
splice @a, 1, -3;
@a = (0..8) ;
splice @a, 7, -3;
@a = (0..2) ;
splice @a, 0, -3;
@a = (0..2) ;
splice @a, 1, -3;
@a = (0..2) ;
splice @a, 7, -3;
sub init_file {
my $data = shift;
binmode F;
print F $data;
close F;
}
sub check_contents {
my $x = shift;
$N++;
my $a;
{ local $/; $a = <FH> }
print "ok $N\n";
} else {
print "not ok $N\n# expected <$x>, got <$a>\n";
}
$N++;
}
sub ctrlfix {
for (@_) {
s/\n/\\n/g;
s/\r/\\r/g;
}
}
END {
undef $o;
untie @a;
}