use strict;
use warnings;
-use Test::More tests => 59;
+use Test::More tests => 92;
my %_re = (
bareword => sub { qr/^Bareword\s+['"]?\s*$_[0]\s*['"]?\s+not\s+allowed\s+while\s+["']?\s*strict\s+subs\s*['"]?\s+in\s+use\s+at\s+$_[1]\s+line\s+$_[2]/ },
use subs::auto;
eval { onlycalledonce 1, 2 };
-_got_undefined('onlycalledonce', 72);
+_got_undefined('onlycalledonce', __LINE__-1);
eval { Test::More->import() };
_got_ok('don\'t touch class names');
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;
-my $y = eval {
- foo 1, 2, \%h;
-};
+eval { foo 1, 2, \%h };
_got_ok('compiling to foo(1,2,\\\%h)');
is($foo, 15, 'foo really was executed');
-eval {
- wut 13, "what"
-};
+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');
+
+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');
+
eval { qux };
-_got_undefined('qux', 103);
+_got_undefined('qux', __LINE__-1);
+
+eval { qux() };
+_got_undefined('qux', __LINE__-1);
+
+eval { &qux };
+_got_undefined('qux', __LINE__-1);
+
+eval { &qux() };
+_got_undefined('qux', __LINE__-1);
{
no strict 'refs';
}
eval { no warnings; no strict; qux };
-_got_undefined('qux', 119);
+_got_undefined('qux', __LINE__-1);
eval { no warnings; no strict; blech };
-_got_undefined('blech', 122);
+_got_undefined('blech', __LINE__-1);
sub foo {
if ($_[2]) {
}
}
-eval {
- foo 3, 4, { };
-};
+eval { foo 3, 4, { } };
_got_ok('compiling to foo(3,4,{})');
is($foo, 7, 'foo really was executed');
is($warn, undef, 'no redefine warning');
eval { qux };
-_got_undefined('qux', 162);
+_got_undefined('qux', __LINE__-1);
eval { blech };
-_got_undefined('blech', 165);
+_got_undefined('blech', __LINE__-1);
# === Up to there =============================================================
no subs::auto;
$cb->();
is($b, 'blech', 'bareword ok');
+eval { foo 13, 1, { } };
+_got_ok('compiling to foo(13,1,{})');
+is($foo, 14, 'foo really was executed');
+
$warn = undef;
{
local $SIG{__WARN__} = sub { $warn = $_[0] =~ /Subroutine\s+\S+redefined/; diag $_[0] };
sub blech;
eval { blech };
-_got_undefined('blech', 226);
+_got_undefined('blech', __LINE__-1);
sub flop;
sub yay { @yay = @_; '::yay' }
-{
- use subs::auto;
- eval "no subs::auto; meh";
- _got_bareword("meh", 1, eval => 1);
+# === Restarting from there ===================================================
+use subs::auto;
+
+eval "no subs::auto; meh";
+_got_bareword("meh", 1, eval => 1);
# eval "use subs::auto; meh";
# _got_undefined('meh', 1, eval => 1, todo => 'Fails because of some bug in perl or Variable::Magic');
# eval "meh";
# _got_undefined('meh', 1, eval => 1, todo => 'Fails because of some bug in perl or Variable::Magic');
+
+my $buf = '';
+{
+ no subs::auto;
+ open DONGS, '>', \$buf or die "open-in-memory: $!";
}
+print DONGS "hlagh\n";
+is($buf, "hlagh\n", 'filehandles should\'t be touched');
+close DONGS;
+
+seek DATA, 0, 1;
+my @fruits = <DATA>;
+chomp @fruits;
+is_deeply(\@fruits, [ qw/apple pear banana/ ], 'DATA filehandle ok');
+
+eval { foo 7, 9, { } };
+_got_ok('compiling to foo(7,9,{})');
+is($foo, 16, 'foo really was executed');
+
+eval { foo(8, 10, { }) };
+_got_ok('compiling to foo(8,10,{})');
+is($foo, 18, 'foo() really was executed');
+
+eval { local @_ = (9, 11, { }); &foo };
+_got_ok('compiling to foo(9,11,{})');
+is($foo, 20, '&foo really was executed');
+
+eval { &foo(10, 12, { }) };
+_got_ok('compiling to foo(10,12,{})');
+is($foo, 22, '&foo() really was executed');
+
+eval { blech };
+_got_undefined('blech', __LINE__-1);
+
+eval { blech() };
+_got_undefined('blech', __LINE__-1);
+
+eval { &blech };
+_got_undefined('blech', __LINE__-1);
+
+eval { &blech() };
+_got_undefined('blech', __LINE__-1);
+
+ok(-f $0 && -r _, '-X _');
+
+__DATA__
+apple
+pear
+banana