This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #118567] Add a warning for prototypes if a missing
authorPeter Martini <PeterCMartini@GMail.com>
Sat, 13 Jul 2013 02:10:06 +0000 (22:10 -0400)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 13 Jul 2013 08:10:39 +0000 (01:10 -0700)
 closing bracket is detected

pod/perldiag.pod
t/comp/proto.t
toke.c

index 9aca0db..1012507 100644 (file)
@@ -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
index 213ae3a..947a232 100644 (file)
@@ -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 (file)
--- 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",