Make \N{unknown char} a syntax error

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index 5c34a49..c767571 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -160,8 +160,10 @@ Perl_free_tmps(pTHX)
     /* XXX should tmps_floor live in cxstack? */
     const I32 myfloor = PL_tmps_floor;
     while (PL_tmps_ix > myfloor) {      /* clean up after last statement */
-       SV* const sv = PL_tmps_stack[PL_tmps_ix];
-       PL_tmps_stack[PL_tmps_ix--] = NULL;
+       SV* const sv = PL_tmps_stack[PL_tmps_ix--];
+#ifdef PERL_POISON
+       PoisonWith(PL_tmps_stack + PL_tmps_ix + 1, 1, SV *, 0xAB);
+#endif
        if (sv && sv != &PL_sv_undef) {
            SvTEMP_off(sv);
            SvREFCNT_dec(sv);           /* note, can modify tmps_ix!!! */
@@ -174,7 +176,7 @@ S_save_scalar_at(pTHX_ SV **sptr, const U32 flags)
 {
     dVAR;
     SV * osv;
-    register SV *sv;
+    SV *sv;
 
     PERL_ARGS_ASSERT_SAVE_SCALAR_AT;
 
@@ -349,7 +351,7 @@ void
 Perl_save_item(pTHX_ register SV *item)
 {
     dVAR;
-    register SV * const sv = newSVsv(item);
+    SV * const sv = newSVsv(item);
 
     PERL_ARGS_ASSERT_SAVE_ITEM;
 
@@ -682,8 +684,8 @@ I32
 Perl_save_alloc(pTHX_ I32 size, I32 pad)
 {
     dVAR;
-    register const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
-                               - (char*)PL_savestack);
+    const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
+                          - (char*)PL_savestack);
     const UV elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
     const UV elems_shifted = elems << SAVE_TIGHT_SHIFT;
 
@@ -702,13 +704,13 @@ void
 Perl_leave_scope(pTHX_ I32 base)
 {
     dVAR;
-    register SV *sv;
-    register SV *value;
-    register GV *gv;
-    register AV *av;
-    register HV *hv;
+    SV *sv;
+    SV *value;
+    GV *gv;
+    AV *av;
+    HV *hv;
     void* ptr;
-    register char* str;
+    char* str;
     I32 i;
     /* Localise the effects of the TAINT_NOT inside the loop.  */
     bool was = PL_tainted;
@@ -911,12 +913,16 @@ Perl_leave_scope(pTHX_ I32 base)
                    SvREADONLY_off(sv);
 
                if (SvTHINKFIRST(sv))
-                   sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF);
+                   sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF
+                                            |SV_COW_DROP_PV);
                if (SvTYPE(sv) == SVt_PVHV)
                    Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
                if (SvMAGICAL(sv))
-                   sv_unmagic(sv, PERL_MAGIC_backref),
+               {
+                 sv_unmagic(sv, PERL_MAGIC_backref);
+                 if (SvTYPE(sv) != SVt_PVCV)
                    mg_free(sv);
+               }
 
                switch (SvTYPE(sv)) {
                case SVt_NULL:
@@ -928,7 +934,14 @@ Perl_leave_scope(pTHX_ I32 base)
                    hv_clear(MUTABLE_HV(sv));
                    break;
                case SVt_PVCV:
-                   Perl_croak(aTHX_ "panic: leave_scope pad code");
+               {
+                   HEK * const hek = CvNAME_HEK((CV *)sv);
+                   assert(hek);
+                   share_hek_hek(hek);
+                   cv_undef((CV *)sv);
+                   CvNAME_HEK_set(sv, hek);
+                   break;
+               }
                default:
                    SvOK_off(sv);
                    break;
@@ -941,6 +954,19 @@ Perl_leave_scope(pTHX_ I32 base)
                switch (SvTYPE(sv)) {   /* Console ourselves with a new value */
                case SVt_PVAV:  *(SV**)ptr = MUTABLE_SV(newAV());       break;
                case SVt_PVHV:  *(SV**)ptr = MUTABLE_SV(newHV());       break;
+               case SVt_PVCV:
+               {
+                   SV ** const svp = (SV **)ptr;
+
+                   /* Create a stub */
+                   *svp = newSV_type(SVt_PVCV);
+
+                   /* Share name */
+                   assert(CvNAMED(sv));
+                   CvNAME_HEK_set(*svp,
+                       share_hek_hek(CvNAME_HEK((CV *)sv)));
+                   break;
+               }
                default:        *(SV**)ptr = newSV(0);          break;
                }
                SvREFCNT_dec(sv);       /* Cast current value to the winds. */
@@ -1136,9 +1162,6 @@ Perl_leave_scope(pTHX_ I32 base)
                     - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
                PL_savestack_ix -= SAVESTACK_ALLOC_FOR_RE_SAVE_STATE;
 
-               if (PL_reg_start_tmp != state->re_state_reg_start_tmp) {
-                   Safefree(PL_reg_start_tmp);
-               }
                if (PL_reg_poscache != state->re_state_reg_poscache) {
                    Safefree(PL_reg_poscache);
                }
@@ -1169,6 +1192,7 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
 #ifdef DEBUGGING
     PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]);
     if (CxTYPE(cx) != CXt_SUBST) {
+       const char *gimme_text;
        PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
        PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%"UVxf"\n",
                      PTR2UV(cx->blk_oldcop));
@@ -1176,7 +1200,21 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
        PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
        PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n",
                      PTR2UV(cx->blk_oldpm));
-       PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
+       switch (cx->blk_gimme) {
+           case G_VOID:
+               gimme_text = "VOID";
+               break;
+           case G_SCALAR:
+               gimme_text = "SCALAR";
+               break;
+           case G_ARRAY:
+               gimme_text = "LIST";
+               break;
+           default:
+               gimme_text = "UNKNOWN";
+               break;
+       }
+       PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", gimme_text);
     }
     switch (CxTYPE(cx)) {
     case CXt_NULL: