view release on metacpan or  search on metacpan

t/n-loop.t  view on Meta::CPAN

    pltest @BbeE, 'last if /^(?:4[^,]|8)/; E "$I;$A:$. $_"', @files;
    &unBbeE;
    pltest '-r', 'last if /^(?:4[^,]|8)/; E "$I;$A:$. $_"', @files;
    s/(?<=\n)1[^\n]+:\K1( .+?\n).+/5$1/s;
    pltest '-p4', 'substr $_, 0, 0, "$I;$A:$. "; last if / [48][^,]/', @files;
    s/(?<=\n)0[^\n]+:3 .+//s;
    pltest '-p2', 'substr $_, 0, 0, "$I;$A:$. "; last if / [48][^,]/', @files;
}

substr $BbeE[0], 1, 1, '';	# done testing -r

{ my $i = 0; s/:\K([0-9]+)(?= )/++$i/eg } # convert $. to count across all files
pltest @BbeE, 'E "$I;$A:$. $_"', @files;

pl_e '', '-n', '', @files;


unBbeE;
s/^.+? //gm;
$copy = $_;

# run pltest, expect @F[1, 0] separated by $_[0]
sub pl_F($$) {
    my $sep = $_[0];
    pl_a { s/^(.+)$sep(.+)$/$2$sep$1/gm } "-Bmy \$j = '$sep'", $_[1], '$_ = pop @F; e join $j, $_, @F', @files;
}
pl_F ' ', '-al';
pl_F ',', '-lF,';
pl_F ':', '-lF:';


s/.+?:[0-9]+ //mg; # reduce to only file contents
pltest '-n', 'E', @files;
pltest '-ln', 'e', @files;
pltest '-p', '', @files;
pltest '-lp', '', @files;

my @lines = grep /[01],/, split /^/;
pl_e join( '', @lines[0..3], "eof\n", @lines[4, 5], "eof\n" ),
  '-P6e', 'e "eof"', '/[01],/', @files;
pl_e join( '', "bof\n",  @lines[0, 1], "bof\n",  @lines[4, 5], "bof\n",  @lines[7, 8] ),
  '-rP2b', 'e "bof"', '/[01],/', @files;

# reproduce the splits that -054 (comma) will do
s/\n0,/\n][0,/g; # new file
s/,/,][/g;
substr $_, 0, 0, '['; $_ .= ']';
pltest '-054n', 'E "[$_]"', @files; # 054 is comma, also splits at file ends


# Testing -i is a bit more complicated. pl_e -i doesn't really test anything.  The actual test comes then.
my @copies = map {
    open my $in, '<', $_ or die $!;
    my $copy = "copy-$_";
    open my $out, '>', $copy or die $!;
    defined( syswrite $out, slurp $in ) or die $!;
    $copy;
} @files;

# Since -i outputs nothing, instead as a side effect test that I get STDERR.
pl_e "get me\nnow", '-pibkp', '-B warn "get me\n"; E "now"', 'tr/abc/xyz/', @copies;	# Windows perl requires -i with backup

$_ = $copy;
for my $sfx ('bkp', '') {
    my $ret = join '', map {
	open my $in, '<', $_.$sfx or die $!;
	slurp $in;
    } @copies;
    ok $ret eq $_,
      "pltest -i file$sfx contents"
      or print "got: '$ret', expected: '$_'\n";
    tr/abc/xyz/;
}