In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/50278ed0ff8eeb370e748884655978f718c551a4?hp=80f78131dd30483862380a927f70b00e4b9a288b>
- Log ----------------------------------------------------------------- commit 50278ed0ff8eeb370e748884655978f718c551a4 Author: Peter Martini <[email protected]> Date: Fri Jul 12 22:10:06 2013 -0400 [perl #118567] Add a warning for prototypes if a missing closing bracket is detected ----------------------------------------------------------------------- Summary of changes: pod/perldiag.pod | 5 +++++ t/comp/proto.t | 15 ++++++++++++++- toke.c | 4 ++++ 3 files changed, 23 insertions(+), 1 deletion(-) diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 9aca0db..1012507 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2981,6 +2981,11 @@ they have a name with which they can be found. are always mentioned with the $ in Perl, unlike in the shells, where it can vary from one line to the next. +=item Missing ']' in prototype for %s : %s + +(W illegalproto) A grouping was started with C<[> but never closed with +C<]>. + =item (Missing operator before %s?) (S syntax) This is an educated guess made in conjunction with the message diff --git a/t/comp/proto.t b/t/comp/proto.t index 213ae3a..947a232 100644 --- a/t/comp/proto.t +++ b/t/comp/proto.t @@ -18,7 +18,7 @@ BEGIN { # strict use strict; -print "1..196\n"; +print "1..199\n"; my $i = 1; @@ -691,21 +691,34 @@ for my $p ( "", qw{ () ($) ($@) ($%) ($;$) (&) (&\@) (&@) (%) (\%) (\@) } ) { print "ok ", $i++, " checking badproto5 - (\$_\$) - illegal character after '_'\n"; print "not " if $warn =~ /Illegal character in prototype for main::badproto5 : \$_\$/; print "ok ", $i++, " checking badproto5 - (\$_\$) - but not just illegal character\n"; + eval 'sub badproto6 (bar_) { 1; }'; print "not " unless $warn =~ /Illegal character in prototype for main::badproto6 : bar_/; print "ok ", $i++, " checking badproto6 - (bar_) - illegal character\n"; print "not " if $warn =~ /Illegal character after '_' in prototype for main::badproto6 : bar_/; print "ok ", $i++, " checking badproto6 - (bar_) - shouldn't add \"after '_'\"\n"; + eval 'sub badproto7 (_;bar) { 1; }'; print "not " unless $warn =~ /Illegal character in prototype for main::badproto7 : _;bar/; print "ok ", $i++, " checking badproto7 - (_;bar) - illegal character\n"; print "not " if $warn =~ /Illegal character after '_' in prototype for main::badproto7 : _;bar/; print "ok ", $i++, " checking badproto7 - (_;bar) - shouldn't add \"after '_'\"\n"; + eval 'sub badproto8 (_b) { 1; }'; print "not " unless $warn =~ /Illegal character after '_' in prototype for main::badproto8 : _b/; print "ok ", $i++, " checking badproto8 - (_b) - illegal character after '_'\n"; print "not " unless $warn =~ /Illegal character in prototype for main::badproto8 : _b/; print "ok ", $i++, " checking badproto8 - (_b) - just illegal character\n"; + + eval 'sub badproto9 ([) { 1; }'; + print "not " unless $warn =~ /Missing '\]' in prototype for main::badproto9 : \[/; + print "ok ", $i++, " checking for matching bracket\n"; + + eval 'sub badproto10 ([_]) { 1; }'; + print "not " if $warn =~ /Missing '\]' in prototype for main::badproto10 : \[/; + print "ok ", $i++, " checking badproto10 - ([_]) - shouldn't trigger matching bracket\n"; + print "not " unless $warn =~ /Illegal character after '_' in prototype for main::badproto10 : \[_\]/; + print "ok ", $i++, " checking badproto10 - ([_]) - should trigger after '_' warnings\n"; } # make sure whitespace in prototypes works diff --git a/toke.c b/toke.c index 45f9f0e..00c8964 100644 --- a/toke.c +++ b/toke.c @@ -1661,6 +1661,10 @@ Perl_validate_proto(pTHX_ SV *name, SV *proto, bool warn) Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO), "Prototype after '%c' for %"SVf" : %s", greedy_proto, SVfARG(name), p); + if (in_brackets) + Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO), + "Missing ']' in prototype for %"SVf" : %s", + SVfARG(name), p); if (bad_proto) Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO), "Illegal character in prototype for %"SVf" : %s", -- Perl5 Master Repository
