In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/7355df7e69464cc1b7c5ce29234ddbcddec74500?hp=5343a617e1832a76d9e6805260dbcd579e845218>

- Log -----------------------------------------------------------------
commit 7355df7e69464cc1b7c5ce29234ddbcddec74500
Author: Father Chrysostomos <[email protected]>
Date:   Wed Dec 28 23:04:04 2011 -0800

    Croak when setting a tied @DB::args
    
    In commit f8c105437 I stopped the setting of a tied @DB::args from
    crashing, by untying the array.  Untying an array automatically with-
    out saying anything seems a little too much like action at a distance.
    For now, let’s just croak, as we can always change it later once we
    decide what should happen.  At least that’s better than crashing.

M       perl.c
M       pod/perldiag.pod
M       t/op/caller.t

commit e77511d262dd01fc8b8b509019091193efc59239
Merge: 5343a61 de53a0e
Author: Father Chrysostomos <[email protected]>
Date:   Wed Dec 28 23:00:57 2011 -0800

    [Merge] perldiag/diag.t clean-up
    
    This is a random sequence of a about one and a half dozen commits that
    all happen to be in the same area.
    
    At least one of these changes the wording of a message, so it should
    probably go in perldelta.

commit de53a0eaa2de521cb88fb796a1b75f0e072e22fb
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 21:40:57 2011 -0800

    Speed up diag.t slightly
    
    By using strings instead of creating qr// things that get flattened,
    we can reduce the run time by 5%.

M       t/porting/diag.t

commit 054235ee45cc2dc80ad1fea405144ec1e3022115
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 21:27:00 2011 -0800

    perldiag: Delete redundant entry
    
    This was made redundant three commits ago when I added more
    descriptive entries for the two variations of this message.

M       pod/perldiag.pod

commit e56cdf1008ff9b6305d9680f9bc95e30b511153b
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 18:12:20 2011 -0800

    diag.t: Delete documented items from to-do

M       t/porting/diag.t

commit d33dadbc31e691c44bb493a86681d41c8cf2071e
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 18:11:28 2011 -0800

    Regen pod issues
    
    podcheck.t doesn’t like links with formatting codes, even though the
    spec says to do it that way.

M       t/porting/known_pod_issues.dat

commit 6651ba0b0f16f7658b2640c69edd3f8bd88571ee
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 18:04:17 2011 -0800

    Document various messages in perldiag

M       pod/perldiag.pod
M       t/porting/diag.t

commit dcbac5bbcda3f6b893eade5bc95878a443cbe563
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 14:52:21 2011 -0800

    diag_listed_as galore
    
    In two instances, I actually modified to code to avoid %s for a
    constant string, as it should be faster that way.

M       gv.c
M       numeric.c
M       op.c
M       perlio.c
M       pp.c
M       pp_ctl.c
M       pp_hot.c
M       pp_sys.c
M       regexec.c
M       sv.c
M       t/porting/diag.t
M       toke.c
M       utf8.c

commit 6ad282c70d80576d5d66b25af19780fde18afd42
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 12:44:43 2011 -0800

    diag_listed_as for -S error
    
    Also teach diag.t not to mistake /* die */ for a die() call, as
    it did in this case, consequently ignoring the diag_listed_as,
    which it thought was in the middle of the call.

M       t/porting/diag.t
M       util.c

commit ae917476d21d843e7a5fcaff458c5ff8cad96328
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 10:09:01 2011 -0800

    diag_listed_as for another lv sub error

M       pp_ctl.c
M       t/porting/diag.t

commit a84828f3d678aa901130999bcf125ea17d27cce5
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 10:06:44 2011 -0800

    diag_listed_as for lvalue scalar context errors

M       pp.c
M       t/porting/diag.t

commit 4d6f11e562d40a9ab0b0578350fb6d356b550649
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 10:05:04 2011 -0800

    perldiag: Consistent formatting of categories

M       pod/perldiag.pod

commit 0d2487cdbd0457d921493d807572337c7210f389
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 09:57:59 2011 -0800

    perldiag: Tweak pack/% message
    
    to match the actual message perl emits.

M       pod/perldiag.pod
M       t/porting/diag.t

commit 4111bb7b5fe19cec0678716de643eb169c0e1881
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 09:56:25 2011 -0800

    diag.t: perldiag does not escape %
    
    It’s primarily for human consumption, and escaping % doesn’t avoid
    ambiguities anyway, as some messages contain a literal \ followed
    by a format sequence.

M       t/porting/diag.t

commit 4f12ec0e1634a909fd18b3ee71896fce1ac75b24
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 09:49:48 2011 -0800

    Document ‘Can't reset %ENV’ in perldiag

M       pod/perldiag.pod

commit de78ba8e3b56e42debaf55da6dc671a1522c95ec
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 09:43:06 2011 -0800

    Teach diag.t about "CONSTANTS" in msgs
    
    After writing this code, I found that "Can't open "BIT_BUCKET"..." was
    the only message affected, so I could have added an exception, but
    I’ve already done this, so why not?

M       t/porting/diag.t

commit 46fa9b26b8c5a79655e96eed239743492a73d89f
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 09:07:44 2011 -0800

    perldiag: Document 2 more ‘Can't open’ messages

M       pod/perldiag.pod
M       t/porting/diag.t

commit 3b1cf97d70273e62efc1ad79156df78f2d49c7eb
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 08:51:53 2011 -0800

    perldiag: Tweak ‘Can't open perl script’
    
    to match what’s in the source code more closely.

M       pod/perldiag.pod
M       t/porting/diag.t

