lib/utf8.pm: Fix pod verbatim line wraps

[perl5.git] / gv.c

diff --git a/gv.c b/gv.c
index 7e954d8..2325194 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -450,7 +450,6 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
     static const char file[] = __FILE__;
     CV *cv, *oldcompcv = NULL;
     int opnum = 0;
-    SV *opnumsv;
     bool ampable = TRUE; /* &{}-able */
     COP *oldcurcop = NULL;
     yy_parser *oldparser = NULL;
@@ -536,8 +535,13 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
     if (stash)
        (void)hv_store(stash,name,len,(SV *)gv,0);
     if (ampable) {
+#ifdef DEBUGGING
+        CV *orig_cv = cv;
+#endif
        CvLVALUE_on(cv);
-       newATTRSUB_flags(
+        /* newATTRSUB will free the CV and return NULL if we're still
+           compiling after a syntax error */
+       if ((cv = newATTRSUB_flags(
                   oldsavestack_ix, (OP *)gv,
                   NULL,NULL,
                   coresub_op(
@@ -547,21 +551,25 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
                     code, opnum
                   ),
                   1
-       );
-       assert(GvCV(gv) == cv);
-       if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS
-        && opnum != OP_UNDEF)
-           CvLVALUE_off(cv); /* Now *that* was a neat trick. */
+               )) != NULL) {
+            assert(GvCV(gv) == orig_cv);
+            if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS
+                && opnum != OP_UNDEF)
+                CvLVALUE_off(cv); /* Now *that* was a neat trick. */
+        }
        LEAVE;
        PL_parser = oldparser;
        PL_curcop = oldcurcop;
        PL_compcv = oldcompcv;
     }
-    opnumsv = opnum ? newSVuv((UV)opnum) : (SV *)NULL;
-    cv_set_call_checker(
-       cv, Perl_ck_entersub_args_core, opnumsv ? opnumsv : (SV *)cv
-    );
-    SvREFCNT_dec(opnumsv);
+    if (cv) {
+        SV *opnumsv = opnum ? newSVuv((UV)opnum) : (SV *)NULL;
+        cv_set_call_checker(
+          cv, Perl_ck_entersub_args_core, opnumsv ? opnumsv : (SV *)cv
+        );
+        SvREFCNT_dec(opnumsv);
+    }
+
     return gv;
 }
 
@@ -1639,14 +1647,11 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                else if (*name == '-' || *name == '+')
                    require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
               } else if (sv_type == SVt_PV) {
-                  if (*name == '*') {
-                      Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED,
-                                                       WARN_SYNTAX),
-                                       "$* is no longer supported, and will become a syntax error");
-                  } else if (*name == '#') {
+                  if (*name == '*' || *name == '#') {
+                      /* diag_listed_as: $* is no longer supported */
                       Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED,
                                                        WARN_SYNTAX),
-                                       "$# is no longer supported");
+                                       "$%c is no longer supported", *name);
                   }
               }
              if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
@@ -1937,14 +1942,11 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
             break;
        }
        case '*':               /* $* */
-           if (sv_type == SVt_PV)
-               Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                                "$* is no longer supported, and will become a syntax error");
-           break;
        case '#':               /* $# */
            if (sv_type == SVt_PV)
+               /* diag_listed_as: $* is no longer supported */
                Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                                "$# is no longer supported");
+                                "$%c is no longer supported", *name);
            break;
        case '\010':    /* $^H */
            {