09_gen_rs.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
my $file = "tf$$.txt";
print "1..59\n";
my $N = 1;
print "ok $N\n"; $N++;
$RECSEP = 'blah';
print $o ? "ok $N\n" : "not ok $N\n";
$N++;
# 3-4 create
$a[0] = 'rec0';
# 5-8 append
$a[1] = 'rec1';
$a[2] = 'rec2';
# 9-14 same-length alterations
$a[0] = 'new0';
$a[1] = 'new1';
$a[2] = 'new2';
# 15-24 lengthening alterations
$a[0] = 'long0';
$a[1] = 'long1';
$a[2] = 'long2';
$a[1] = 'longer1';
$a[0] = 'longer0';
# 25-34 shortening alterations, including truncation
$a[0] = 'short0';
$a[1] = 'short1';
$a[2] = 'short2';
$a[1] = 'sh1';
$a[0] = 'sh0';
# (35-38) file with holes
$a[4] = 'rec4';
$a[3] = 'rec3';
# (39-40) zero out file
@a = ();
# (41-42) insert into the middle of an empty file
$a[3] = "rec3";
# (43-47) 20020326 You thought there would be a bug in STORE where if
# a cached record was false, STORE wouldn't see it at all. Yup, there is,
# and adding the appropriate defined() test fixes the problem.
$RECSEP = '0';
print $o ? "ok $N\n" : "not ok $N\n";
$N++;
$#a = 2;
my $z = $a[1]; # caches "0"
$a[2] = "oops";
$a[1] = "bah";
# (48-56) 20020331 Make sure we correctly handle the case where the final
# record of the file is not properly terminated, Through version 0.90,
# we would mangle the file.
my $badrec = "Malformed";
# (48-50)
my $z = $a[0];
$N++;
}
# (51-52)
}
# (53-56)
my $n = @r;
print $n == 1 ? "ok $N\n" : "not ok $N \# expected 1 elt, got $n\n";
$N++;
$N++;
}
# (57-58) 20020402 The modification would have failed if $\ were set wrong.
# I hate $\.
{ local $\ = "I hate \$\\.";
my $z = $a[0];
}
}
# (59) 20030527 Tom Christiansen pointed out that FETCH returns the wrong
# data on the final record of an unterminated file if the file is opened
# in read-only mode. Note that the $#a is necessary here.
# There's special-case code to fix the final record when it is read normally.
# But the $#a forces it to be read from the cache, which skips the
# termination.
$badrec = "world${RECSEP}hello";
my $z = $#a;
$z = $a[1];
"not ok $N \# got $z, expected hello\n";
$N++;
}
my $NTESTS = shift;
binmode F;
print F $badrec;
close F;
print "ok $N \# skipped - can't create improperly terminated file\n";
$N++;
}
return;
}
return 1;
}
use POSIX 'SEEK_SET';
sub check_contents {
my @c = @_;
my $a;
{ local $/; $a = <FH> }
print "ok $N\n";
} else {
}
$N++;
# now check FETCH:
my $good = 1;
for (0.. $#c) {
$good = 0;
}
}
$N++;
}
sub ctrlfix {
for (@_) {
s/\n/\\n/g;
s/\r/\\r/g;
}
}
END {
undef $o;
untie @a;
}