Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes

 - added delete of READONLY value inhibit & test for same
 - re-tabbed

p4raw-id: //depot/perlio@13760

1 files changed, 38 insertions, 29 deletions

diff --git a/scope.c b/scope.c
index cc6f13c9b9..da5fa6b581 100644
--- a/scope.c
+++ b/scope.c
@@ -143,7 +143,7 @@ Perl_markstack_grow(pTHX)
 void
 Perl_savestack_grow(pTHX)
 {
-    PL_savestack_max = GROW(PL_savestack_max) + 4; 
+    PL_savestack_max = GROW(PL_savestack_max) + 4;
     Renew(PL_savestack, PL_savestack_max, ANY);
 }
 
@@ -169,7 +169,7 @@ Perl_free_tmps(pTHX)
     while (PL_tmps_ix > myfloor) {      /* clean up after last statement */
 	SV* sv = PL_tmps_stack[PL_tmps_ix];
 	PL_tmps_stack[PL_tmps_ix--] = Nullsv;
-	if (sv) {
+	if (sv && sv != &PL_sv_undef) {
 	    SvTEMP_off(sv);
 	    SvREFCNT_dec(sv);		/* note, can modify tmps_ix!!! */
 	}
@@ -195,7 +195,7 @@ S_save_scalar_at(pTHX_ SV **sptr)
 		mg->mg_obj = osv;
 	    }
 	    SvFLAGS(osv) |= (SvFLAGS(osv) &
-               (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+	       (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 	    PL_tainted = oldtainted;
 	}
 	SvMAGIC(sv) = SvMAGIC(osv);
@@ -606,12 +606,12 @@ I32
 Perl_save_alloc(pTHX_ I32 size, I32 pad)
 {
     register I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
-                                - (char*)PL_savestack);
+				- (char*)PL_savestack);
     register I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
 
     /* SSCHECK may not be good enough */
     while (PL_savestack_ix + elems + 2 > PL_savestack_max)
-        savestack_grow();
+	savestack_grow();
 
     PL_savestack_ix += elems;
     SSPUSHINT(elems);
@@ -643,13 +643,13 @@ Perl_leave_scope(pTHX_ I32 base)
 	    SvSETMAGIC(sv);
 	    PL_localizing = 0;
 	    break;
-        case SAVEt_SV:				/* scalar reference */
+	case SAVEt_SV:				/* scalar reference */
 	    value = (SV*)SSPOPPTR;
 	    gv = (GV*)SSPOPPTR;
 	    ptr = &GvSV(gv);
 	    SvREFCNT_dec(gv);
 	    goto restore_sv;
-        case SAVEt_GENERIC_PVREF:		/* generic pv */
+	case SAVEt_GENERIC_PVREF:		/* generic pv */
 	    str = (char*)SSPOPPTR;
 	    ptr = SSPOPPTR;
 	    if (*(char**)ptr != str) {
@@ -657,7 +657,7 @@ Perl_leave_scope(pTHX_ I32 base)
 		*(char**)ptr = str;
 	    }
 	    break;
-        case SAVEt_GENERIC_SVREF:		/* generic sv */
+	case SAVEt_GENERIC_SVREF:		/* generic sv */
 	    value = (SV*)SSPOPPTR;
 	    ptr = SSPOPPTR;
 	    sv = *(SV**)ptr;
@@ -665,14 +665,14 @@ Perl_leave_scope(pTHX_ I32 base)
 	    SvREFCNT_dec(sv);
 	    SvREFCNT_dec(value);
 	    break;
-        case SAVEt_SVREF:			/* scalar reference */
+	case SAVEt_SVREF:			/* scalar reference */
 	    value = (SV*)SSPOPPTR;
 	    ptr = SSPOPPTR;
 	restore_sv:
 	    sv = *(SV**)ptr;
 	    DEBUG_S(PerlIO_printf(Perl_debug_log,
 				  "restore svref: %p %p:%s -> %p:%s\n",
-			  	  ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
+				  ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
 	    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
 		SvTYPE(sv) != SVt_PVGV)
 	    {
@@ -691,20 +691,20 @@ Perl_leave_scope(pTHX_ I32 base)
 		     SvTYPE(value) != SVt_PVGV)
 	    {
 		SvFLAGS(value) |= (SvFLAGS(value) &
-                                  (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+				  (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 		SvMAGICAL_off(value);
 		/* XXX this is a leak when we get here because the
 		 * mg_get() in save_scalar_at() croaked */
 		SvMAGIC(value) = 0;
 	    }
-            SvREFCNT_dec(sv);
+	    SvREFCNT_dec(sv);
 	    *(SV**)ptr = value;
 	    PL_localizing = 2;
 	    SvSETMAGIC(value);
 	    PL_localizing = 0;
 	    SvREFCNT_dec(value);
-            break;
-        case SAVEt_AV:				/* array reference */
+	    break;
+	case SAVEt_AV:				/* array reference */
 	    av = (AV*)SSPOPPTR;
 	    gv = (GV*)SSPOPPTR;
 	    if (GvAV(gv)) {
@@ -715,14 +715,14 @@ Perl_leave_scope(pTHX_ I32 base)
 		SvMAGIC(goner) = 0;
 		SvREFCNT_dec(goner);
 	    }
-            GvAV(gv) = av;
+	    GvAV(gv) = av;
 	    if (SvMAGICAL(av)) {
 		PL_localizing = 2;
 		SvSETMAGIC((SV*)av);
 		PL_localizing = 0;
 	    }
-            break;
-        case SAVEt_HV:				/* hash reference */
+	    break;
+	case SAVEt_HV:				/* hash reference */
 	    hv = (HV*)SSPOPPTR;
 	    gv = (GV*)SSPOPPTR;
 	    if (GvHV(gv)) {
@@ -733,13 +733,13 @@ Perl_leave_scope(pTHX_ I32 base)
 		SvMAGIC(goner) = 0;
 		SvREFCNT_dec(goner);
 	    }
-            GvHV(gv) = hv;
+	    GvHV(gv) = hv;
 	    if (SvMAGICAL(hv)) {
 		PL_localizing = 2;
 		SvSETMAGIC((SV*)hv);
 		PL_localizing = 0;
 	    }
-            break;
+	    break;
 	case SAVEt_INT:				/* int reference */
 	    ptr = SSPOPPTR;
 	    *(int*)ptr = (int)SSPOPINT;
@@ -788,18 +788,18 @@ Perl_leave_scope(pTHX_ I32 base)
 	case SAVEt_GP:				/* scalar reference */
 	    ptr = SSPOPPTR;
 	    gv = (GV*)SSPOPPTR;
-            if (SvPVX(gv) && SvLEN(gv) > 0) {
-                Safefree(SvPVX(gv));
-            }
-            SvPVX(gv) = (char *)SSPOPPTR;
-            SvCUR(gv) = (STRLEN)SSPOPIV;
-            SvLEN(gv) = (STRLEN)SSPOPIV;
-            gp_free(gv);
-            GvGP(gv) = (GP*)ptr;
+	    if (SvPVX(gv) && SvLEN(gv) > 0) {
+		Safefree(SvPVX(gv));
+	    }
+	    SvPVX(gv) = (char *)SSPOPPTR;
+	    SvCUR(gv) = (STRLEN)SSPOPIV;
+	    SvLEN(gv) = (STRLEN)SSPOPIV;
+	    gp_free(gv);
+	    GvGP(gv) = (GP*)ptr;
 	    if (GvCVu(gv))
 		PL_sub_generation++;  /* putting a method back into circulation */
 	    SvREFCNT_dec(gv);
-            break;
+	    break;
 	case SAVEt_FREESV:
 	    ptr = SSPOPPTR;
 	    SvREFCNT_dec((SV*)ptr);
@@ -823,6 +823,15 @@ Perl_leave_scope(pTHX_ I32 base)
 	    sv = *(SV**)ptr;
 	    /* Can clear pad variable in place? */
 	    if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
+		/*
+		 * 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))
+		    SvREADONLY_off(sv);
+
 		if (SvTHINKFIRST(sv))
 		    sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF);
 		if (SvMAGICAL(sv))
@@ -867,7 +876,7 @@ Perl_leave_scope(pTHX_ I32 base)
 	    ptr = SSPOPPTR;
 	    (void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD);
 	    SvREFCNT_dec(hv);
-	    Safefree(ptr); 
+	    Safefree(ptr);
 	    break;
 	case SAVEt_DESTRUCTOR:
 	    ptr = SSPOPPTR;