Add Matt Johnson to AUTHORS.

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index b6bd297..47844e0 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -178,6 +178,7 @@ 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 */
        return 0;
     default:
        return 1;
@@ -634,7 +635,7 @@ Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_REGDATUM_SET;
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
-    Perl_croak(aTHX_ "%s", PL_no_modify);
+    Perl_croak_no_modify(aTHX);
     NORETURN_FUNCTION_END;
 }
 
@@ -1555,7 +1556,7 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
     PERL_UNUSED_ARG(sv);
 
     /* Skip _isaelem because _isa will handle it shortly */
-    if (PL_delaymagic & DM_ARRAY && mg->mg_type == PERL_MAGIC_isaelem)
+    if (PL_delaymagic & DM_ARRAY_ISA && mg->mg_type == PERL_MAGIC_isaelem)
        return 0;
 
     return magic_clearisa(NULL, mg);
@@ -1649,10 +1650,11 @@ 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 is the number of args (in addition to $self) to pass to the method;
+       the args themselves are any values following the argc argument.
 * 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.
 
 Returns the SV (if any) returned by the method, or NULL on failure.
 
@@ -1661,8 +1663,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 +1676,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 +1710,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;
@@ -1728,10 +1730,9 @@ S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags,
        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
@@ -1825,7 +1826,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;
 }
 
@@ -1837,10 +1838,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;
@@ -1877,7 +1876,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;
@@ -2373,7 +2372,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
              * set without a previous pattern match. Unless it's C<local $1>
              */
             if (!PL_localizing) {
-                Perl_croak(aTHX_ "%s", PL_no_modify);
+                Perl_croak_no_modify(aTHX);
             }
         }
     case '\001':       /* ^A */
@@ -3005,7 +3004,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)
@@ -3072,13 +3071,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;
     }
 
 }