This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ucfirst() new signature diagnostic messages
authorDavid Mitchell <davem@iabyn.com>
Mon, 25 Jul 2016 10:37:37 +0000 (11:37 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 3 Aug 2016 19:54:41 +0000 (20:54 +0100)
e.g.

    a slurpy parameter may not have a default value
=>
    A slurpy parameter may not have a default value

Also, split the "Too %s arguments for subroutine" diagnostic into
separate "too few" and "too many" entries in perldiag.

Based on suggestions by Father Chrysostomos.

perly.act
perly.h
perly.tab
perly.y
pod/perldiag.pod
pp.c
t/op/signatures.t
toke.c

index 07e5fc2..407c27a 100644 (file)
--- a/perly.act
+++ b/perly.act
@@ -826,7 +826,7 @@ case 2:
                             PL_parser->sig_slurpy = sigil;
 
                             if (defexpr)
-                                yyerror("a slurpy parameter may not have "
+                                yyerror("A slurpy parameter may not have "
                                         "a default value");
 
                             (yyval.opval) = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
@@ -1973,6 +1973,6 @@ case 2:
     
 
 /* Generated from:
- * 6deb43709ef5dcefc6a8b7059606df5a86eae75b6a769e7451f39368b1de5d9d perly.y
+ * f197986843aaef0ab285344b7144e3bf7b35fea3ed9aa46884a25d31c7485700 perly.y
  * 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl
  * ex: set ro: */
diff --git a/perly.h b/perly.h
index 25c69c5..f680902 100644 (file)
--- a/perly.h
+++ b/perly.h
@@ -181,6 +181,6 @@ int yyparse (void);
 
 
 /* Generated from:
- * 6deb43709ef5dcefc6a8b7059606df5a86eae75b6a769e7451f39368b1de5d9d perly.y
+ * f197986843aaef0ab285344b7144e3bf7b35fea3ed9aa46884a25d31c7485700 perly.y
  * 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl
  * ex: set ro: */
index 997be30..338bd7c 100644 (file)
--- a/perly.tab
+++ b/perly.tab
@@ -1109,6 +1109,6 @@ static const toketypes yy_type_tab[] =
 };
 
 /* Generated from:
- * 6deb43709ef5dcefc6a8b7059606df5a86eae75b6a769e7451f39368b1de5d9d perly.y
+ * f197986843aaef0ab285344b7144e3bf7b35fea3ed9aa46884a25d31c7485700 perly.y
  * 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl
  * ex: set ro: */
diff --git a/perly.y b/perly.y
index 2f3647f..34e2264 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -662,7 +662,7 @@ sigslurpelem: sigslurpsigil sigvarname sigdefault/* def only to catch errors */
                             PL_parser->sig_slurpy = sigil;
 
                             if (defexpr)
-                                yyerror("a slurpy parameter may not have "
+                                yyerror("A slurpy parameter may not have "
                                         "a default value");
 
                             $$ = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
index 557fadd..fa9cd5e 100644 (file)
@@ -44,14 +44,14 @@ letter.
 
 =over 4
 
-=item a signature parameter must start with '$', '@' or '%'
+=item A signature parameter must start with '$', '@' or '%'
 
 (F) Each subroutine signature parameter declaration must start with a valid
 sigil; for example:
 
     sub foo ($a, $, $b = 1, @c) {}
 
-=item a slurpy parameter may not have a default value
+=item A slurpy parameter may not have a default value
 
 (F) Only scalar subroutine signature parameters may have a default value;
 for example:
@@ -2592,7 +2592,7 @@ declaration.  The '_' in a prototype must be followed by a ';',
 indicating the rest of the parameters are optional, or one of '@'
 or '%', since those two will accept 0 or more final parameters.
 
-=item illegal character following sigil in a subroutine signature
+=item Illegal character following sigil in a subroutine signature
 
 (F) A parameter in a subroutine signature contained an unexpected character
 following the C<$>, C<@> or C<%> sigil character. Normally the sigil
@@ -6043,12 +6043,6 @@ uc(), or ucfirst() (or their string-inlined versions), but you
 specified an illegal mapping.
 See L<perlunicode/"User-Defined Character Properties">.
 
-=item Too %s arguments for subroutine
-
-(F) A subroutine using a signature received too few or too many arguments
-than required by the signature.  The caller of the subroutine is
-presumably at fault.
-
 =item Too deeply nested ()-groups
 
 (F) Your template contains ()-groups with a ridiculously deep nesting level.
@@ -6058,6 +6052,12 @@ presumably at fault.
 (F) There has to be at least one argument to syscall() to specify the
 system call to call, silly dilly.
 
+=item Too few arguments for subroutine
+
+(F) A subroutine using a signature received too few arguments than
+required by the signature.  The caller of the subroutine is presumably
+at fault.
+
 =item Too late for "-%s" option
 
 (X) The #! line (or local equivalent) in a Perl script contains the
@@ -6088,6 +6088,13 @@ BEGIN block.
 
 (F) The function requires fewer arguments than you specified.
 
+=item Too many arguments for subroutine
+
+(F) A subroutine using a signature received too many arguments than
+required by the signature.  The caller of the subroutine is presumably
+at fault.
+
+
 =item Too many )'s
 
 (A) You've accidentally run your script through B<csh> instead of Perl.
diff --git a/pp.c b/pp.c
index 1fba3d9..69b40e2 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -6811,6 +6811,8 @@ PP(pp_argcheck)
     too_few = (argc < (params - opt_params));
 
     if (UNLIKELY(too_few || (!slurpy && argc > params)))
+        /* diag_listed_as: Too few arguments for subroutine */
+        /* diag_listed_as: Too many arguments for subroutine */
         Perl_croak_caller("Too %s arguments for subroutine",
                             too_few ? "few" : "many");
 
index 6470586..f5c4dc1 100644 (file)
@@ -579,10 +579,10 @@ is eval("t034(456, 789, 987, 654, 321, 111)"), "456/789/987/654/321/111;6";
 is $a, 123;
 
 eval "#line 8 foo\nsub t136 (\@abc = 222) { }";
-is $@, qq{a slurpy parameter may not have a default value at foo line 8, near "222) "\n};
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n};
 
 eval "#line 8 foo\nsub t137 (\@abc =) { }";
