sub chimpx {
my $pat = @_ ? shift : $/; for @_ ? @_ : $_;
}
####
chimpx $pat, my $dst = $src;
####
sub chimpx {
my $pat = @_ ? shift : $/;
my $targs = sub { \@_ }->( @_ ? @_ : $_ );
@$targs = @$targs if defined(wantarray);
s/^(?:\Q$pat\E)*// for @$targs;
return wantarray ? @$targs : $targs->[0];
}
####
use Test::More tests => 18;
{
local $_ = 'ababac';
my $x = 'ababac';
chimpx 'ab', $x;
is($_, 'ababac', 'void pat var - $_ preservation');
is($x, 'ac', 'void pat var - result verification');
}
{
local $_ = 'ababac';
my $x = 'ababac';
my $y = chimpx 'ab', $x;
is($_, 'ababac', 'scalar pat var - $_ preservation');
is($x, 'ababac', 'scalar pat var - arg preservation');
is($y, 'ac', 'scalar pat var - result verification');
}
{
local $_ = 'ababac';
chimpx 'ab';
is($_, 'ac', 'void pat novar - result verification');
}
{
local $_ = 'ababac';
my $y = chimpx 'ab';
is($_, 'ababac', 'scalar pat novar - $_ preservation');
is($y, 'ac', 'scalar pat novar - result verification');
}
{
local $_ = "$/$/c";
chimpx;
is($_, 'c', 'void nopat novar - result verification');
}
{
local $_ = "$/$/c";
my $y = chimpx;
is($_, "$/$/c", 'scalar nopat novar - $_ preservation');
is($y, 'c', 'scalar nopat novar - result verification');
}
{
local $/ = 'ab';
local $_ = "$/$/ac";
chimpx;
is($_, 'ac', 'alt $/ - result verification');
}
{
my $x1 = 'ababac';
my $x2 = 'ababad';
chimpx('ab', $x1, $x2);
is($x1, 'ac', 'void multiple args - 1st result verification');
is($x2, 'ad', 'void multiple args - 2nd result verification');
}
{
my $x1 = 'ababac';
my $x2 = 'ababad';
my ($y1, $y2) = chimpx('ab', $x1, $x2);
is($x1, 'ababac', 'scalar multi args - 1st arg preservation');
is($x2, 'ababad', 'scalar multi args - 2nd arg preservation');
is($y1, 'ac', 'scalar multi args - 1st result verification');
is($y2, 'ad', 'scalar multi args - 2nd result verification');
}