Turn on CVf_LEXICAL for lexical subs

This flag will signify that lexical subs should not have package names
associated with them in error messages, etc.

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);
+       CvLEXICAL_off(cv);
     }
 
     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
                )
            );
+           CvLEXICAL_on(*spot);
        }
        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:
+    CvLEXICAL_on(cv);
     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
-     * 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 */
-    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);
+                       CvLEXICAL_on(sv);
                    }
                    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)
                        );
+                       CvLEXICAL_on(sv);
                    }
                    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);
+                        CvLEXICAL_on(sv);
                         break;
                     }
                     default:
@@ -1076,6 +1077,7 @@ Perl_leave_scope(pTHX_ I32 base)
                                          )[svp-PL_curpad],
                                          PERL_MAGIC_proto
                                         )->mg_obj))));
+                        CvLEXICAL_on(*svp);
                         break;
                     }
                     default:   *svp = newSV(0);                break;