-is $@, qq{a slurpy parameter may not have a default value at foo line 8, near "=) "\n};
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n};
 
 sub t035 (@) { $a }
 is prototype(\&t035), undef;
@@ -597,10 +597,10 @@ is eval("t035(456, 789, 987, 654, 321, 111)"), 123;
 is $a, 123;
 
 eval "#line 8 foo\nsub t138 (\@ = 222) { }";
-is $@, qq{a slurpy parameter may not have a default value at foo line 8, near "222) "\n};
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n};
 
 eval "#line 8 foo\nsub t139 (\@ =) { }";
-is $@, qq{a slurpy parameter may not have a default value at foo line 8, near "=) "\n};
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n};
 
 sub t039 (%abc) { join("/", map { $_."=".$abc{$_} } sort keys %abc) }
 is prototype(\&t039), undef;
@@ -619,10 +619,10 @@ is eval("t039(456, 789, 987, 654, 321, 111)"), "321=111/456=789/987=654";
 is $a, 123;
 
 eval "#line 8 foo\nsub t140 (\%abc = 222) { }";
-is $@, qq{a slurpy parameter may not have a default value at foo line 8, near "222) "\n};
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n};
 
 eval "#line 8 foo\nsub t141 (\%abc =) { }";
-is $@, qq{a slurpy parameter may not have a default value at foo line 8, near "=) "\n};
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n};
 
 sub t040 (%) { $a }
 is prototype(\&t040), undef;
@@ -641,10 +641,10 @@ is eval("t040(456, 789, 987, 654, 321, 111)"), 123;
 is $a, 123;
 
 eval "#line 8 foo\nsub t142 (\% = 222) { }";
-is $@, qq{a slurpy parameter may not have a default value at foo line 8, near "222) "\n};
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n};
 
 eval "#line 8 foo\nsub t143 (\% =) { }";
-is $@, qq{a slurpy parameter may not have a default value at foo line 8, near "=) "\n};
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n};
 
 sub t041 ($a, @b) { $a.";".join("/", @b) }
 is prototype(\&t041), undef;
@@ -1082,11 +1082,11 @@ eval "#line 8 foo\nsub t093 (\%#foo\na) { }";
 like $@, qr{\A'#' not allowed immediately following a sigil in a subroutine signature at foo line 8, near "\(%"\n};
 
 eval "#line 8 foo\nsub t094 (123) { }";
-like $@, qr{\Aa signature parameter must start with '\$', '\@' or '%' at foo line 8, near "\(1"\n};
+like $@, qr{\AA signature parameter must start with '\$', '\@' or '%' at foo line 8, near "\(1"\n};
 
 eval "#line 8 foo\nsub t095 (\$a, 123) { }";
 is $@, <<EOF;
-a signature parameter must start with '\$', '\@' or '%' at foo line 8, near ", 1"
+A signature parameter must start with '\$', '\@' or '%' at foo line 8, near ", 1"
 syntax error at foo line 8, near ", 123"
 EOF
 
@@ -1096,7 +1096,7 @@ is $@, qq{syntax error at foo line 8, near "\$a 123"\n};
 eval "#line 8 foo\nsub t097 (\$a { }) { }";
 is $@, <<EOF;
 syntax error at foo line 8, near "\$a { "
-a signature parameter must start with '\$', '\@' or '%' at foo line 8, near "{ }"
+A signature parameter must start with '\$', '\@' or '%' at foo line 8, near "{ }"
 Missing right curly or square bracket at foo line 8, at end of line
 EOF
 
@@ -1108,7 +1108,7 @@ EOF
 
 eval "#line 8 foo\nsub t099 (\$\$) { }";
 is $@, <<EOF;
-illegal character following sigil in a subroutine signature at foo line 8, near "(\$"
+Illegal character following sigil in a subroutine signature at foo line 8, near "(\$"
 syntax error at foo line 8, near "\$\$"
 EOF
 
diff --git a/toke.c b/toke.c
index 74313dc..663e591 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4827,7 +4827,7 @@ Perl_yylex(pTHX)
         case '%':
             /* spot stuff that looks like an prototype */
             if (strchr("$:@%&*;\\[]", *s)) {
-                yyerror("illegal character following sigil in a subroutine signature");
+                yyerror("Illegal character following sigil in a subroutine signature");
                 break;
             }
             /* '$#' is banned, while '$ # comment' isn't */
@@ -4857,7 +4857,7 @@ Perl_yylex(pTHX)
             break;
 
         default:
-            yyerror("a signature parameter must start with '$', '@' or '%'");
+            yyerror("A signature parameter must start with '$', '@' or '%'");
             /* very crude error recovery: skip to likely next signature
              * element */
             while (*s && *s != '$' && *s != '@' && *s != '%' && *s != ')')