# strict
use strict;
-print "1..187\n";
+print "1..196\n";
my $i = 1;
eval 'sub badproto (@bar) { 1; }';
print "not " unless $warn =~ /Illegal character in prototype for main::badproto : \@bar/;
- print "ok ", $i++, "\n";
+ print "ok ", $i++, " checking badproto - (\@bar)\n";
eval 'sub badproto2 (bar) { 1; }';
print "not " unless $warn =~ /Illegal character in prototype for main::badproto2 : bar/;
- print "ok ", $i++, "\n";
+ print "ok ", $i++, " checking badproto2 - (bar)\n";
eval 'sub badproto3 (&$bar$@) { 1; }';
print "not " unless $warn =~ /Illegal character in prototype for main::badproto3 : &\$bar\$\@/;
- print "ok ", $i++, "\n";
+ print "ok ", $i++, " checking badproto3 - (&\$bar\$\@)\n";
eval 'sub badproto4 (@ $b ar) { 1; }';
+ # This one emits two warnings
print "not " unless $warn =~ /Illegal character in prototype for main::badproto4 : \@ \$b ar/;
- print "ok ", $i++, "\n";
+ print "ok ", $i++, " checking badproto4 - (\@ \$b ar) - illegal character\n";
+ print "not " unless $warn =~ /Prototype after '\@' for main::badproto4 : \@ \$b ar/;
+ print "ok ", $i++, " checking badproto4 - (\@ \$b ar) - prototype after '\@'\n";
+
+ eval 'sub badproto5 ($_$) { 1; }';
+ print "not " unless $warn =~ /Illegal character after '_' in prototype for main::badproto5 : \$_\$/;
+ 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";
}
# make sure whitespace in prototypes works
unless eval 'sub uniproto12 (;;;+) {} uniproto12 $_, 1' or warn $@;
print "ok ", $i++, " - uniproto12 (;;;*)\n";
print "not "
- unless eval 'sub uniproto12 ( ; ; ; + ) {} uniproto12 $_, 1' or warn $@;
-print "ok ", $i++, " - uniproto12 ( ; ; ; * )\n";
+ unless eval 'sub uniproto13 ( ; ; ; + ) {} uniproto13 $_, 1' or warn $@;
+print "ok ", $i++, " - uniproto13 ( ; ; ; * )\n";
+
# Test that a trailing semicolon makes a sub have listop precedence
sub unilist ($;) { $_[0]+1 }
bool proto_after_greedy_proto = FALSE;
bool must_be_last = FALSE;
bool underscore = FALSE;
- bool seen_underscore = FALSE;
+ bool bad_proto_after_underscore = FALSE;
PERL_ARGS_ASSERT_VALIDATE_PROTO;
if (!isSPACE(*p)) {
if (must_be_last)
proto_after_greedy_proto = TRUE;
+ if (underscore) {
+ if (!strchr(";@%", *p))
+ bad_proto_after_underscore = TRUE;
+ underscore = FALSE;
+ }
if (!strchr("$@%*;[]&\\_+", *p) || *p == '\0') {
bad_proto = TRUE;
}
else {
- if (underscore) {
- if(!strchr(";@%", *p))
- bad_proto = TRUE;
- underscore = FALSE;
- }
-
if (*p == '[')
in_brackets = TRUE;
else if (*p == ']')
greedy_proto = *p;
}
else if (*p == '_')
- underscore = seen_underscore = TRUE;
+ underscore = TRUE;
}
if (*p == '\\')
after_slash = TRUE;
greedy_proto, SVfARG(name), p);
if (bad_proto)
Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
- "Illegal character %sin prototype for %"SVf" : %s",
- seen_underscore ? "after '_' " : "", SVfARG(name), p);
+ "Illegal character in prototype for %"SVf" : %s",
+ SVfARG(name), p);
+ if (bad_proto_after_underscore)
+ Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
+ "Illegal character after '_' in prototype for %"SVf" : %s",
+ SVfARG(name), p);
}
return (! (proto_after_greedy_proto || bad_proto) );