view release on metacpan or  search on metacpan

t/10-base.t  view on Meta::CPAN

 } else {
  like($@, $re, $msg);
 }
}

sub _got_bareword { _got_test(@_, name => 'bareword'); }

sub _got_undefined {
 my $sub = shift;
 $sub = 'main::' . $sub if $sub !~ /::/;
 _got_test($sub, @_, name => 'undefined');
}

sub _got_ok { is($@, '', $_[0]); }

my $warn;

# ... First test that the default behaviour apply to all the subs .............

my $bar;
sub bar { $bar = 1 }

eval "yay 11, 13"; # Defined on the other side of the scope
_got_ok('compiling to yay(11,13)');
our @yay;
is_deeply(\@yay, [ 11, 13 ], 'yay really was executed');

eval "flip"; # Not called in sub::auto zone, not declared, not defined
_got_bareword('flip', 1, eval => 1);

eval "flop"; # Not called in sub::auto zone, declared outside, not defined
_got_undefined('flop', 1, eval => 1);

my $qux;
eval "qux"; # Called in sub::auto zone, not declared, not defined
_got_bareword('qux', 1, eval => 1);

my $blech;
eval "blech"; # Called in sub::auto zone, declared outside, not defined
_got_undefined('blech', 1, eval => 1);

my $wut;
eval "wut"; # Called in sub::auto zone, declared and defined outside
_got_ok('compiling to wut()');

# === Starting from here ======================================================
use subs::auto;

# ... Called in sub::auto zone only, not declared, not defined ................

eval { onlycalledonce 1, 2 };
_got_undefined('onlycalledonce', __LINE__-1);

# ... Method calls, anyone? ...................................................

eval { Test::More->import() };
_got_ok('don\'t touch class names');

my $strict;
sub strict { $strict = 1; undef }
eval { strict->import };
is($strict, 1, 'the strict subroutine was called');

# ... Test hash keys ..........................................................

my $c = 0;
my %h = (
 a => 5,
 b => 7,
);
sub a { ++$c }
sub b { ++$c }
is($c, 0, "hash keys shouldn't be converted");

my $foo;
our @foo;

# ... Called in sub::auto zone, declared and defined inside ...................

eval { foo 1, 2, \%h };
_got_ok('compiling to foo(1,2,\\\%h)');
is($foo, 15, 'foo really was executed');

eval { foo(3, 4, \%h) };
_got_ok('compiling to foo(3,4,\\\%h)');
is($foo, 19, 'foo() really was executed');

eval { local @_ = (5, 6, \%h); &foo };
_got_ok('compiling to foo(5,6,\\\%h)');
is($foo, 23, '&foo really was executed');

eval { &foo(7, 8, \%h) };
_got_ok('compiling to foo(7,8,\\\%h)');
is($foo, 27, '&foo() really was executed');

# ... Called in sub::auto zone, declared and defined outside ..................

eval { wut 13, "what" };
_got_ok('compiling to wut(13,"what")');
is($wut, 17, 'wut really was executed');

eval { wut(17, "what") };
_got_ok('compiling to wut(17,"what")');
is($wut, 21, 'wut() really was executed');

eval { local @_ = (21, "what"); &wut };
_got_ok('compiling to wut(21,"what")');
is($wut, 25, '&wut really was executed');

eval { &wut(25, "what") };
_got_ok('compiling to wut(25,"what")');
is($wut, 29, '&wut() really was executed');

# ... Called in sub::auto zone, not declared, not defined .....................

eval { qux };
_got_undefined('qux', __LINE__-1);

eval { qux() };
_got_undefined('qux', __LINE__-1);