view release on metacpan or  search on metacpan

t/09b-autochomp.t  view on Meta::CPAN

use Test::More;
use Acme::InputRecordSeparatorIsRegexp 'binmode','autochomp';
use strict;
use warnings;

# handle the case where the length of a record is much larger
# than the size of the read buffer

my $yy = "";
for (1..20) {
    $yy .= "x" x 9999;
    if (rand() < 0.333333) {
	$yy .= "\n";
    } elsif (rand() < 0.5) {
	$yy .= "\r";
    } else {
	$yy .= "\r\n";
    }
}
open my $xx, '>:raw', 't/test09b.txt';
print $xx $yy;
close $xx;

my $z = open my $fh, '<:raw', "t/test09b.txt";
ok($z && $fh, 'builtin open ok');
ok(!tied(*$fh), 'handle not tied yet');
$z = binmode $fh, ":irs(\r\n|\r|\n)";
ok($z, 'Acme::InputRecordSeparatorIsRegexp::binmode ok');
ok(tied(*$fh), 'handle tied after binmode');

ok(!(tied *$fh)->autochomp(), 'autochomp is off');
ok(!autochomp(tied *$fh), 'autochomp get function');
ok(!autochomp($fh), 'autochomp get function');

(tied *$fh)->autochomp(1);
ok((tied *$fh)->autochomp(), 'autochomp is on');

autochomp(tied *$fh, 0);
ok(!autochomp(tied $fh), 'autochomp set function');
autochomp($fh, 1);
ok(autochomp(tied *$fh), 'autochomp set function');
ok(autochomp($fh), 'autochomp set function');
ok(autochomp(*$fh), 'autochomp set function');

open my $f1, "<", "t/test09b.txt";
my $line = <$f1>;
ok($line =~ m<$/$>, 'line from regular fh contains line ending');
ok(!tied *$f1, "f1 is regular filehandle");
my $z1 = autochomp($f1);
ok(defined($z1) && $z1==0, 'can call autochomp on regular filehandle');
ok(!tied *$f1, "f1 is still regular fh after get autochomp");
$line = <$f1>;
ok($line =~ m<$/$>, 'line from regular fh still contains line ending');
my $z2 = autochomp($f1,1);
ok(defined($z2) && $z2==0, 'autochomp called on regular filehandle');
ok(tied *$f1, "set autochomp on regular fh ties it to this package");
$line = <$f1>;
ok($line !~ m<$/$>, 'line from autochomped fh does not contain line ending');






my (@tell, @seek);

push @tell, tell($fh);
while (<$fh>) {
    push @seek, $_;
    push @tell, tell($fh);
    if (@seek > 1) {
	ok( $seek[-2] !~ /[\r\n]$/, 'line ending was chomped' )
	    or diag $seek[-2], "\n\n", $seek[-1],
	    "\n\n", length($seek[-2]),"\t",length($seek[-1]);
	ok( length($seek[-2]) == 9999, 'autochomped line length' );

	my $x = $seek[-2];
	my $u = tied(*$fh)->chomp($x);
	ok($u==0, 'chomp return value for already chomped');
	ok($x eq $seek[-2], 'already chomped line not changed');
    }
}

# don't close

while (@seek) {
    my $i = int(rand(@seek));
    my $t = splice @tell, $i, 1;
    my $s = splice @seek, $i, 1;