commit 9711931a132d1dcbd76a0d85b17f351b4af98c81
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 08:33:18 2011 -0800

    Correct spelling of sv_insert error msg
    
    It is already documented in perldiag with the right spelling.

M       sv.c
M       t/porting/diag.t

commit 00455a9228d526dd30742f8768c5f710d40c2a85
Author: Father Chrysostomos <[email protected]>
Date:   Tue Dec 27 08:31:06 2011 -0800

    More diag_listed_as

M       pp_ctl.c
M       t/porting/diag.t
-----------------------------------------------------------------------

Summary of changes:
 gv.c                           |    2 +
 numeric.c                      |    3 +
 op.c                           |    3 +
 perl.c                         |    2 +-
 perlio.c                       |    1 +
 pod/perldiag.pod               |  128 ++++++++++++++++++++++++++++++++++++----
 pp.c                           |    3 +
 pp_ctl.c                       |    5 ++
 pp_hot.c                       |    1 +
 pp_sys.c                       |    7 ++
 regexec.c                      |    9 ++-
 sv.c                           |    4 +-
 t/op/caller.t                  |    8 ++-
 t/porting/diag.t               |   74 ++---------------------
 t/porting/known_pod_issues.dat |    1 +
 toke.c                         |    8 +++
 utf8.c                         |    2 +
 util.c                         |    1 +
 18 files changed, 174 insertions(+), 88 deletions(-)

diff --git a/gv.c b/gv.c
index 37c1f9c..c0baa09 100644
--- a/gv.c
+++ b/gv.c
@@ -1926,6 +1926,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN 
full_len, I32 flags,
        case '*':               /* $* */
        case '#':               /* $# */
            if (sv_type == SVt_PV)
+               /* diag_listed_as: $* is no longer supported */
                Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
                                 "$%c is no longer supported", *name);
            break;
@@ -2346,6 +2347,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
                        const SV * const name = (gvsv && SvPOK(gvsv))
                                                     ? gvsv
                                                     : newSVpvs_flags("???", 
SVs_TEMP);
+                       /* diag_listed_as: Can't resolve method "%s" 
overloading "%s" in package "%s" */
                        Perl_croak(aTHX_ "%s method \"%"SVf256
                                    "\" overloading \"%s\" "\
                                    "in package \"%"HEKf256"\"",
diff --git a/numeric.c b/numeric.c
index 2749e5e..fe8837a 100644
--- a/numeric.c
+++ b/numeric.c
@@ -180,6 +180,7 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 
*flags, NV *result)
                     continue;
                 }
                 /* Bah. We're just overflowed.  */
+               /* diag_listed_as: Integer overflow in %s number */
                Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
                                 "Integer overflow in binary number");
                 overflowed = TRUE;
@@ -302,6 +303,7 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 
*flags, NV *result)
                     continue;
                 }
                 /* Bah. We're just overflowed.  */
+               /* diag_listed_as: Integer overflow in %s number */
                Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
                                 "Integer overflow in hexadecimal number");
                 overflowed = TRUE;
@@ -407,6 +409,7 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 
*flags, NV *result)
                     continue;
                 }
                 /* Bah. We're just overflowed.  */
+               /* diag_listed_as: Integer overflow in %s number */
                Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
                               "Integer overflow in octal number");
                 overflowed = TRUE;
diff --git a/op.c b/op.c
index fea3014..7f217e7 100644
--- a/op.c
+++ b/op.c
@@ -6831,6 +6831,7 @@ S_process_special_blocks(pTHX_ const char *const 
fullname, GV *const gv,
        } else if (*name == 'C') {
            if (strEQ(name, "CHECK")) {
                if (PL_main_start)
+                   /* diag_listed_as: Too late to run %s block */
                    Perl_ck_warner(aTHX_ packWARN(WARN_VOID),
                                   "Too late to run CHECK block");
                Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, 
MUTABLE_SV(cv));
@@ -6840,6 +6841,7 @@ S_process_special_blocks(pTHX_ const char *const 
fullname, GV *const gv,
        } else if (*name == 'I') {
            if (strEQ(name, "INIT")) {
                if (PL_main_start)
+                   /* diag_listed_as: Too late to run %s block */
                    Perl_ck_warner(aTHX_ packWARN(WARN_VOID),
                                   "Too late to run INIT block");
                Perl_av_create_and_push(aTHX_ &PL_initav, MUTABLE_SV(cv));
@@ -7072,6 +7074,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
                Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
                            "Format %"SVf" redefined", SVfARG(cSVOPo->op_sv));
            } else {
+               /* diag_listed_as: Format %s redefined */
                Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
                            "Format STDOUT redefined");
            }
diff --git a/perl.c b/perl.c
index 73e1073..d50116b 100644
--- a/perl.c
+++ b/perl.c
@@ -3890,7 +3890,7 @@ Perl_init_dbargs(pTHX)
           "leak" until global destruction.  */
        av_clear(args);
        if (SvTIED_mg((const SV *)args, PERL_MAGIC_tied))
-           sv_unmagic((SV *)args, PERL_MAGIC_tied);
+           Perl_croak(aTHX_ "Cannot set tied @DB::args");
     }
     AvREIFY_only(PL_dbargs);
 }
diff --git a/perlio.c b/perlio.c
index 79c6fdf..c61ba44 100644
--- a/perlio.c
+++ b/perlio.c
@@ -1519,6 +1519,7 @@ PerlIO_layer_from_ref(pTHX_ SV *sv)
        /* This isn't supposed to happen, since PerlIO::scalar is core,
         * but could happen anyway in smaller installs or with PAR */
        if (!f)
+           /* diag_listed_as: Unknown PerlIO layer "%s" */
            Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer 
