File-Replace-Inplace
view release on metacpan or search on metacpan
t/00_smoke.t view on Meta::CPAN
You should have received a copy of the GNU General Public License
along with this program. If not, see L<http://www.gnu.org/licenses/>.
=cut
use Test::More tests=>11; # remember to keep in sync with done_testing
BEGIN {
diag "This is Perl $] at $^X on $^O";
BAIL_OUT("Perl 5.8.1 is required") if $] lt '5.008001';
}
use FindBin ();
use lib $FindBin::Bin;
use File_Replace_Testlib;
## no critic (RequireCarping)
BEGIN {
use_ok('Tie::Handle::Base')
t/25_tie_handle_argv.t view on Meta::CPAN
use lib $FindBin::Bin;
use File_Replace_Testlib;
use Test::More tests=>21;
use Cwd qw/getcwd/;
use File::Temp qw/tempdir/;
use warnings FATAL => qw/ io inplace /;
our $DEBUG = 0;
our $FE = $] ge '5.012' && $] lt '5.029007' ? !!0 : !!1; # FE="first eof", see https://github.com/Perl/perl5/issues/16786
#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;
t/25_tie_handle_argv.t view on Meta::CPAN
[[$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];
t/25_tie_handle_argv.t view on Meta::CPAN
push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof, $_] while <>;
push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof];
is_deeply \@states, [
[["<foo"], undef, !!0, undef, $FE ],
[[], "<foo", !!1, 1, !!0, "I am foo\n"],
[[], "<foo", !!1, 2, !!1, "bar" ],
[[], "<foo", !!0, 2, $BE?!!0:!!1 ],
], 'states' or diag explain \@states;
};
testboth 'double-diamond' => sub {
plan $] lt '5.022' ? (skip_all => 'need Perl >=5.22 for double-diamond') : (tests=>1);
my @states;
@ARGV = ("<foo"); ## no critic (RequireLocalizedPunctuationVars)
push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof];
my $code = <<' ENDCODE'; # need to eval this because otherwise <<>> is a syntax error on older Perls
push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof, $_] while <<>>;
; 1
ENDCODE
eval $code or die $@||"unknown error"; ## no critic (ProhibitStringyEval, ProhibitMixedBooleanOperators)
push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof];
TODO: { local $TODO; tied(*ARGV) and $TODO = "double-diamond not yet supported with tied filehandles (?)"; ## no critic (RequireInitializationForLocalVars)
t/50_inplace.t view on Meta::CPAN
use Cwd qw/getcwd/;
use File::Temp qw/tempdir/;
use File::Spec::Functions qw/catdir catfile/;
use IPC::Run3::Shell 0.56 ':FATAL', [ perl => { fail_on_stderr=>1,
show_cmd=>Test::More->builder->output },
$^X, '-wMstrict', '-I'.catdir($FindBin::Bin,'..','lib') ];
use warnings FATAL => qw/ io inplace /;
our $DEBUG = 0;
our $FE = $] ge '5.012' && $] lt '5.029007' ? !!0 : !!1; # FE="first eof", see https://github.com/Perl/perl5/issues/16786
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 File::Replace::Inplace\n\t"
."(see documentation of Tie::Handle::Argv for details)" if $] lt '5.016';
BEGIN {
use_ok 'File::Replace::Inplace';
use_ok 'File::Replace', 'inplace';
}
use warnings FATAL => 'File::Replace';
## no critic (RequireCarping)
our $TESTMODE;
t/50_inplace.t view on Meta::CPAN
# test that both regular $^I and our tied class act the same
die "bad nr of args" unless @_==2 || @_==3;
my ($name, $sub, $args) = @_;
my $stdin = delete $$args{stdin};
{
local $TESTMODE = 'Perl';
local (*ARGV, *ARGVOUT, $., $^I); ## no critic (RequireInitializationForLocalVars)
$^I = $$args{backup}||''; ## no critic (RequireLocalizedPunctuationVars)
my $osi = defined($stdin) ? OverrideStdin->new($stdin) : undef;
subtest "$name - Perl" =>
$^O eq 'MSWin32' && $] lt '5.028' && !length($^I)
? sub { plan skip_all=>'This test would fail on Win32 with Perls older then 5.28' }
# see https://perldoc.pl/perldiag#Can't-do-inplace-edit-without-backup
# and https://perldoc.pl/perl5280delta#In-place-editing-with-perl-i-is-now-safer
: $sub;
$osi and $osi->restore;
}
{
local $TESTMODE = 'Inplace';
local (*ARGV, *ARGVOUT, $., $^I); ## no critic (RequireInitializationForLocalVars)
local $CE = $] lt '5.012';
my $inpl = File::Replace::Inplace->new(debug=>$DEBUG, %$args);
my $osi = defined($stdin) ? OverrideStdin->new($stdin) : undef;
subtest "$name - ::Inplace" => $sub;
$osi and $osi->restore;
}
return;
}
testboth 'basic test' => sub { plan tests=>9;
my @tf = (newtempfn("Foo\nBar\n"), newtempfn("Quz\nBaz"));
t/50_inplace.t view on Meta::CPAN
my $tfn = newtempfn;
ok !-e $tfn, 'file doesn\'t exist';
@ARGV = ($tfn); ## no critic (RequireLocalizedPunctuationVars)
my $inpl = File::Replace::Inplace->new( debug=>$DEBUG, create=>'off' );
like exception { <>; 1 }, qr/\bfailed to open '\Q$tfn\E'/, 'read dies ok';
}
};
subtest 'premature destroy' => sub { plan tests=>7;
local (*ARGV, *ARGVOUT, $., $^I); ## no critic (RequireInitializationForLocalVars)
local $CE = $] lt '5.012';
is grep( {/\bunclosed file\b.+\bnot replaced\b/i} warns {
my $tfn = newtempfn("IJK\nMNO");
@ARGV = ($tfn); ## no critic (RequireLocalizedPunctuationVars)
my @states;
my $inpl = inplace(debug=>$DEBUG);
is select(), 'main::STDOUT', 'STDOUT is selected initially';
push @states, [[@ARGV], $ARGV, defined(fileno ARGV), defined(fileno ARGVOUT), $., eof];
is <>, "IJK\n", 'read ok';
isnt select(), 'main::STDOUT', 'STDOUT isn\'t selected after read';
push @states, [[@ARGV], $ARGV, defined(fileno ARGV), defined(fileno ARGVOUT), $., eof];
t/50_inplace.t view on Meta::CPAN
push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof, $_] while <>;
push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof];
is_deeply \@states, [
[["<foo"], undef, !!0, undef, $FE ],
[[], "<foo", !!1, 1, !!0, "I am <foo!\n"],
[[], "<foo", !!1, 2, !!1, "quz" ],
[[], "<foo", !!0, 2, !!1 ],
], 'states for double-diamond';
};
testboth 'double-diamond' => sub {
if ($] lt '5.022') { plan skip_all => 'need Perl >=5.22 for double-diamond' }
elsif ($^O eq 'MSWin32') { plan skip_all => 'special filenames won\'t work on Windows' }
else { plan tests=>1 }
spew("foo","I am foo\nbar");
spew("<foo","I am <foo!\nquz");
my @states;
@ARGV = ("<foo"); ## no critic (RequireLocalizedPunctuationVars)
push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof];
my $code = <<' ENDCODE'; # need to eval this because otherwise <<>> is a syntax error on older Perls
push @states, [[@ARGV], $ARGV, defined(fileno ARGV), $., eof, $_] while <<>>;
; 1
( run in 0.532 second using v1.01-cache-2.11-cpan-cc502c75498 )