In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/27b4ba23e0a765dcb0c320a5bd4590c45aad6820?hp=a4031a721e0a1941c14467c7671da2ee1b91c969>

- Log -----------------------------------------------------------------
commit 27b4ba23e0a765dcb0c320a5bd4590c45aad6820
Author: Zefram <zef...@fysh.org>
Date:   Sat Jan 28 06:25:28 2017 +0000

    in dump_sub() handle CV ref used as GV
    
    dump_sub() can receive a CV ref where it's expecting a GV.  Make it
    handle that cleanly.  Fixes [perl #129126].
-----------------------------------------------------------------------

Summary of changes:
 dump.c | 36 +++++++++++++++++++++---------------
 1 file changed, 21 insertions(+), 15 deletions(-)

diff --git a/dump.c b/dump.c
index 9edc8bf7db..9eb26bcc94 100644
--- a/dump.c
+++ b/dump.c
@@ -684,27 +684,33 @@ Perl_dump_sub(pTHX_ const GV *gv)
 void
 Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
 {
-    STRLEN len;
-    SV * const sv = newSVpvs_flags("", SVs_TEMP);
-    SV *tmpsv;
-    const char * name;
+    CV *cv;
 
     PERL_ARGS_ASSERT_DUMP_SUB_PERL;
 
-    if (justperl && (CvISXSUB(GvCV(gv)) || !CvROOT(GvCV(gv))))
+    cv = isGV_with_GP(gv) ? GvCV(gv) :
+           (assert(SvROK((SV*)gv)), (CV*)SvRV((SV*)gv));
+    if (justperl && (CvISXSUB(cv) || !CvROOT(cv)))
        return;
 
-    tmpsv = newSVpvs_flags("", SVs_TEMP);
-    gv_fullname3(sv, gv, NULL);
-    name = SvPV_const(sv, len);
-    Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ",
-                     generic_pv_escape(tmpsv, name, len, SvUTF8(sv)));
-    if (CvISXSUB(GvCV(gv)))
+    if (isGV_with_GP(gv)) {
+       SV * const namesv = newSVpvs_flags("", SVs_TEMP);
+       SV *escsv = newSVpvs_flags("", SVs_TEMP);
+       const char *namepv;
+       STRLEN namelen;
+       gv_fullname3(namesv, gv, NULL);
+       namepv = SvPV_const(namesv, namelen);
+       Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ",
+                    generic_pv_escape(escsv, namepv, namelen, SvUTF8(namesv)));
+    } else {
+       Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB = ");
+    }
+    if (CvISXSUB(cv))
        Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%" UVxf " %d)\n",
-           PTR2UV(CvXSUB(GvCV(gv))),
-           (int)CvXSUBANY(GvCV(gv)).any_i32);
-    else if (CvROOT(GvCV(gv)))
-       op_dump(CvROOT(GvCV(gv)));
+           PTR2UV(CvXSUB(cv)),
+           (int)CvXSUBANY(cv).any_i32);
+    else if (CvROOT(cv))
+       op_dump(CvROOT(cv));
     else
        Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
 }

--
Perl5 Master Repository

Reply via email to