In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/4c7c9f9a23eabbe80581a1423a8542777105d1ef?hp=cb79f740dae4d41cfe556ac0e57a6e7afcd0fb6f>
- Log ----------------------------------------------------------------- commit 4c7c9f9a23eabbe80581a1423a8542777105d1ef Author: Nicholas Clark <[email protected]> Date: Sun Mar 13 21:33:25 2011 +0000 Convert t/op/anonsub.t to test.pl, strict and warnings. test.pl no longer uses closures, which removes the principal reason for avoiding it until now. anonsub.t is now 25% shorter. M t/op/anonsub.t commit 9eb41b690e9c66416ca5e28fe9acb0f2595cbd3f Author: Nicholas Clark <[email protected]> Date: Sun Mar 13 21:30:55 2011 +0000 In test.pl, avoid using a closure to capture warnings. In the general case a closure is the "right" way to do "it". However, closures, unlike local and regular subroutines, have some complexity at compile time, which means that using closures in test.pl runs the risk of closure bugs causing spurious hard to diagnose collateral damage to other tests. local is already in use, and "has" to work for capturing warnings, as $SIG{__WARN__} is localised already. M t/test.pl ----------------------------------------------------------------------- Summary of changes: t/op/anonsub.t | 87 +++++++++++++++----------------------------------------- t/test.pl | 11 +++++-- 2 files changed, 31 insertions(+), 67 deletions(-) diff --git a/t/op/anonsub.t b/t/op/anonsub.t index 6b17aa0..6624f9c 100644 --- a/t/op/anonsub.t +++ b/t/op/anonsub.t @@ -1,80 +1,39 @@ -#!./perl - -# Note : we're not using t/test.pl here, because we would need -# fresh_perl_is, and fresh_perl_is uses a closure -- a special -# case of what this program tests for. +#!./perl -w chdir 't' if -d 't'; @INC = '../lib'; -$Is_VMS = $^O eq 'VMS'; -$Is_MSWin32 = $^O eq 'MSWin32'; -$Is_NetWare = $^O eq 'NetWare'; -$ENV{PERL5LIB} = "../lib" unless $Is_VMS; +require './test.pl'; +$ENV{PERL5LIB} = "../lib" unless $^O eq 'VMS'; +use strict; $|=1; -undef $/; -@prgs = split "\n########\n", <DATA>; -print "1..", 6 + scalar @prgs, "\n"; - -$tmpfile = "asubtmp000"; -1 while -f ++$tmpfile; -END { if ($tmpfile) { 1 while unlink $tmpfile; } } +run_multiple_progs('', \*DATA); -for (@prgs){ - my $switch = ""; - if (s/^\s*(-\w+)//){ - $switch = $1; - } - my($prog,$expected) = split(/\nEXPECT\n/, $_); - open TEST, ">$tmpfile"; - print TEST "$prog\n"; - close TEST or die "Could not close: $!"; - my $results = $Is_VMS ? - `$^X "-I[-.lib]" $switch $tmpfile 2>&1` : - $Is_MSWin32 ? - `.\\perl -I../lib $switch $tmpfile 2>&1` : - $Is_NetWare ? - `perl -I../lib $switch $tmpfile 2>&1` : - `./perl $switch $tmpfile 2>&1`; - my $status = $?; - $results =~ s/\n+$//; - # allow expected output to be written as if $prog is on STDIN - $results =~ s/runltmp\d+/-/g; - $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg - $expected =~ s/\n+$//; - if ($results ne $expected) { - print STDERR "PROG: $switch\n$prog\n"; - print STDERR "EXPECTED:\n$expected\n"; - print STDERR "GOT:\n$results\n"; - print "not "; - } - print "ok ", ++$i, "\n"; +foreach my $code ('sub;', 'sub ($) ;', '{ $x = sub }', 'sub ($) && 1') { + eval $code; + like($@, qr/^Illegal declaration of anonymous subroutine at/, + "'$code' is illegal"); } -sub test_invalid_decl { - my ($code,$todo) = @_; - $todo //= ''; +{ + local $::TODO; + $::TODO = 'RT #17589 not completely resolved'; + # Here's a patch. It makes "sub;" and similar report an error immediately + # from the lexer. However the solution is not complete, it doesn't + # handle the case "sub ($) : lvalue;" (marked as a TODO test), because + # it's handled by the lexer in separate tokens, hence more difficult to + # work out. + my $code = 'sub ($) : lvalue;'; eval $code; - if ($@ =~ /^Illegal declaration of anonymous subroutine at/) { - print "ok ", ++$i, " - '$code' is illegal$todo\n"; - } else { - print "not ok ", ++$i, " - '$code' is illegal$todo\n# GOT: $@"; - } + like($@, qr/^Illegal declaration of anonymous subroutine at/, + "'$code' is illegal"); } -test_invalid_decl('sub;'); -test_invalid_decl('sub ($) ;'); -test_invalid_decl('{ $x = sub }'); -test_invalid_decl('sub ($) && 1'); -test_invalid_decl('sub ($) : lvalue;',' # TODO'); - eval "sub #foo\n{print 1}"; -if ($@ eq '') { - print "ok ", ++$i, "\n"; -} else { - print "not ok ", ++$i, "\n# GOT: $@"; -} +is($@, ''); + +done_testing(); __END__ sub X { diff --git a/t/test.pl b/t/test.pl index d83f69b..d9b9432 100644 --- a/t/test.pl +++ b/t/test.pl @@ -1097,13 +1097,18 @@ WHOA _ok( !$diag, _where(), $name ); } +# Purposefully avoiding a closure. +sub __capture { + push @::__capture, join "", @_; +} + sub capture_warnings { my $code = shift; - my @w; - local $SIG {__WARN__} = sub {push @w, join "", @_}; + local @::__capture; + local $SIG {__WARN__} = \&__capture; &$code; - return @w; + return @::__capture; } # This will generate a variable number of tests. -- Perl5 Master Repository