\"scalar\"");
        return f;
     }
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 93097af..ea1d259 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -614,6 +614,11 @@ be directly assigned to.
 (S io) You tried to apply an encoding that did not exist to a filehandle,
 either with open() or binmode().
 
+=item Cannot set tied @DB::args
+
+(F) C<caller> tried to set C<@DB::args>, but found it tied.  Tying C<@DB::args>
+is not supported.  (Before this error was added, it used to crash.)
+
 =item Cannot tie unreifiable array
 
 (P) You somehow managed to call C<tie> on an array that does not
@@ -1032,13 +1037,22 @@ grep().  You can usually double the curlies to get the 
same effect
 though, because the inner curlies will be considered a block that loops
 once.  See L<perlfunc/next>.
 
+=item Can't open %s
+
+(F) You tried to run a perl built with MAD support with
+the PERL_XMLDUMP environment variable set, but the file
+named by that variable could not be opened.
+
 =item Can't open %s: %s
 
 (S inplace) The implicit opening of a file through use of the C<< <> >>
 filehandle, either implicitly under the C<-n> or C<-p> command-line
-switches, or explicitly, failed for the indicated reason.  Usually this
-is because you don't have read permission for a file which you named on
-the command line.
+switches, or explicitly, failed for the indicated reason.  Usually
+this is because you don't have read permission for a file which
+you named on the command line.
+
+(F) You tried to call perl with the B<-e> switch, but F</dev/null> (or
+your operating system's equivalent) could not be opened.
 
 =item Can't open a reference
 
@@ -1081,7 +1095,7 @@ the command line for writing.
 redirection, and couldn't open the pipe into which to send data destined
 for stdout.
 
-=item Can't open perl script%s
+=item Can't open perl script "%s": %s
 
 (F) The script you specified can't be opened for the indicated reason.
 
@@ -1122,6 +1136,13 @@ probably because you don't have write permission to the 
directory.
 (P) An error peculiar to VMS.  Perl thought stdin was a pipe, and tried
 to reopen it to accept binary data.  Alas, it failed.
 
+=item Can't reset %ENV on this system
+
+(F) You called C<reset('E')> or similar, which tried to reset
+all variables in the current package beginning with "E".  In
+the main package, that includes %ENV.  Resetting %ENV is not
+supported on some systems, notably VMS.
+
 =item Can't resolve method "%s" overloading "%s" in package "%s"
 
 (F)(P) Error resolving overloading specified by a method name (as
@@ -1178,6 +1199,11 @@ into a more specialized kind of SV.  The top several SV 
types are so
 specialized, however, that they cannot be interconverted.  This message
 indicates that such a conversion was attempted.
 
+=item Can't use '%c' after -mname
+
+(F) You tried to call perl with the B<-m> switch, but you put something
+other than "=" after the module name.
+
 =item Can't use anonymous symbol table for method lookup
 
 (F) The internal routine that does method lookup was handed a symbol
@@ -1380,6 +1406,10 @@ non-printable characters.  You used it for a printable 
one, which is better
 written as simply itself, perhaps preceded by a backslash for non-word
 characters.
 
+=item Cloning substitution context is unimplemented
+
+(F) Creating a new thread inside the C<s///> operator is not supported.
+
 =item close() on unopened filehandle %s
 
 (W unopened) You tried to close a filehandle that was never opened.
@@ -1557,6 +1587,8 @@ valid magic number.
 you have also specified an explicit size for the string.  See
 L<perlfunc/pack>.
 
+=item Deep recursion on anonymous subroutine
+
 =item Deep recursion on subroutine "%s"
 
 (W recursion) This subroutine has called itself (directly or indirectly)
@@ -2040,6 +2072,12 @@ version of Perl, and this should not happen anyway.
 (F) Unlike with "next" or "last", you're not allowed to goto an
 unspecified destination.  See L<perlfunc/goto>.
 
+=item Goto undefined subroutine%s
+
+(F) You tried to call a subroutine with C<goto &sub> syntax, but
+the indicated subroutine hasn't been defined, or if it was, it
+has since been undefined.
+
 =item ()-group starts with a count
 
 (F) A ()-group started with a count.  A count is supposed to follow
@@ -2349,6 +2387,13 @@ escape was discovered.
 number.  Either it is empty, or you tried to use a character other than
 0 - 9 or A - F, a - f in a hexadecimal number.
 
+=item Invalid module name %s with -%c option: contains single ':'
+
+(F) The module argument to perl's B<-m> and B<-M> command-line options
+cannot contain single colons in the module name, but only in the
+arguments after "=".  In other words, B<-MFoo::Bar=:baz> is ok, but
+B<-MFoo:Bar=baz> is not.
+
 =item Invalid mro name: '%s'
 
 (F) You tried to C<mro::set_mro("classname", "foo")> or C<use mro 'foo'>,
@@ -2356,6 +2401,12 @@ where C<foo> is not a valid method resolution order 
(MRO).  Currently,
 the only valid ones supported are C<dfs> and C<c3>, unless you have loaded
 a module that is a MRO plugin.  See L<mro> and L<perlmroapi>.
 
+=item invalid option -D%c, use -D'' to see choices
+
+(F) Perl was called with invalid debugger flags.  Call perl with
+the B<-D> option with no flags to see the list of acceptable values.
+See also L<< perlrun/B<-D>I<letters> >>.
+
 =item Invalid [] range "%s" in regex; marked by <-- HERE in m/%s/
 
 (F) The range specified in a character class had a minimum character
@@ -2534,6 +2585,12 @@ detectable way.
 to check the return value of your socket() call?  See
 L<perlfunc/listen>.
 
+=item List form of piped open not implemented
+
+(F) On some platforms, notably Windows, the three-or-more-arguments
+form of C<open> does not support pipes, such as C<open($pipe, '|-', @args)>.
+Use the two-argument C<open($pipe, '|prog arg1 arg2...')> form instead.
+
 =item localtime(%f) too large
 
 (W overflow) You called C<localtime> with a number that was larger
@@ -2613,7 +2670,7 @@ when the function is called.
 
 =item Malformed UTF-8 character (%s)
 
-(S utf8) (F) Perl detected a string that didn't comply with UTF-8
+(S utf8)(F) Perl detected a string that didn't comply with UTF-8
 encoding rules, even though it had the UTF8 flag on.
 
 One possible cause is that you set the UTF8 flag yourself for data that
@@ -2672,7 +2729,7 @@ safely.  (See L<perlipc/"Deferred Signals (Safe 
Signals)">.)
 interpreter, especially if the word that is being warned about is
 "use" or "my".
 
-=item % may not be used in pack
+=item '%' may not be used in pack
 
 (F) You can't pack a string by supplying a checksum, because the
 checksumming process loses information, and you can't go the other way.
@@ -2959,6 +3016,16 @@ setgid script to even be allowed to attempt.  Generally 
speaking there
 will be another way to do what you want that is, if not secure, at least
 securable.  See L<perlsec>.
 
+=item No code specified for -%c
+
+(F) Perl's B<-e> and B<-E> command-line options require an argument.  If
+you want to run an empty program, pass the empty string as a separate
+argument or run a program consisting of a single 0 or 1:
+
+    perl -e ""
+    perl -e0
+    perl -e1
+
 =item No comma allowed after %s
 
 (F) A list operator that has a filehandle or "indirect object" is
@@ -3002,6 +3069,11 @@ for some reason the current debugger (e.g. F<perl5db.pl> 
or a C<Devel::>
 module) didn't define a C<DB::sub> routine to be called at the beginning
 of each ordinary subroutine call.
 
+=item No directory specified for -I
+
+(F) The B<-I> command-line switch requires a directory name as part of the
+I<same> argument.  Use B<-Ilib>, for instance.  B<-I lib> won't work.
+
 =item No error file after 2> or 2>> on command line
 
 (F) An error peculiar to VMS.  Perl handles its own command line
@@ -3064,11 +3136,6 @@ your system.
 (F) Configure didn't find anything resembling the setreuid() call for
 your system.
 
-=item No %s specified for -%c
-
-(F) The indicated command line switch needs a mandatory argument, but
-you haven't specified one.
-
 =item No such class field "%s" in variable %s of type %s
 
 (F) You tried to access a key from a hash through the indicated typed
@@ -3700,6 +3767,15 @@ so it was not possible to set up some or all fixed-width 
byte-order
 conversion functions.  This is only a problem when you're using the
 '<' or '>' modifiers in (un)pack templates.  See L<perlfunc/pack>.
 
+=item Perl %s required (did you mean %s?)--this is only %s, stopped
+
+(F) The code you are trying to run has asked for a newer version of
+Perl than you are running.  Perhaps C<use 5.10> was written instead
+of C<use 5.010> or C<use v5.10>.  Without the leading C<v>, the number is
+interpreted as a decimal, with every three digits after the
+decimal point representing a part of the version number.  So 5.10
+is equivalent to v5.100.
+
 =item Perl %s required--this is only version %s, stopped
 
 (F) The module in question uses features of a version of Perl more
@@ -3715,6 +3791,13 @@ C<sh>-shell in.  See "PERL_SH_DIR" in L<perlos2>.
 
 See L<perlrun/PERL_SIGNALS> for legal values.
 
+=item Perls since %s too modern--this is %s, stopped
+
+(F) The code you are trying to run claims it will not run
+on the version of Perl you are using because it is too new.
+Maybe the code needs to be updated, or maybe it is simply
+wrong and the version check should just be removed.
+
 =item perl: warning: Setting locale failed.
 
 (S) The whole warning message will look something like:
@@ -4011,6 +4094,13 @@ already been freed.
 the desired output is compiled into Perl, which entails some overhead,
 which is why it's currently left out of your copy.
 
+=item Recursive call to Perl_load_module in PerlIO_find_layer
+
+(P) It is currently not permitted to load modules when creating
+a filehandle inside an %INC hook.  This can happen with C<open my
+$fh, '<', \$scalar>, which implicitly loads PerlIO::scalar.  Try
+loading PerlIO::scalar explicitly first.
+
 =item Recursive inheritance detected in package '%s'
 
 (F) While calculating the method resolution order (MRO) of a package, Perl
@@ -4767,6 +4857,12 @@ many values were temporarily localized.
 (W internal) The exit code detected an internal inconsistency in how
 many blocks were entered and left.
 
+=item Unbalanced string table refcount: (%d) for "%s"
+
+(W internal) On exit, Perl found some strings remaining in the shared
+string table used for copy on write and for hash keys.  The entries
+should have been freed, so this indicates a bug somewhere.
+
 =item Unbalanced tmps: %d more allocs than frees
 
 (W internal) The exit code detected an internal inconsistency in how
@@ -4818,6 +4914,11 @@ Check the #! line, or manually feed your script into 
Perl yourself.
 (F) The unexec() routine failed for some reason.  See your local FSF
 representative, who probably put it there in the first place.
 
+=item Unexpected constant lvalue entersub entry via type/targ %d:%d
+
+(P) When compiling a subroutine call in lvalue context, Perl failed an
+internal consistency check.  It encountered a malformed op tree.
+
 =item Unicode non-character U+%X is illegal for open interchange
 
 (W utf8, nonchar) Certain codepoints, such as U+FFFE and U+FFFF, are
@@ -5514,6 +5615,11 @@ anonymous, using the C<sub {}> syntax.  When inner 
anonymous subs that
 reference variables in outer subroutines are created, they
 are automatically rebound to the current values of such variables.
 
+=item vector argument not supported with alpha versions
+
+(W internal) The %vd (s)printf format does not support version objects
+with alpha parts.
+
 =item Verb pattern '%s' has a mandatory argument in regex; marked by <-- HERE 
in m/%s/ 
 
 (F) You used a verb pattern that requires an argument.  Supply an
diff --git a/pp.c b/pp.c
index 44fe916..eaf6a85 100644
--- a/pp.c
+++ b/pp.c
@@ -75,6 +75,7 @@ PP(pp_padav)
        const I32 flags = is_lvalue_sub();
        if (flags && !(flags & OPpENTERSUB_INARGS)) {
        if (GIMME == G_SCALAR)
+           /* diag_listed_as: Can't return %s to lvalue scalar context */
            Perl_croak(aTHX_ "Can't return array to lvalue scalar context");
        PUSHs(TARG);
        RETURN;
@@ -121,6 +122,7 @@ PP(pp_padhv)
       const I32 flags = is_lvalue_sub();
       if (flags && !(flags & OPpENTERSUB_INARGS)) {
        if (GIMME == G_SCALAR)
+           /* diag_listed_as: Can't return %s to lvalue scalar context */
            Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
        RETURN;
       }
@@ -2713,6 +2715,7 @@ PP(pp_sin)
       if (neg_report) {
          if (op_type == OP_LOG ? (value <= 0.0) : (value < 0.0)) {
              SET_NUMERIC_STANDARD();
+             /* diag_listed_as: Can't take log of %g */
              DIE(aTHX_ "Can't take %s of %"NVgf, neg_report, value);
          }
       }
diff --git a/pp_ctl.c b/pp_ctl.c
index a9012ee..b74855b 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1394,6 +1394,7 @@ S_dopoptolabel(pTHX_ const char *label)
        case CXt_FORMAT:
        case CXt_EVAL:
        case CXt_NULL:
+           /* diag_listed_as: Exiting subroutine via %s */
            Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
                           context_name[CxTYPE(cx)], OP_NAME(PL_op));
            if (CxTYPE(cx) == CXt_NULL)
@@ -1531,6 +1532,7 @@ S_dopoptoloop(pTHX_ I32 startingblock)
        case CXt_FORMAT:
        case CXt_EVAL:
        case CXt_NULL:
+           /* diag_listed_as: Exiting subroutine via %s */
            Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
                           context_name[CxTYPE(cx)], OP_NAME(PL_op));
            if ((CxTYPE(cx)) == CXt_NULL)
@@ -2395,6 +2397,7 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, 
I32 gimme,
                    POPSUB(cx,sv);
                    PL_curpm = newpm;
                    LEAVESUB(sv);
+              /* diag_listed_as: Can't return %s from lvalue subroutine */
                    Perl_croak(aTHX_
                        "Can't return a %s from lvalue subroutine",
                        SvREADONLY(TOPs) ? "readonly value" : "temporary");
@@ -2837,8 +2840,10 @@ PP(pp_goto)
            /* ban goto in eval: see <[email protected]> */
            if (CxTYPE(cx) == CXt_EVAL) {
                if (CxREALEVAL(cx))
+               /* diag_listed_as: Can't goto subroutine from an eval-%s */
                    DIE(aTHX_ "Can't goto subroutine from an eval-string");
                else
+               /* diag_listed_as: Can't goto subroutine from an eval-%s */
                    DIE(aTHX_ "Can't goto subroutine from an eval-block");
            }
            else if (CxMULTICALL(cx))
diff --git a/pp_hot.c b/pp_hot.c
index aea1f02..cbdcb90 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -774,6 +774,7 @@ PP(pp_rv2av)
        }
        sv = SvRV(sv);
        if (SvTYPE(sv) != type)
