The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package ImplicitTest;
use Test::More tests => 26;
use Devel::DumpTrace::PPI ':test';
use PPI;
use strict;
use warnings;

*preval = \&Devel::DumpTrace::PPI::preval;
*__add_implicit_elements = \&Devel::DumpTrace::PPI::__add_implicit_elements;

sub to_PPI_Statement {
  my $code = shift;
  $::doc = new PPI::Document(\$code);  # must keep document in scope
  my $s = $::doc->find('PPI::Statement');
  for my $ss (@{$s}) {
    __add_implicit_elements($ss);   # added for v0.10
    Devel::DumpTrace::PPI::__add_implicit_to_given_when_blocks($ss)
	if ref($ss) eq 'PPI::Statement::Given';
  }
  return $s->[0];
}

# implicit $_ =~ qr/regexp/
# implicit $_ in built in functions
# implicit @_ or @ARGV in shift, pop

$_ = "FOOasdfBAR";
my $doc = new PPI::Document(\'m{asdf} && print "Contains asdf\n"'); #');
my $s = $doc->find('PPI::Statement');
__add_implicit_elements($s->[0]);
my @z = preval($s->[0], 1, __PACKAGE__);
ok("@z" =~ /\$_:.*$_.*=~\s*m\{asdf\}/,
   "implicit \$_=~ inserted before regexp");

$s = to_PPI_Statement('s/hello/hey/i && print "$_ world\n"');       #');
@z = preval($s, 1, __PACKAGE__);
ok("@z" =~ m!\$_:.*$_.*=~\s*s/hello/hey/i!,
   "implicit \$_=~ inserted before substitution");


@z = preval(
	    to_PPI_Statement('my $z = log;'),
	    1, __PACKAGE__);
ok("@z" =~ m/\$_/,
   "inserted implicit \$_ for builtin function");

@z = preval(
	    to_PPI_Statement('my $z = ref'),
	    1, __PACKAGE__);
ok("@z" =~ m/\$_/,
   "inserted implicit \$_ for builtin function");

@z = preval(
	    to_PPI_Statement('my $z = shift'),
	    1, __PACKAGE__);
ok("@z" =~ m/\@ARGV/,
   "inserted implicit \@ARGV to shift/pop call");


sub naked_pop_inside_sub_test {
  my @z = preval(
	    to_PPI_Statement('$b = pop'),
	    1, __PACKAGE__);
  ok("@z" =~ m/\@_/,
     "inserted implicit \@_ after shift/pop call inside sub")
  or diag(@z);
}
&naked_pop_inside_sub_test();


@z = preval(
	    to_PPI_Statement('if (-f)'),
	    1, __PACKAGE__);
ok("@z" =~ m/-f\s+\$_/,
   "inserted implicit \$_ for file test");

@z = preval(
	    to_PPI_Statement('if (-t)'),
	    1, __PACKAGE__);
ok("@z" !~ m/\$_/,
   "no implicit \$_ for -t file test");



# implicit smart match in given/when statements
#
# if you have an old Perl (pre given-when statements) but
# a newer version of PPI, these tests will still pass

SKIP: {

    if ($PPI::VERSION < 1.205) {
	skip "no given/when statements in PPI v$PPI::VERSION", 17;
    }


# 1. when expressions that should have implicit smart match
    for my $expr ('undef', '7.5', '"foo"', '$bar', '@bar', '[@bar]',
	      '\@bar', '[1,3,5,7,9]', ) {

        @z = preval(
            to_PPI_Statement('given($foo) { when (' . $expr . ') { say } }'),
            1, __PACKAGE__);

        ok("@z" =~ m/\$_:\S+\s*~~/ || "@z" =~ m/\$foo:\S+\s*~~/,
           "implicit smart match for when ($expr) {...} expression")
            or diag("processed statement was:  ",@z,", expected smart match");


    }

# 2. when expressions that should NOT have implicit smart match
    foreach my $expr ('defined', 'exists $bar{$_}', 'eof', '-d',
		  'm{pattern}', '!$bar', '$bar..$baz',
		  '$bar < $baz', '$bar == $baz', '\&func') {

        @z = preval(
            to_PPI_Statement('given($foo) { when (' . $expr . ') { say } }'),
            1, __PACKAGE__);

        ok("@z" !~ m/\$_:\S+\s*~~/ && "@z" !~ m/\$foo:\S+\s*~~/,
           "no implicit smart match for when ($expr) {...} expression")
            or diag("processed statement was:  ", @z,
                    ", expected no smart match");
    }

}