view release on metacpan or  search on metacpan

t/25_tie_handle_argv.t  view on Meta::CPAN

#TODO Later: Why is $BE needed here, but not in the ::Inplace tests?
our $BE; # BE="buggy eof", Perl 5.14.x had several regressions regarding eof (and a few others) (gets set below)
our $CE; # CE="can't eof()", Perl <5.12 doesn't support eof() on tied filehandles (gets set below)
our $FL = undef; # FL="First Line"
# Apparently there are some versions of Perl on Win32 where the following two appear to work slightly differently.
# I've seen differing results on different systems and I'm not sure why, so I set it dynamically... not pretty, but this test isn't critical.
if ( $^O eq 'MSWin32' && $] ge '5.014' && $] lt '5.018' )
	{ $FL = $.; $FE = defined($.) }

diag "WARNING: Perl 5.16 or better is strongly recommended for Tie::Handle::Argv (see documentation)" if $] lt '5.016';

BEGIN { use_ok('Tie::Handle::Argv') }

## no critic (RequireCarping)

sub testboth {  ## no critic (RequireArgUnpacking)
	# test that both regular ARGV and our tied base class act the same
	die "bad nr of args" unless @_==2 || @_==3;
	my ($name, $sub, $args) = @_;
	my $stdin = delete $$args{stdin};
	{
		local (*ARGV, $.);  ## no critic (RequireInitializationForLocalVars)
		my $osi = defined($stdin) ? OverrideStdin->new($stdin) : undef;
		subtest "$name - untied" => $sub;
		$osi and $osi->restore;
	}
	{
		local (*ARGV, $.);  ## no critic (RequireInitializationForLocalVars)
		local $CE = $] lt '5.012';
		local $BE = $] ge '5.014' && $] lt '5.016';
		tie *ARGV, 'Tie::Handle::Argv', debug=>$DEBUG;
		my $osi = defined($stdin) ? OverrideStdin->new($stdin) : undef;
		subtest "$name - tied" => $sub;
		$osi and $osi->restore;
		untie *ARGV;
	}
	return;
}

testboth 'basic test' => sub { plan tests=>1;
	my @tf = (newtempfn("Foo\nBar\n"), newtempfn("Quz\nBaz"));
	my @states;
	@ARGV = @tf;  ## no critic (RequireLocalizedPunctuationVars)
	push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof];
	push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof, $_] while <>;
	push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof];
	is_deeply \@states, [
		[[@tf],    undef,  !!0, $FL, $FE         ],
		[[$tf[1]], $tf[0], !!1, 1,   !!0, "Foo\n"],
		[[$tf[1]], $tf[0], !!1, 2,   !!1, "Bar\n"],
		[[],       $tf[1], !!1, 3,   !!0, "Quz\n"],
		[[],       $tf[1], !!1, 4,   !!1, "Baz"  ],
		[[],       $tf[1], !!0, 4,   $BE?!!0:!!1 ],
	], 'states' or diag explain \@states;
};

testboth 'basic test with eof()' => sub {
	plan $CE ? ( skip_all=>"eof() not supported on tied handles on Perl<5.12" ) : (tests=>1);
	my @tf = (newtempfn("Foo\nBar"), newtempfn("Quz\nBaz\n"));
	my @states;
	local @ARGV = @tf; # this also tests "local"ization after constructing the object
	# WARNING: eof() modifies $ARGV (and potentially others), so don't do e.g. [$ARGV, $., eof, eof()]!!
	# See e.g. https://www.perlmonks.org/?node_id=289044 and https://www.perlmonks.org/?node_id=1076954
	# and https://www.perlmonks.org/?node_id=1164369 and probably more
	push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof], eof();
	# eof() will open the first file, so record the current state again:
	push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof], eof();
	push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof, $_], eof() while <>;
	# another call to eof() now would open and try to read STDIN (we test that in the STDIN tests)
	push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof];
	is_deeply \@states, [
		[[@tf],    undef,  !!0, $FL,       $FE         ], !!0,
		[[$tf[1]], $tf[0], !!1, $BE?$FL:0, !!0         ], !!0,
		[[$tf[1]], $tf[0], !!1, 1,         !!0, "Foo\n"], !!0,
		[[$tf[1]], $tf[0], !!1, 2,         !!1, "Bar"  ], !!0,
		[[],       $tf[1], !!1, 3,         !!0, "Quz\n"], !!0,
		[[],       $tf[1], !!1, 4,         !!1, "Baz\n"], !!1,
		[[],       $tf[1], !!0, 4,         $BE?!!0:!!1 ],
	], 'states' or diag explain \@states;
};

subtest 'custom files & filename' => sub { plan tests=>3;
	local (*ARGV, $.);  ## no critic (RequireInitializationForLocalVars)
	local $BE = $] ge '5.014' && $] lt '5.016';
	my @testfiles1;
	my $testfilename1;
	my $obj = tie *ARGV, 'Tie::Handle::Argv', debug=>$DEBUG, files=>\@testfiles1, filename=>\$testfilename1;
	my @tf = (newtempfn("Foo\nBar\n"), newtempfn("Quz\nBaz"));
	my @states;
	@ARGV = ("foo");  ## no critic (RequireLocalizedPunctuationVars)
	@testfiles1 = @tf;
	push @states, [[@ARGV], $ARGV, [@testfiles1], $testfilename1, defined(fileno ARGV), $., eof];
	push @states, [[@ARGV], $ARGV, [@testfiles1], $testfilename1, defined(fileno ARGV), $., eof, $_] while <>;
	push @states, [[@ARGV], $ARGV, [@testfiles1], $testfilename1, defined(fileno ARGV), $., eof];
	is_deeply \@states, [
		[["foo"], undef, [@tf],    undef,  !!0, $FL, $FE         ],
		[["foo"], undef, [$tf[1]], $tf[0], !!1, 1,   !!0, "Foo\n"],
		[["foo"], undef, [$tf[1]], $tf[0], !!1, 2,   !!1, "Bar\n"],
		[["foo"], undef, [],       $tf[1], !!1, 3,   !!0, "Quz\n"],
		[["foo"], undef, [],       $tf[1], !!1, 4,   !!1, "Baz"  ],
		[["foo"], undef, [],       $tf[1], !!0, 4,   $BE?!!0:!!1 ],
	], 'states' or diag explain \@states;
	{ # make code coverage happy
		is 0+@testfiles1, 0, 'testfiles empty';
		$obj->init_empty_argv;
		is_deeply \@testfiles1, ['-'], 'testfiles was populated';
	}
	untie *ARGV;
};

testboth 'readline contexts' => sub { plan tests=>2;
	# we test scalar everywhere, need to test the others too
	my @tf = (newtempfn("Alpha"), newtempfn("Bravo\nCharlie\nDelta"), newtempfn("Echo\n!!!"));
	my @states;
	@ARGV = @tf;  ## no critic (RequireLocalizedPunctuationVars)
	push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof];
	for (1..2) {
		<>; # void ctx
		push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof];
	}
	my @got = <>; # list ctx