Tidy up EXE_EXT patches to MM_Unix.pm

[p5sagit/p5-mst-13.2.git] / scope.c

diff --git a/scope.c b/scope.c
index da5fa6b..59adddf 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -254,6 +254,18 @@ Perl_save_generic_pvref(pTHX_ char **str)
     SSPUSHINT(SAVEt_GENERIC_PVREF);
 }
 
+/* Like save_generic_pvref(), but uses PerlMemShared_free() rather than Safefree().
+ * Can be used to restore a shared global char* to its prior
+ * contents, freeing new value. */
+void
+Perl_save_shared_pvref(pTHX_ char **str)
+{
+    SSCHECK(3);
+    SSPUSHPTR(str);
+    SSPUSHPTR(*str);
+    SSPUSHINT(SAVEt_SHARED_PVREF);
+}
+
 void
 Perl_save_gp(pTHX_ GV *gv, I32 empty)
 {
@@ -657,6 +669,14 @@ Perl_leave_scope(pTHX_ I32 base)
                *(char**)ptr = str;
            }
            break;
+       case SAVEt_SHARED_PVREF:                /* shared pv */
+           str = (char*)SSPOPPTR;
+           ptr = SSPOPPTR;
+           if (*(char**)ptr != str) {
+               PerlMemShared_free(*(char**)ptr);
+               *(char**)ptr = str;
+           }
+           break;
        case SAVEt_GENERIC_SVREF:               /* generic sv */
            value = (SV*)SSPOPPTR;
            ptr = SSPOPPTR;
@@ -673,9 +693,7 @@ Perl_leave_scope(pTHX_ I32 base)
            DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "restore svref: %p %p:%s -> %p:%s\n",
                                  ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
-           if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
-               SvTYPE(sv) != SVt_PVGV)
-           {
+           if (SvTYPE(sv) == SVt_PVMG && SvMAGIC(sv)) {
                (void)SvUPGRADE(value, SvTYPE(sv));
                SvMAGIC(value) = SvMAGIC(sv);
                SvFLAGS(value) |= SvMAGICAL(sv);
@@ -687,9 +705,7 @@ Perl_leave_scope(pTHX_ I32 base)
             * croaking that might ensue when the SvSETMAGIC() below is
             * called, or to avoid two different SVs pointing at the same
             * SvMAGIC()).  This needs a total rethink.  --GSAR */
-           else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) &&
-                    SvTYPE(value) != SVt_PVGV)
-           {
+           else if (SvTYPE(value) == SVt_PVMG && SvMAGIC(value)) {
                SvFLAGS(value) |= (SvFLAGS(value) &
                                  (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
                SvMAGICAL_off(value);
@@ -827,9 +843,8 @@ Perl_leave_scope(pTHX_ I32 base)
                 * if a my variable that was made readonly is going out of
                 * scope, we want to remove the readonlyness so that it can
                 * go out of scope quietly
-                * Disabled as I don't see need yet NI-S 2001/12/18
                 */
-               if (0 && SvPADMY(sv) && ! SvFAKE(sv))
+               if (SvPADMY(sv) && !SvFAKE(sv))
                    SvREADONLY_off(sv);
 
                if (SvTHINKFIRST(sv))