This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Turn on CVf_LEXICAL for lexical subs
authorFather Chrysostomos <sprout@cpan.org>
Fri, 29 Aug 2014 00:37:55 +0000 (17:37 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 15 Sep 2014 13:19:31 +0000 (06:19 -0700)
This flag will signify that lexical subs should not have package names
associated with them in error messages, etc.

gv.c
op.c
pad.c
scope.c

diff --git a/gv.c b/gv.c
index 5cbcf62..134ed6e 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -235,6 +235,7 @@ Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
     else if ((hek = CvNAME_HEK(cv))) {
        unshare_hek(hek);
        CvNAMED_off(cv);
     else if ((hek = CvNAME_HEK(cv))) {
        unshare_hek(hek);
        CvNAMED_off(cv);
+       CvLEXICAL_off(cv);
     }
 
     SvANY(cv)->xcv_gv_u.xcv_gv = gv;
     }
 
     SvANY(cv)->xcv_gv_u.xcv_gv = gv;
diff --git a/op.c b/op.c
index aba7a9b..9c0399b 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7377,6 +7377,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                    PadnameLEN(name)-1 * (PadnameUTF8(name) ? -1 : 1), hash
                )
            );
                    PadnameLEN(name)-1 * (PadnameUTF8(name) ? -1 : 1), hash
                )
            );
+           CvLEXICAL_on(*spot);
        }
        if (mg) {
            assert(mg->mg_obj);
        }
        if (mg) {
            assert(mg->mg_obj);
@@ -7503,6 +7504,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        *spot = cv;
     }
    setname:
        *spot = cv;
     }
    setname:
+    CvLEXICAL_on(cv);
     if (!CvNAME_HEK(cv)) {
        if (hek) (void)share_hek_hek(hek);
        else {
     if (!CvNAME_HEK(cv)) {
        if (hek) (void)share_hek_hek(hek);
        else {
diff --git a/pad.c b/pad.c
index b3f6d2c..38b0ce5 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -469,9 +469,10 @@ Perl_cv_undef(pTHX_ CV *cv)
        CvXSUB(cv) = NULL;
     }
     /* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the
        CvXSUB(cv) = NULL;
     }
     /* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the
-     * ref status of CvOUTSIDE and CvGV, and ANON, which pp_entersub uses
+     * ref status of CvOUTSIDE and CvGV, and ANON and
+     * LEXICAL, which pp_entersub uses
      * to choose an error message */
      * to choose an error message */
-    CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON);
+    CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON|CVf_LEXICAL);
 }
 
 /*
 }
 
 /*
@@ -2086,6 +2087,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
                        assert(SvTYPE(ppad[ix]) == SVt_PVCV);
                        subclones = 1;
                        sv = newSV_type(SVt_PVCV);
                        assert(SvTYPE(ppad[ix]) == SVt_PVCV);
                        subclones = 1;
                        sv = newSV_type(SVt_PVCV);
+                       CvLEXICAL_on(sv);
                    }
                    else if (PadnameLEN(namesv)>1 && !PadnameIsOUR(namesv))
                    {
                    }
                    else if (PadnameLEN(namesv)>1 && !PadnameIsOUR(namesv))
                    {
@@ -2104,6 +2106,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
                                         * (SvUTF8(namesv) ? -1 : 1),
                                      hash)
                        );
                                         * (SvUTF8(namesv) ? -1 : 1),
                                      hash)
                        );
+                       CvLEXICAL_on(sv);
                    }
                    else sv = SvREFCNT_inc(ppad[ix]);
                 else if (sigil == '@')
                    }
                    else sv = SvREFCNT_inc(ppad[ix]);
                 else if (sigil == '@')
diff --git a/scope.c b/scope.c
index 50036d0..9c8b040 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -1042,6 +1042,7 @@ Perl_leave_scope(pTHX_ I32 base)
                         share_hek_hek(hek);
                         cv_undef((CV *)sv);
                         CvNAME_HEK_set(sv, hek);
                         share_hek_hek(hek);
                         cv_undef((CV *)sv);
                         CvNAME_HEK_set(sv, hek);
+                        CvLEXICAL_on(sv);
                         break;
                     }
                     default:
                         break;
                     }
                     default:
@@ -1076,6 +1077,7 @@ Perl_leave_scope(pTHX_ I32 base)
                                          )[svp-PL_curpad],
                                          PERL_MAGIC_proto
                                         )->mg_obj))));
                                          )[svp-PL_curpad],
                                          PERL_MAGIC_proto
                                         )->mg_obj))));
+                        CvLEXICAL_on(*svp);
                         break;
                     }
                     default:   *svp = newSV(0);                break;
                         break;
                     }
                     default:   *svp = newSV(0);                break;