+           /* diag_listed_as: Not an ARRAY reference */
            DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash);
        if (PL_op->op_flags & OPf_REF) {
            SETs(sv);
diff --git a/pp_sys.c b/pp_sys.c
index 9c6bc99..92624bf 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -248,6 +248,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresuid(euid, ruid, (Uid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: entering effective %s failed */
        Perl_croak(aTHX_ "entering effective uid failed");
 #endif
 
@@ -261,6 +262,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresgid(egid, rgid, (Gid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: entering effective %s failed */
        Perl_croak(aTHX_ "entering effective gid failed");
 #endif
 
@@ -273,6 +275,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresuid(ruid, euid, (Uid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: leaving effective %s failed */
        Perl_croak(aTHX_ "leaving effective uid failed");
 
 #ifdef HAS_SETREGID
@@ -282,6 +285,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresgid(rgid, egid, (Gid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: leaving effective %s failed */
        Perl_croak(aTHX_ "leaving effective gid failed");
 
     return res;
@@ -4461,17 +4465,20 @@ PP(pp_gmtime)
        NV input = Perl_floor(POPn);
        when = (Time64_T)input;
        if (when != input) {
+           /* diag_listed_as: gmtime(%f) too large */
            Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                           "%s(%.0" NVff ") too large", opname, input);
        }
     }
 
     if ( TIME_LOWER_BOUND > when ) {
+       /* diag_listed_as: gmtime(%f) too small */
        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                       "%s(%.0" NVff ") too small", opname, when);
        err = NULL;
     }
     else if( when > TIME_UPPER_BOUND ) {
+       /* diag_listed_as: gmtime(%f) too small */
        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                       "%s(%.0" NVff ") too large", opname, when);
        err = NULL;
diff --git a/regexec.c b/regexec.c
index ced20bd..44d7b96 100644
--- a/regexec.c
+++ b/regexec.c
@@ -4843,8 +4843,9 @@ NULL
                && !(PL_reg_flags & RF_warned))
            {
                PL_reg_flags |= RF_warned;
-               Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) 
exceeded",
-                    "Complex regular subexpression recursion",
+               Perl_warner(aTHX_ packWARN(WARN_REGEXP),
+                    "Complex regular subexpression recursion limit (%d) "
+                    "exceeded",
                     REG_INFTY - 1);
            }
 
@@ -4867,8 +4868,8 @@ NULL
                {
                    PL_reg_flags |= RF_warned;
                    Perl_warner(aTHX_ packWARN(WARN_REGEXP),
-                       "%s limit (%d) exceeded",
-                       "Complex regular subexpression recursion",
+                       "Complex regular subexpression recursion "
+                       "limit (%d) exceeded",
                        REG_INFTY - 1);
                }
                cur_curlyx->u.curlyx.count--;
diff --git a/sv.c b/sv.c
index e972476..2d8039b 100644
--- a/sv.c
+++ b/sv.c
@@ -5744,7 +5744,7 @@ Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN 
offset, const STRLEN l
     PERL_ARGS_ASSERT_SV_INSERT_FLAGS;
 
     if (!bigstr)
-       Perl_croak(aTHX_ "Can't modify non-existent substring");
+       Perl_croak(aTHX_ "Can't modify nonexistent substring");
     SvPV_force_flags(bigstr, curlen, flags);
     (void)SvPOK_only_UTF8(bigstr);
     if (offset + len > curlen) {
@@ -7955,6 +7955,7 @@ Perl_sv_inc_nomg(pTHX_ register SV *const sv)
        const NV was = SvNVX(sv);
        if (NV_OVERFLOWS_INTEGERS_AT &&
            was >= NV_OVERFLOWS_INTEGERS_AT) {
+           /* diag_listed_as: Lost precision when %s %f by 1 */
            Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
                           "Lost precision when incrementing %" NVff " by 1",
                           was);
@@ -8139,6 +8140,7 @@ Perl_sv_dec_nomg(pTHX_ register SV *const sv)
            const NV was = SvNVX(sv);
            if (NV_OVERFLOWS_INTEGERS_AT &&
                was <= -NV_OVERFLOWS_INTEGERS_AT) {
+               /* diag_listed_as: Lost precision when %s %f by 1 */
                Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
                               "Lost precision when decrementing %" NVff " by 
1",
                               was);
diff --git a/t/op/caller.t b/t/op/caller.t
index a694aa6..af73242 100644
--- a/t/op/caller.t
+++ b/t/op/caller.t
@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan( tests => 84 );
+    plan( tests => 85 );
 }
 
 my @c;
@@ -243,8 +243,10 @@ sub FETCH    { $_[0][$_[1]] }
 sub STORE    { $_[0][$_[1]] = $_[2] }
 package DB;
 tie @args, 'glelp';
-sub { () = caller 0; } ->(1..3);
-::is "@args", "1 2 3", 'tied @DB::args';
+eval { sub { () = caller 0; } ->(1..3) };
+::like $@, qr "^Cannot set tied \@DB::args at ",
+              'caller dies with tie @DB::args';
+::ok tied @args, '@DB::args is still tied';
 untie @args;
 package main;
 
diff --git a/t/porting/diag.t b/t/porting/diag.t
index f56cfc6..ff0e3b2 100644
--- a/t/porting/diag.t
+++ b/t/porting/diag.t
@@ -50,8 +50,8 @@ while (<$func_fh>) {
 close $func_fh;
 
 my $function_re = join '|', @functions;
-my $source_msg_re = qr/(?<routine>\bDIE\b|$function_re)/;
-my $text_re = qr/"(?<text>(?:\\"|[^"])*?)"/;
+my $source_msg_re = '(?<routine>\bDIE\b|$function_re)';
+my $text_re = '"(?<text>(?:\\\\"|[^"]|"\s*[A-Z_]+\s*")*)"';
 my $source_msg_call_re = qr/$source_msg_re(?:_nocontext)? \s*
     \(aTHX_ \s*
     (?:packWARN\d*\((?<category>.*?)\),)? \s*
@@ -219,7 +219,7 @@ sub check_file {
 
     my $multiline = 0;
     # Loop to accumulate the message text all on one line.
-    if (m/$source_msg_re/) {
+    if (m/$source_msg_re(?:_nocontext)?\s*\(/) {
       while (not m/\);$/) {
         my $nextline = <$codefh>;
         # Means we fell off the end of the file.  Not terribly surprising;
@@ -274,11 +274,11 @@ sub check_file {
     } else {
       # The form listed in perldiag ignores most sorts of fancy printf
       # formatting, or makes it more perlish.
-      $name =~ s/%%/\\%/g;
+      $name =~ s/%%/%/g;
       $name =~ s/%l[ud]/%d/g;
       $name =~ s/%\.(\d+|\*)s/\%s/g;
       $name =~ s/(?:%s){2,}/%s/g;
-      $name =~ s/\\"/"/g;
+      $name =~ s/(\\")|("\s*[A-Z_]+\s*")/$1 ? '"' : '%s'/egg;
       $name =~ s/\\t/\t/g;
       $name =~ s/\\n/\n/g;
       $name =~ s/\s+$//;
@@ -376,65 +376,36 @@ Can't coerce readonly %s to string
 Can't coerce readonly %s to string in %s
 Can't fix broken locale name "%s"
 Can't get short module name from a handle
-Can't goto subroutine from an eval-block
-Can't goto subroutine from an eval-string
 Can't locate object method "%s" via package "%s" (perhaps you forgot to load 
"%s"?)
-Can't modify non-existent substring
-Can't open
-Can't open perl script "%s": %s
-Can't open %s
-Can't reset \%ENV on this system
-Can't return array to lvalue scalar context
-Can't return a %s from lvalue subroutine
-Can't return hash to lvalue scalar context
 Can't spawn "%s": %s
 Can't %s script `%s' with ARGV[0] being `%s'
 Can't %s "%s": %s
-Can't %s %s
 Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)
-Can't take %s of %f
-Can't use '%c' after -mname
 Can't use string ("%s"%s) as a subroutine ref while "strict refs" in use
-Can't use when() outside a topicalizer
 \%c better written as $%c
 Character(s) in '%c' format wrapped in %s
-$%c is no longer supported
-Cloning substitution context is unimplemented
 Code missing after '/' in pack
 Code missing after '/' in unpack
 Corrupted regexp opcode %d > %d
 '%c' outside of string in pack
 Debug leaking scalars child failed%s with errno %d: %s
-Deep recursion on anonymous subroutine
-defined(\%hash) is deprecated
 Don't know how to handle magic of type \%o
 -Dp not implemented on this platform
-entering effective gid failed
-entering effective uid failed
 Error reading "%s": %s
-Exiting %s via %s
 Filehandle opened only for %sput
 Filehandle %s opened only for %sput
 Filehandle STD%s reopened as %s only for input
 YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET! FIX YOUR KERNEL, PUT A 
C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!
-Format STDOUT redefined
 Free to wrong pool %p not %p
 get %s %p %p %p
 glob failed (can't start child: %s)
 glob failed (child exited with status %d%s)
 Goto undefined subroutine
 Goto undefined subroutine &%s
-Hash \%%s missing the \% in argument %d of %s()
 Illegal character %sin prototype for %s : %s
-Integer overflow in binary number
-Integer overflow in decimal number
-Integer overflow in hexadecimal number
-Integer overflow in octal number
 Integer overflow in version %d
-internal \%<num>p might conflict with future printf extensions
+internal %<num>p might conflict with future printf extensions
 invalid control request: '\%o'
-Invalid module name %s with -%c option: contains single ':'
-invalid option -D%c, use -D'' to see choices
 Invalid range "%c-%c" in transliteration operator
 Invalid separator character %c%c%c in PerlIO layer specification %s
 Invalid TOKEN object ignored
@@ -444,53 +415,31 @@ Invalid type '%c' in unpack
 Invalid type ',' in %s
 'j' not supported on this platform
 'J' not supported on this platform
-leaving effective gid failed
-leaving effective uid failed
-List form of piped open not implemented
-Lost precision when decrementing %f by 1
-Lost precision when incrementing %f by 1
-%lx
 Malformed UTF-8 character (fatal)
-'\%' may not be used in pack
 Missing (suid) fd script name
 More than one argument to open
 More than one argument to open(,':%s')
 mprotect for %p %u failed with %d
 mprotect RW for %p %u failed with %d
-No code specified for -%c
-No directory specified for -I
-No such class field "%s"
 Not an XSUB reference
-Not %s reference
 Operator or semicolon missing before %c%s
-Perl %s required (did you mean %s?)--this is only %s, stopped
 Perl %s required--this is only %s, stopped
-Perls since %s too modern--this is %s, stopped
 ptr wrong %p != %p fl=%x nl=%p e=%p for %d
 Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)
-Recursive call to Perl_load_module in PerlIO_find_layer
 Reversed %c= operator
 Runaway prototype
-%s(%.0
 %s(%f) failed
-%s(%f) too large
-%s(%f) too small
-Scalar value %s better written as $%s
 %sCompilation failed in regexp
 %sCompilation failed in require
 set %s %p %p %p
 %s free() ignored (RMAGIC, PERL_CORE)
 %s has too many errors.
 SIG%s handler "%s" not defined.
-%s: illegal mapping '%s'
 %s in %s
 Size magic not implemented
-%s limit (%d) exceeded
-%s method "%s" overloading "%s" in package "%s"
 %s number > %s non-portable
 %s object version %s does not match %s %s
 %srealloc() %signored
-%s returned from lvalue subroutine in scalar context
 %s has too many errors.
 %s on %s %s
 %s on %s %s %s
@@ -503,20 +452,10 @@ The rewinddir() function is not implemented on NetWare
 The seekdir() function is not implemented on NetWare
 The telldir() function is not implemented on NetWare
 Too deeply nested ()-groups in %s
-Too late to run CHECK block
-Too late to run INIT block
 Too many args on %s line of "%s"
 U0 mode on a byte string
-Unbalanced string table refcount: (%d) for "%s"
 Undefined top format called
-Unexpected constant lvalue entersub entry via type/targ %d:%d
-Unicode non-character 0x%X
-Unknown PerlIO layer "scalar"
 Unstable directory path, current directory changed unexpectedly
-Unsupported script encoding UTF-16BE
-Unsupported script encoding UTF-16LE
-Unsupported script encoding UTF-32BE
-Unsupported script encoding UTF-32LE
 Unterminated compressed integer in unpack
 Usage: CODE(0x%x)(%s)
 Usage: %s(%s)
@@ -528,7 +467,6 @@ utf8 "\x%X" does not map to Unicode
 Value of logical "%s" too long. Truncating to %i bytes
 value of node is %d in Offset macro
 Variable "%c%s" is not imported
-vector argument not supported with alpha versions
 Wide character
 Wide character in $/
 Wide character in print
diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat
index c0243f2..9b5118d 100644
--- a/t/porting/known_pod_issues.dat
+++ b/t/porting/known_pod_issues.dat
@@ -216,6 +216,7 @@ pod/perldebguts.pod Verbatim line length including indents 
exceeds 79 by    68
 pod/perldebtut.pod     Verbatim line length including indents exceeds 79 by    
22
 pod/perldebug.pod      Verbatim line length including indents exceeds 79 by    
3
 pod/perldiag.pod       =item type mismatch     1
+pod/perldiag.pod       Apparent broken link    1
 pod/perldsc.pod        Verbatim line length including indents exceeds 79 by    
4
 pod/perldtrace.pod     Verbatim line length including indents exceeds 79 by    
22
 pod/perlebcdic.pod     Verbatim line length including indents exceeds 79 by    
273
diff --git a/toke.c b/toke.c
index db743e9..8fb6164 100644
--- a/toke.c
+++ b/toke.c
@@ -6239,6 +6239,7 @@ Perl_yylex(pTHX)
                    if (*t == '}' || *t == ']') {
                        t++;
                        PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */
+       /* diag_listed_as: Scalar value @%s[%s] better written as $%s[%s] */
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                            "Scalar value %.*s better written as $%.*s",
                            (int)(t-PL_bufptr), PL_bufptr,
@@ -10823,6 +10824,7 @@ S_swallow_bom(pTHX_ U8 *s)
        if (s[1] == 0xFE) {
            /* UTF-16 little-endian? (or UTF-32LE?) */
            if (s[2] == 0 && s[3] == 0)  /* UTF-32 little-endian */
+               /* diag_listed_as: Unsupported script encoding %s */
                Perl_croak(aTHX_ "Unsupported script encoding UTF-32LE");
 #ifndef PERL_NO_UTF16_FILTER
            if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, 
"UTF-16LE script encoding (BOM)\n");
@@ -10831,6 +10833,7 @@ S_swallow_bom(pTHX_ U8 *s)
                s = add_utf16_textfilter(s, TRUE);
            }
 #else
+           /* diag_listed_as: Unsupported script encoding %s */
            Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE");
 #endif
        }
@@ -10844,6 +10847,7 @@ S_swallow_bom(pTHX_ U8 *s)
                s = add_utf16_textfilter(s, FALSE);
            }
 #else
+           /* diag_listed_as: Unsupported script encoding %s */
            Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE");
 #endif
        }
@@ -10859,6 +10863,7 @@ S_swallow_bom(pTHX_ U8 *s)
             if (s[1] == 0) {
                  if (s[2] == 0xFE && s[3] == 0xFF) {
                       /* UTF-32 big-endian */
+                      /* diag_listed_as: Unsupported script encoding %s */
                       Perl_croak(aTHX_ "Unsupported script encoding UTF-32BE");
                  }
             }
@@ -10870,6 +10875,7 @@ S_swallow_bom(pTHX_ U8 *s)
                  if (DEBUG_p_TEST || DEBUG_T_TEST) 
PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (no BOM)\n");
                  s = add_utf16_textfilter(s, FALSE);
 #else
+                 /* diag_listed_as: Unsupported script encoding %s */
                  Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE");
 #endif
             }
@@ -10892,6 +10898,7 @@ S_swallow_bom(pTHX_ U8 *s)
              if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, 
"UTF-16LE script encoding (no BOM)\n");
              s = add_utf16_textfilter(s, TRUE);
 #else
+             /* diag_listed_as: Unsupported script encoding %s */
              Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE");
 #endif
         }
@@ -11108,6 +11115,7 @@ Perl_scan_vstring(pTHX_ const char *s, const char 
*const e, SV *sv)
                    rev += (*end - '0') * mult;
                    mult *= 10;
                    if (orev > rev)
+                       /* diag_listed_as: Integer overflow in %s number */
                        Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
                                         "Integer overflow in decimal number");
                }
diff --git a/utf8.c b/utf8.c
index e985386..23308a3 100644
--- a/utf8.c
+++ b/utf8.c
@@ -2776,6 +2776,7 @@ S_swash_scan_list_line(pTHX_ U8* l, U8* const lend, UV* 
min, UV* max, UV* val,
            else {
                *val = 0;
                if (typeto) {
+                   /* diag_listed_as: To%s: illegal mapping '%s' */
                    Perl_croak(aTHX_ "%s: illegal mapping '%s'",
                                     typestr, l);
                }
@@ -2790,6 +2791,7 @@ S_swash_scan_list_line(pTHX_ U8* l, U8* const lend, UV* 
min, UV* max, UV* val,
        if (wants_value) {
            *val = 0;
            if (typeto) {
+               /* diag_listed_as: To%s: illegal mapping '%s' */
                Perl_croak(aTHX_ "%s: illegal mapping '%s'", typestr, l);
            }
        }
diff --git a/util.c b/util.c
index 3915286..9d7683d 100644
--- a/util.c
+++ b/util.c
@@ -3681,6 +3681,7 @@ Perl_find_script(pTHX_ const char *scriptname, bool 
dosearch,
            seen_dot = 1;                       /* Disable message. */
        if (!xfound) {
            if (flags & 1) {                    /* do or die? */
+               /* diag_listed_as: Can't execute %s */
                Perl_croak(aTHX_ "Can't %s %s%s%s",
                      (xfailed ? "execute" : "find"),
                      (xfailed ? xfailed : scriptname),

--
Perl5 Master Repository

Reply via email to