Make parser_free() be called slightly later,

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

diff --git a/gv.c b/gv.c
index f0f2145..f48ef98 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -697,11 +697,12 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methp
                                  so save it. For the moment it's always
                                  a single char. */
        dSP;
-       PUTBACK;
        ENTER;
        if ( flags & 1 )
            save_scalar(gv);
+       PUSHSTACKi(PERLSI_MAGIC);
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL);
+       POPSTACK;
        LEAVE;
        SPAGAIN;
        stash = gv_stashsv(namesv, 0);
@@ -1004,7 +1005,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                if (*name == '!')
                    require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
                else if (*name == '-' || *name == '+')
-                   require_tie_mod(gv, name, newSVpvs("re::Tie::Hash::NamedCapture"), "FETCH", 0);
+                   require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "FETCH", 0);
            }
        }
        return gv;
@@ -1190,13 +1191,13 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
            goto magicalize;
 
        case '!':
-       GvMULTI_on(gv);    
+           GvMULTI_on(gv);
            /* If %! has been used, automatically load Errno.pm. */
 
            sv_magic(GvSVn(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
 
             /* magicalization must be done before require_tie_mod is called */
-           if (sv_type == SVt_PVHV)
+           if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
                require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
 
            break;
@@ -1204,33 +1205,19 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        case '+':
        GvMULTI_on(gv); /* no used once warnings here */
         {
-            bool plus = (*name == '+');
-            SV *stashname = newSVpvs("re::Tie::Hash::NamedCapture");
             AV* const av = GvAVn(gv);
-           HV *const hv = GvHVn(gv);
-           HV *const hv_tie = newHV();
-            SV *tie = newRV_noinc((SV*)hv_tie);
+           SV* const avc = (*name == '+') ? (SV*)av : NULL;
 
-           sv_bless(tie, gv_stashsv(stashname, GV_ADD));
-           hv_magic(hv, (GV*)tie, PERL_MAGIC_tied);
-            sv_magic((SV*)av, (plus ? (SV*)av : NULL), PERL_MAGIC_regdata, NULL, 0);
+           sv_magic((SV*)av, avc, PERL_MAGIC_regdata, NULL, 0);
             sv_magic(GvSVn(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
-
-            if (plus)
+            if (avc)
                 SvREADONLY_on(GvSVn(gv));
-            else
-                Perl_hv_store(aTHX_ hv_tie, STR_WITH_LEN("all"), newSViv(1), 0);
-
-            SvREADONLY_on(hv);
-            SvREADONLY_on(tie);
             SvREADONLY_on(av);
 
-           if (sv_type == SVt_PVHV)
-               require_tie_mod(gv, name, stashname, "FETCH", 0);
-           else
-               SvREFCNT_dec(stashname);
+            if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
+                require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "FETCH", 0);
 
-           break;
+            break;
        }
        case '*':
        case '#':
@@ -1300,7 +1287,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        {
            SV * const sv = GvSVn(gv);
            if (!sv_derived_from(PL_patchlevel, "version"))
-               upg_version(PL_patchlevel);
+               upg_version(PL_patchlevel, TRUE);
            GvSV(gv) = vnumify(PL_patchlevel);
            SvREADONLY_on(GvSV(gv));
            SvREFCNT_dec(sv);