In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/019070c31184a4deb57cb85f7e597a789c6c5b54?hp=a11eaecb3511133877ccbbc89337da7a30e8f21b>
- Log ----------------------------------------------------------------- commit 019070c31184a4deb57cb85f7e597a789c6c5b54 Author: Father Chrysostomos <[email protected]> Date: Sun Jul 29 00:03:45 2012 -0700 Use $^S instead of caller in splain M lib/diagnostics.pm commit c369a25dcc5e5c5b627a50d1c4b73c2be0b926b9 Author: Father Chrysostomos <[email protected]> Date: Sat Jul 28 23:58:44 2012 -0700 Increase $diagnostics::VERSION to 1.31 M lib/diagnostics.pm commit b4cf37f552befe5c786175885bfda09c5323c887 Author: Father Chrysostomos <[email protected]> Date: Sat Jul 28 23:54:16 2012 -0700 perldelta: proto mismatch warnings M pod/perldelta.pod commit 105ff74ce063d3eef3434a4ce97c533fde909e43 Author: Father Chrysostomos <[email protected]> Date: Sat Jul 28 23:41:00 2012 -0700 Fix scrambled and incorrect proto mismatch error $ ./perl -Ilib -e 'use constant foo=>bar; sub foo(@);' Prototype mismatch:: none vs (@) at -e line 1. $ ./perl -Ilib -e 'sub foo(); sub foo(@);' Prototype mismatch: () vs (@) at -e line 1. Notice the double colon and the ânoneâ in the first example? We also have this bug, where the prototype is the same, but we get the warning anyway: $ ./perl -Ilib -e 'use constant foo=>bar; sub foo();' Prototype mismatch:: none vs () at -e line 1. When the $::{foo} = \1 constant optimisation was added in 5.10.0, pro- totype warnings were not taken into account. A forward declaration like sub foo() puts a string in the stash element. newATTRSUB was passing a non-SVt_NULL non-gv stash element to cv_ckproto_len_flags, which assumed that !SvPOK meant no prototype. Thatâs not the case with a reference. The double colon, which goes back to 5.8.4 (ebe643b99/59e7bac08e), occurs when the sub name is not available: $ perl5.8.4 -e 'sub foo; sub foo();' Prototype mismatch:: none vs () at -e line 1. (Before that the message was worse: $ perl5.8.3 -e 'sub foo; sub foo();' Prototype mismatch: vs () at -e line 1.) In 5.10.0, it started applying to constants as well, which used to show the sub name: $ perl5.8.9 -e 'use constant foo=>bar; sub foo(@);' Prototype mismatch: sub main::foo () vs (@) at -e line 1. $ perl5.10.0 -e 'use constant foo=>bar; sub foo(@);' Runaway prototype at -e line 1. Prototype mismatch:: none vs (@) at -e line 1. (âRunaway prototypeâ is already gone in blead [acfcf464b177, in which I stated wrongly that the warning could only come about with stash manipulation].) This commit changes cv_ckproto_len_flags to assume that a reference is a constant with an empty string for a prototype. It also makes newATTRSUB pass the sub name sv instead of a gv in those cases where the stash element isnât a gv. This doesnât restore things to exactly the way they were before (foo instead of main::foo), but Iâm not sure itâs worth the added complexity of constructing the fully-qualified name, just for a warning. M op.c M t/lib/warnings/op commit afc04f16a85625bbb9c291b91861c1c5e3c450b7 Author: Father Chrysostomos <[email protected]> Date: Sat Jul 28 22:52:57 2012 -0700 perldelta for 4499db7385 (vstr =~ s/a/a/) M pod/perldelta.pod ----------------------------------------------------------------------- Summary of changes: lib/diagnostics.pm | 11 ++--------- op.c | 12 +++++++++--- pod/perldelta.pod | 15 +++++++++++++++ t/lib/warnings/op | 5 +++++ 4 files changed, 31 insertions(+), 12 deletions(-) diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index 1efbd67..c734c85 100644 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -186,7 +186,7 @@ use 5.009001; use Carp; $Carp::Internal{__PACKAGE__.""}++; -our $VERSION = '1.30'; +our $VERSION = '1.31'; our $DEBUG; our $VERBOSE; our $PRETTY; @@ -546,14 +546,7 @@ sub death_trap { # See if we are coming from anywhere within an eval. If so we don't # want to explain the exception because it's going to get caught. - my $in_eval = 0; - my $i = 0; - while (my $caller = (caller($i++))[3]) { - if ($caller eq '(eval)') { - $in_eval = 1; - last; - } - } + my $in_eval = $^S || !defined $^S; splainthis($exception) unless $in_eval; if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; } diff --git a/op.c b/op.c index 41bea3b..8fc0312 100644 --- a/op.c +++ b/op.c @@ -6649,7 +6649,7 @@ void Perl_cv_ckproto_len_flags(pTHX_ const CV *cv, const GV *gv, const char *p, const STRLEN len, const U32 flags) { - const char * const cvp = CvPROTO(cv); + const char * const cvp = SvROK(cv) ? "" : CvPROTO(cv); const STRLEN clen = CvPROTOLEN(cv); PERL_ARGS_ASSERT_CV_CKPROTO_LEN_FLAGS; @@ -6671,11 +6671,15 @@ Perl_cv_ckproto_len_flags(pTHX_ const CV *cv, const GV *gv, const char *p, SV* name = NULL; if (gv) + { + if (isGV(gv)) gv_efullname3(name = sv_newmortal(), gv, NULL); + else name = (SV *)gv; + } sv_setpvs(msg, "Prototype mismatch:"); if (name) Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, SVfARG(name)); - if (SvPOK(cv)) + if (cvp) Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", SVfARG(newSVpvn_flags(cvp,clen, SvUTF8(cv)|SVs_TEMP)) ); @@ -6928,7 +6932,9 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, if (SvTYPE(gv) != SVt_PVGV) { /* Maybe prototype now, and had at maximum a prototype before. */ if (SvTYPE(gv) > SVt_NULL) { - cv_ckproto_len_flags((const CV *)gv, NULL, ps, ps_len, ps_utf8); + cv_ckproto_len_flags((const CV *)gv, + o ? (const GV *)cSVOPo->op_sv : NULL, ps, + ps_len, ps_utf8); } if (ps) { sv_setpvn(MUTABLE_SV(gv), ps, ps_len); diff --git a/pod/perldelta.pod b/pod/perldelta.pod index b0637d1..cbc6313 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -383,6 +383,21 @@ if the filehandle has been deleted. This was broken in Perl 5.16.0. Subroutine redefinitions after sub-to-glob and glob-to-glob assignments no longer cause double frees or panic messages. +=item * + +C<s///> now turns vstrings into plain strings when performing a +substitution, even if the resulting string is the same (C<s/a/a/>). + +=item * + +Prototype mismatch warnings no longer erroneously treat constant subs as +having no prototype when they actually have "". + +=item * + +Constant subroutines and forward declarations no longer prevent prototype +mismatch warnings from omitting the sub name. + =back =head1 Known Problems diff --git a/t/lib/warnings/op b/t/lib/warnings/op index c6a3bb8..4f33700 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -844,8 +844,13 @@ EXPECT # op.c sub fred(); sub fred($) {} +use constant foo=>bar; sub foo(@); +use constant bav=>bar; sub bav(); # no warning +sub btu; sub btu(); EXPECT Prototype mismatch: sub main::fred () vs ($) at - line 3. +Prototype mismatch: sub foo () vs (@) at - line 4. +Prototype mismatch: sub btu: none vs () at - line 6. ######## # op.c use utf8; -- Perl5 Master Repository
