X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F10-base.t;h=48090834ca28e352157b7461fe2a60916a5eaf21;hb=4da9a0bfbda4e7ed439a1e9de9994e1a63b40c0d;hp=70a898513d77e18f09fe9632d78cb21cb6ffc975;hpb=a0ade8a080a0ebf61171ee3082183cd2e53f59af;p=perl%2Fmodules%2Fsubs-auto.git diff --git a/t/10-base.t b/t/10-base.t index 70a8985..4809083 100644 --- a/t/10-base.t +++ b/t/10-base.t @@ -3,7 +3,9 @@ use strict; use warnings; -use Test::More tests => 60; +use Test::More tests => 92; + +# ... Helpers ................................................................. 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]/ }, @@ -40,6 +42,8 @@ sub _got_ok { is($@, '', $_[0]); } my $warn; +# ... First test that the default behaviour apply to all the subs ............. + my $bar; sub bar { $bar = 1 } @@ -48,29 +52,33 @@ _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 +eval "flip"; # Not called in subs::auto zone, not declared, not defined _got_bareword('flip', 1, eval => 1); -eval "flop"; # Not called in sub::auto zone, declared, not defined +eval "flop"; # Not called in subs::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 +eval "qux"; # Called in subs::auto zone, not declared, not defined _got_bareword('qux', 1, eval => 1); my $blech; -eval "blech"; # Called in sub::auto zone, declared, not defined +eval "blech"; # Called in subs::auto zone, declared outside, not defined _got_undefined('blech', 1, eval => 1); my $wut; -eval "wut"; # Called in sub::auto zone, declared, defined +eval "wut"; # Called in subs::auto zone, declared and defined outside _got_ok('compiling to wut()'); # === Starting from here ====================================================== use subs::auto; +# ... Called in subs::auto zone only, not declared, not defined ............... + eval { onlycalledonce 1, 2 }; -_got_undefined('onlycalledonce', 72); +_got_undefined('onlycalledonce', __LINE__-1); + +# ... Method calls, anyone? ................................................... eval { Test::More->import() }; _got_ok('don\'t touch class names'); @@ -80,28 +88,71 @@ 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; -my $y = eval { - foo 1, 2, \%h; -}; +# ... Called in subs::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 { - 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'); + +# ... Called in subs::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 subs::auto zone, not declared, not defined .................... + 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); + +# ... Are our subs visible in the symbol table entry or what? ................. { no strict 'refs'; @@ -110,17 +161,21 @@ _got_undefined('qux', 103); isnt(*{'::yay'}{CODE}, undef, 'yay is defined'); isnt(*{'::foo'}{CODE}, undef, 'foo is defined'); is(*{'::flip'}{CODE}, undef, 'flip isn\'t defined'); - isnt(*{'::flop'}{CODE}, undef, 'flip is defined'); + isnt(*{'::flop'}{CODE}, undef, 'flop is defined'); is(*{'::qux'}{CODE}, undef, 'qux isn\'t defined'); isnt(*{'::blech'}{CODE}, undef, 'blech is defined'); isnt(*{'::wut'}{CODE}, undef, 'wut is defined'); } +# ... Let's check that this didn't induce any quantic effect .................. + 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); + +# ... Define foo .............................................................. sub foo { if ($_[2]) { @@ -133,15 +188,15 @@ sub foo { } } -eval { - foo 3, 4, { }; -}; +eval { foo 3, 4, { } }; _got_ok('compiling to foo(3,4,{})'); is($foo, 7, 'foo really was executed'); +# ... Locally define qux (declared outside, not defined) ...................... + $warn = undef; eval { - local $SIG{__WARN__} = sub { $warn = $_[0] =~ /Subroutine\s+\S+redefined/ }; + local $SIG{__WARN__} = sub { $warn = $_[0] =~ /Subroutine\s+\S+redefined/ }; local *qux = sub { $qux = $_[0] }; qux 5; }; @@ -149,6 +204,8 @@ _got_ok('compiling to qux(5)'); is($qux, 5, 'qux really was executed'); is($warn, undef, 'no redefine warning'); +# ... Locally define blech (declared and defined outside) ..................... + $warn = undef; eval { local $SIG{__WARN__} = sub { $warn = $_[0] =~ /Subroutine\s+\S+redefined/ }; @@ -159,15 +216,19 @@ _got_ok('compiling to blech(7)'); is($blech, 7, 'blech really was executed'); is($warn, undef, 'no redefine warning'); +# ... But now they aren't anymore ............................................. + 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; +# ... Barewords are strings when the pragma isn't in effect ................... + my $b; my $cb = eval { sub { @@ -175,13 +236,21 @@ my $cb = eval { no strict; no warnings 'reserved'; blech; - } + } } }; _got_ok('compiling to bareword'); $cb->(); is($b, 'blech', 'bareword ok'); +# ... Does foo's definition still valid outside of the pragma scope? .......... + +eval { foo 13, 1, { } }; +_got_ok('compiling to foo(13,1,{})'); +is($foo, 14, 'foo really was executed'); + +# ... Locally define qux ...................................................... + $warn = undef; { local $SIG{__WARN__} = sub { $warn = $_[0] =~ /Subroutine\s+\S+redefined/; diag $_[0] }; @@ -192,6 +261,8 @@ _got_ok('compiling to qux(3)'); is($qux, 6, 'new qux really was executed'); is($warn, undef, 'no redefine warning'); +# ... Locally define blech .................................................... + $warn = undef; { local $SIG{__WARN__} = sub { $warn = $_[0] =~ /Subroutine\s+\S+redefined/ }; @@ -202,29 +273,35 @@ _got_ok('compiling to blech(9)'); is($blech, 18, 'new blech really was executed'); is($warn, undef, 'no redefine warning'); +# ... But now they aren't anymore ............................................. + eval "qux"; _got_bareword('qux', 1, eval => 1); eval "blech"; _got_undefined('blech', 1, eval => 1); +# ... How's my symbol table, Doug Hastings? ................................... + { - no strict qw/refs subs/; + no strict qw; is(*{::feh}{CODE}, undef, 'feh isn\'t defined'); is(*{::feh}{CODE}, undef, 'feh isn\'t defined, really'); isnt(*{::yay}{CODE}, undef, 'yay is defined'); isnt(*{::foo}{CODE}, undef, 'foo is defined'); # calls foo is($foo, '::foo', 'foo was called'); is(*{::flip}{CODE}, undef, 'flip isn\'t defined'); - isnt(*{::flop}{CODE}, undef, 'flip is defined'); + isnt(*{::flop}{CODE}, undef, 'flop is defined'); is(*{::qux}{CODE}, undef, 'qux isn\'t defined'); isnt(*{::blech}{CODE}, undef, 'blech is defined'); isnt(*{::wut}{CODE}, undef, 'wut is defined'); } +# ... Declareth thy oneth thad shalt be ....................................... + sub blech; eval { blech }; -_got_undefined('blech', 226); +_got_undefined('blech', __LINE__-1); sub flop; @@ -235,18 +312,73 @@ sub wut { $wut = ($_[0] || 0) + length($_[1] || ''); '::wut' } sub yay { @yay = @_; '::yay' } -{ - use subs::auto; - eval "no subs::auto; meh"; - _got_bareword("meh", 1, eval => 1); +# === Restarting from there =================================================== +use subs::auto; + +# ... How does the pragma propagates through eval STRING? ..................... + +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'); -} + +# ... Try filehandles ......................................................... my $buf = ''; -open DONGS, '>', \$buf or die "open-in-memory: $!"; +{ + 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; + +# ... Try default filehandles ................................................. + +seek DATA, 0, 1; +my @fruits = ; +chomp @fruits; +is_deeply(\@fruits, [ qw ], 'DATA filehandle ok'); + +# ... Retest foo (declared and defined inside) ................................ + +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'); + +# ... Retest blech (declared outside, not defined) ............................ + +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); + +# ... Try _ in a filetest ..................................................... + +ok(-f $0 && -r _, '-X _'); + +__DATA__ +apple +pear +banana