This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix (valid) -Wall warnings in perlio.c
[perl5.git] / scope.c
diff --git a/scope.c b/scope.c
index 7c83a41..a82c0f5 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -1,6 +1,6 @@
 /*    scope.c
  *
- *    Copyright (c) 1991-2000, Larry Wall
+ *    Copyright (c) 1991-2001, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -196,17 +196,21 @@ S_save_scalar_at(pTHX_ SV **sptr)
        if (SvGMAGICAL(osv)) {
            MAGIC* mg;
            bool oldtainted = PL_tainted;
-           mg_get(osv);
-           if (PL_tainting && PL_tainted && (mg = mg_find(osv, 't'))) {
+           mg_get(osv);                /* note, can croak! */
+           if (PL_tainting && PL_tainted &&
+                       (mg = mg_find(osv, PERL_MAGIC_taint))) {
                SAVESPTR(mg->mg_obj);
                mg->mg_obj = osv;
            }
            SvFLAGS(osv) |= (SvFLAGS(osv) &
-               (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+               (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
            PL_tainted = oldtainted;
        }
        SvMAGIC(sv) = SvMAGIC(osv);
        SvFLAGS(sv) |= SvMAGICAL(osv);
+       /* XXX SvMAGIC() is *shared* between osv and sv.  This can
+        * lead to coredumps when both SVs are destroyed without one
+        * of their SvMAGIC() slots being NULLed. */
        PL_localizing = 1;
        SvSETMAGIC(sv);
        PL_localizing = 0;
@@ -501,6 +505,14 @@ Perl_save_freesv(pTHX_ SV *sv)
 }
 
 void
+Perl_save_mortalizesv(pTHX_ SV *sv)
+{
+    SSCHECK(2);
+    SSPUSHPTR(sv);
+    SSPUSHINT(SAVEt_MORTALIZESV);
+}
+
+void
 Perl_save_freeop(pTHX_ OP *o)
 {
     SSCHECK(2);
@@ -678,12 +690,19 @@ Perl_leave_scope(pTHX_ I32 base)
                SvMAGICAL_off(sv);
                SvMAGIC(sv) = 0;
            }
+           /* XXX This branch is pretty bogus.  This code irretrievably
+            * clears(!) the magic on the SV (either to avoid further
+            * 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)
            {
                SvFLAGS(value) |= (SvFLAGS(value) &
-                                  (SVp_IOK|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);
@@ -793,6 +812,10 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
            SvREFCNT_dec((SV*)ptr);
            break;
+       case SAVEt_MORTALIZESV:
+           ptr = SSPOPPTR;
+           sv_2mortal((SV*)ptr);
+           break;
        case SAVEt_FREEOP:
            ptr = SSPOPPTR;
            if (PL_comppad)
@@ -852,6 +875,7 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
            (void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD);
            SvREFCNT_dec(hv);
+           Safefree(ptr); 
            break;
        case SAVEt_DESTRUCTOR:
            ptr = SSPOPPTR;
@@ -878,7 +902,7 @@ Perl_leave_scope(pTHX_ I32 base)
            if (ptr) {
                sv = *(SV**)ptr;
                if (sv && sv != &PL_sv_undef) {
-                   if (SvTIED_mg((SV*)av, 'P'))
+                   if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
                        (void)SvREFCNT_inc(sv);
                    SvREFCNT_dec(av);
                    goto restore_sv;
@@ -896,7 +920,7 @@ Perl_leave_scope(pTHX_ I32 base)
                SV *oval = HeVAL((HE*)ptr);
                if (oval && oval != &PL_sv_undef) {
                    ptr = &HeVAL((HE*)ptr);
-                   if (SvTIED_mg((SV*)hv, 'P'))
+                   if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
                        (void)SvREFCNT_inc(*(SV**)ptr);
                    SvREFCNT_dec(hv);
                    SvREFCNT_dec(sv);
@@ -911,10 +935,6 @@ Perl_leave_scope(pTHX_ I32 base)
            PL_op = (OP*)SSPOPPTR;
            break;
        case SAVEt_HINTS:
-           if (GvHV(PL_hintgv)) {
-               SvREFCNT_dec((SV*)GvHV(PL_hintgv));
-               GvHV(PL_hintgv) = NULL;
-           }
            *(I32*)&PL_hints = (I32)SSPOPINT;
            break;
        case SAVEt_COMPPAD: