In perl_clone_using(), turn off AvREAL() on param->stashes.

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

diff --git a/mg.c b/mg.c
index 24d2b98..7c7c03e 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -178,6 +178,8 @@ S_is_container_magic(const MAGIC *mg)
     case PERL_MAGIC_arylen_p:
     case PERL_MAGIC_rhash:
     case PERL_MAGIC_symtab:
+    case PERL_MAGIC_tied: /* treat as value, so 'local @tied' isn't tied */
+    case PERL_MAGIC_tiedscalar: /* so 'local $scalar' isn't tied */
        return 0;
     default:
        return 1;
@@ -1649,10 +1651,12 @@ Invoke a magic method (like FETCH).
 
 * sv and mg are the tied thinggy and the tie magic;
 * meth is the name of the method to call;
-* n, arg1, arg2 are the number of args (in addition to $self) to pass to
-  the method, and the args themselves (negative n is special-cased);
+* argc, arg1, arg2 are the number of args (in addition to $self) to pass to
+  the method, and the args themselves
 * flags:
     G_DISCARD:     invoke method with G_DISCARD flag and don't return a value
+    G_UNDEF_FILL:  fill the stack with argc pointers to PL_sv_undef;
+                   ignore arg1 and arg2.
 
 Returns the SV (if any) returned by the method, or NULL on failure.
 
@@ -1661,8 +1665,8 @@ Returns the SV (if any) returned by the method, or NULL on failure.
 */
 
 SV*
-Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags,
-    int n, SV *arg1, SV *arg2)
+Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
+                   U32 argc, ...)
 {
     dVAR;
     dSP;
@@ -1674,22 +1678,22 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags,
     PUSHSTACKi(PERLSI_MAGIC);
     PUSHMARK(SP);
 
-    if (n < 0) {
-       /* special case for UNSHIFT */
-       EXTEND(SP,-n+1);
-       PUSHs(SvTIED_obj(sv, mg));
-       while (n++ < 0) {
+    EXTEND(SP, argc+1);
+    PUSHs(SvTIED_obj(sv, mg));
+    if (flags & G_UNDEF_FILL) {
+       while (argc--) {
            PUSHs(&PL_sv_undef);
        }
-    }
-    else {
-       EXTEND(SP,n+1);
-       PUSHs(SvTIED_obj(sv, mg));
-       if (n > 0) {
-           PUSHs(arg1);
-           if (n > 1) PUSHs(arg2);
-           assert(n <= 2);
-       }
+    } else if (argc > 0) {
+       va_list args;
+       va_start(args, argc);
+
+       do {
+           SV *const sv = va_arg(args, SV *);
+           PUSHs(sv);
+       } while (--argc);
+
+       va_end(args);
     }
     PUTBACK;
     if (flags & G_DISCARD) {
@@ -1708,7 +1712,7 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags,
 /* wrapper for magic_methcall that creates the first arg */
 
 STATIC SV*
-S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags,
+S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
     int n, SV *val)
 {
     dVAR;
@@ -1718,22 +1722,19 @@ S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags,
 
     if (mg->mg_ptr) {
        if (mg->mg_len >= 0) {
-           arg1 = newSVpvn(mg->mg_ptr, mg->mg_len);
-           sv_2mortal(arg1);
+           arg1 = newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP);
        }
        else if (mg->mg_len == HEf_SVKEY)
            arg1 = MUTABLE_SV(mg->mg_ptr);
     }
     else if (mg->mg_type == PERL_MAGIC_tiedelem) {
-       arg1 = newSV_type(SVt_IV);
-       sv_setiv(arg1, (IV)(mg->mg_len));
+       arg1 = newSViv((IV)(mg->mg_len));
        sv_2mortal(arg1);
     }
     if (!arg1) {
-       arg1 = val;
-       n--;
+       return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n - 1, val);
     }
-    return magic_methcall(sv, mg, meth, flags, n, arg1, val);
+    return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n, arg1, val);
 }
 
 STATIC int
@@ -1827,7 +1828,7 @@ Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
 
     PERL_ARGS_ASSERT_MAGIC_WIPEPACK;
 
-    magic_methcall(sv, mg, "CLEAR", G_DISCARD, 0, NULL, NULL);
+    Perl_magic_methcall(aTHX_ sv, mg, "CLEAR", G_DISCARD, 0);
     return 0;
 }
 
@@ -1839,10 +1840,8 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 
     PERL_ARGS_ASSERT_MAGIC_NEXTPACK;
 
-    ret = magic_methcall(sv, mg,
-           (SvOK(key) ? "NEXTKEY" : "FIRSTKEY"),
-           0,
-           (SvOK(key) ? 1 : 0), key, NULL);
+    ret = SvOK(key) ? Perl_magic_methcall(aTHX_ sv, mg, "NEXTKEY", 0, 1, key)
+       : Perl_magic_methcall(aTHX_ sv, mg, "FIRSTKEY", 0, 0);
     if (ret)
        sv_setsv(key,ret);
     return 0;
@@ -1879,7 +1878,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
     }
    
     /* there is a SCALAR method that we can call */
-    retval = magic_methcall(MUTABLE_SV(hv), mg, "SCALAR", 0, 0, NULL, NULL);
+    retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, "SCALAR", 0, 0);
     if (!retval)
        retval = &PL_sv_undef;
     return retval;
@@ -3007,7 +3006,7 @@ Perl_sighandler(int sig)
        (void)rsignal(sig, PL_csighandlerp);
 #endif
 #endif /* !PERL_MICRO */
-       Perl_die(aTHX_ NULL);
+       die_sv(ERRSV);
     }
 cleanup:
     if (flags & 1)
@@ -3074,13 +3073,12 @@ S_restore_magic(pTHX_ const void *p)
      */
     if (PL_savestack_ix == mgs->mgs_ss_ix)
     {
-       I32 popval = SSPOPINT;
+       UV popval = SSPOPUV;
         assert(popval == SAVEt_DESTRUCTOR_X);
         PL_savestack_ix -= 2;
-       popval = SSPOPINT;
-        assert(popval == SAVEt_ALLOC);
-       popval = SSPOPINT;
-        PL_savestack_ix -= popval;
+       popval = SSPOPUV;
+        assert((popval & SAVE_MASK) == SAVEt_ALLOC);
+        PL_savestack_ix -= popval >> SAVE_TIGHT_SHIFT;
     }
 
 }