summaryrefslogtreecommitdiff
path: root/lib/Tie/File/t/22_autochomp.t
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Tie/File/t/22_autochomp.t')
-rw-r--r--lib/Tie/File/t/22_autochomp.t175
1 files changed, 0 insertions, 175 deletions
diff --git a/lib/Tie/File/t/22_autochomp.t b/lib/Tie/File/t/22_autochomp.t
deleted file mode 100644
index dee07a8ec8..0000000000
--- a/lib/Tie/File/t/22_autochomp.t
+++ /dev/null
@@ -1,175 +0,0 @@
-#!/usr/bin/perl
-
-my $file = "tf$$.txt";
-$: = Tie::File::_default_recsep();
-
-print "1..71\n";
-
-my $N = 1;
-use Tie::File;
-print "ok $N\n"; $N++;
-
-my $o = tie @a, 'Tie::File', $file, autochomp => 1, autodefer => 0;
-print $o ? "ok $N\n" : "not ok $N\n";
-$N++;
-
-# 3-5 create
-$a[0] = 'rec0';
-check_contents("rec0");
-
-# 6-11 append
-$a[1] = 'rec1';
-check_contents("rec0", "rec1");
-$a[2] = 'rec2';
-check_contents("rec0", "rec1", "rec2");
-
-# 12-20 same-length alterations
-$a[0] = 'new0';
-check_contents("new0", "rec1", "rec2");
-$a[1] = 'new1';
-check_contents("new0", "new1", "rec2");
-$a[2] = 'new2';
-check_contents("new0", "new1", "new2");
-
-# 21-35 lengthening alterations
-$a[0] = 'long0';
-check_contents("long0", "new1", "new2");
-$a[1] = 'long1';
-check_contents("long0", "long1", "new2");
-$a[2] = 'long2';
-check_contents("long0", "long1", "long2");
-$a[1] = 'longer1';
-check_contents("long0", "longer1", "long2");
-$a[0] = 'longer0';
-check_contents("longer0", "longer1", "long2");
-
-# 36-50 shortening alterations, including truncation
-$a[0] = 'short0';
-check_contents("short0", "longer1", "long2");
-$a[1] = 'short1';
-check_contents("short0", "short1", "long2");
-$a[2] = 'short2';
-check_contents("short0", "short1", "short2");
-$a[1] = 'sh1';
-check_contents("short0", "sh1", "short2");
-$a[0] = 'sh0';
-check_contents("sh0", "sh1", "short2");
-
-# (51-56) file with holes
-$a[4] = 'rec4';
-check_contents("sh0", "sh1", "short2", "", "rec4");
-$a[3] = 'rec3';
-check_contents("sh0", "sh1", "short2", "rec3", "rec4");
-
-# (57-59) zero out file
-@a = ();
-check_contents();
-
-# (60-62) insert into the middle of an empty file
-$a[3] = "rec3";
-check_contents("", "", "", "rec3");
-
-# (63-68) Test the ->autochomp() method
-@a = qw(Gold Frankincense Myrrh);
-my $ac;
-$ac = $o->autochomp();
-expect($ac);
-# See if that accidentally changed it
-$ac = $o->autochomp();
-expect($ac);
-# Now clear it
-$ac = $o->autochomp(0);
-expect($ac);
-expect(join("-", @a), "Gold$:-Frankincense$:-Myrrh$:");
-# Now set it again
-$ac = $o->autochomp(1);
-expect(!$ac);
-expect(join("-", @a), "Gold-Frankincense-Myrrh");
-
-# (69) Does 'splice' work correctly with autochomp?
-my @sr;
-@sr = splice @a, 0, 2;
-expect(join("-", @sr), "Gold-Frankincense");
-
-# (70-71) Didn't you forget that fetch may return an unchomped cached record?
-$a1 = $a[0]; # populate cache
-$a2 = $a[0];
-expect($a1, "Myrrh");
-expect($a2, "Myrrh");
-# Actually no, you didn't---_fetch might return such a record, but
-# the chomping is done by FETCH.
-
-use POSIX 'SEEK_SET';
-sub check_contents {
- my @c = @_;
- my $x = join $:, @c, '';
- local *FH = $o->{fh};
- seek FH, 0, SEEK_SET;
-# my $open = open FH, "< $file";
- my $a;
- { local $/; $a = <FH> }
- $a = "" unless defined $a;
- if ($a eq $x) {
- print "ok $N\n";
- } else {
- ctrlfix($a, $x);
- print "not ok $N\n# expected <$x>, got <$a>\n";
- }
- $N++;
-
- # now check FETCH:
- my $good = 1;
- my $msg;
- for (0.. $#c) {
- my $aa = $a[$_];
- unless ($aa eq $c[$_]) {
- $msg = "expected <$c[$_]>, got <$aa>";
- ctrlfix($msg);
- $good = 0;
- }
- }
- print $good ? "ok $N\n" : "not ok $N # $msg\n";
- $N++;
-
- print $o->_check_integrity($file, $ENV{INTEGRITY})
- ? "ok $N\n" : "not ok $N\n";
- $N++;
-}
-
-sub expect {
- if (@_ == 1) {
- print $_[0] ? "ok $N\n" : "not ok $N\n";
- } elsif (@_ == 2) {
- my ($a, $x) = @_;
- if (! defined($a) && ! defined($x)) { print "ok $N\n" }
- elsif ( defined($a) && ! defined($x)) {
- ctrlfix(my $msg = "expected UNDEF, got <$a>");
- print "not ok $N \# $msg\n";
- }
- elsif (! defined($a) && defined($x)) {
- ctrlfix(my $msg = "expected <$x>, got UNDEF");
- print "not ok $N \# $msg\n";
- } elsif ($a eq $x) { print "ok $N\n" }
- else {
- ctrlfix(my $msg = "expected <$x>, got <$a>");
- print "not ok $N \# $msg\n";
- }
- } else {
- die "expect() got ", scalar(@_), " args, should have been 1 or 2";
- }
- $N++;
-}
-
-sub ctrlfix {
- for (@_) {
- s/\n/\\n/g;
- s/\r/\\r/g;
- }
-}
-
-END {
- undef $o;
- untie @a;
- 1 while unlink $file;
-}
-