Missing PUSHMARK in unshift TIEARRAY hook

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

diff --git a/pp.c b/pp.c
index 3afd65b..2512979 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -360,9 +360,54 @@ PP(pp_prototype)
     SV *ret;
 
     ret = &sv_undef;
+    if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
+       char *s = SvPVX(TOPs);
+       if (strnEQ(s, "CORE::", 6)) {
+           int code;
+           
+           code = keyword(s + 6, SvCUR(TOPs) - 6);
+           if (code < 0) {     /* Overridable. */
+#define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
+               int i = 0, n = 0, seen_question = 0;
+               I32 oa;
+               char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
+
+               while (i < MAXO) {      /* The slow way. */
+                   if (strEQ(s + 6, op_name[i]) || strEQ(s + 6, op_desc[i]))
+                       goto found;
+                   i++;
+               }
+               goto nonesuch;          /* Should not happen... */
+             found:
+               oa = opargs[i] >> OASHIFT;
+               while (oa) {
+                   if (oa & OA_OPTIONAL) {
+                       seen_question = 1;
+                       str[n++] = ';';
+                   } else if (seen_question) 
+                       goto set;       /* XXXX system, exec */
+                   if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF 
+                       && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
+                       str[n++] = '\\';
+                   }
+                   /* What to do with R ((un)tie, tied, (sys)read, recv)? */
+                   str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
+                   oa = oa >> 4;
+               }
+               str[n++] = '\0';
+               ret = sv_2mortal(newSVpv(str, n - 1));
+           } else if (code)            /* Non-Overridable */
+               goto set;
+           else {                      /* None such */
+             nonesuch:
+               croak("Cannot find an opnumber for \"%s\"", s+6);
+           }
+       }
+    }
     cv = sv_2cv(TOPs, &stash, &gv, FALSE);
     if (cv && SvPOK(cv))
        ret = sv_2mortal(newSVpv(SvPVX(cv), SvCUR(cv)));
+  set:
     SETs(ret);
     RETURN;
 }
@@ -1866,7 +1911,7 @@ PP(pp_vec)
        }
     }
 
-    sv_setiv(TARG, (IV)retnum);
+    sv_setuv(TARG, (UV)retnum);
     PUSHs(TARG);
     RETURN;
 }
@@ -2713,9 +2758,8 @@ PP(pp_unshift)
     MAGIC *mg;
 
     if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
-
-
        *MARK-- = mg->mg_obj;
+       PUSHMARK(MARK);
        PUTBACK;
        ENTER;
        perl_call_method("UNSHIFT",G_SCALAR|G_DISCARD);
@@ -3107,7 +3151,7 @@ PP(pp_unpack)
                    s += SIZE16;
 #ifdef HAS_NTOHS
                    if (datumtype == 'n')
-                       aushort = ntohs(aushort);
+                       aushort = PerlSock_ntohs(aushort);
 #endif
 #ifdef HAS_VTOHS
                    if (datumtype == 'v')
@@ -3125,7 +3169,7 @@ PP(pp_unpack)
                    sv = NEWSV(39, 0);
 #ifdef HAS_NTOHS
                    if (datumtype == 'n')
-                       aushort = ntohs(aushort);
+                       aushort = PerlSock_ntohs(aushort);
 #endif
 #ifdef HAS_VTOHS
                    if (datumtype == 'v')
@@ -3226,7 +3270,7 @@ PP(pp_unpack)
                    s += SIZE32;
 #ifdef HAS_NTOHL
                    if (datumtype == 'N')
-                       aulong = ntohl(aulong);
+                       aulong = PerlSock_ntohl(aulong);
 #endif
 #ifdef HAS_VTOHL
                    if (datumtype == 'V')
@@ -3246,7 +3290,7 @@ PP(pp_unpack)
                    s += SIZE32;
 #ifdef HAS_NTOHL
                    if (datumtype == 'N')
-                       aulong = ntohl(aulong);
+                       aulong = PerlSock_ntohl(aulong);
 #endif
 #ifdef HAS_VTOHL
                    if (datumtype == 'V')
@@ -3856,7 +3900,7 @@ PP(pp_pack)
                fromstr = NEXTFROM;
                ashort = (I16)SvIV(fromstr);
 #ifdef HAS_HTONS
-               ashort = htons(ashort);
+               ashort = PerlSock_htons(ashort);
 #endif
                CAT16(cat, &ashort);
            }
@@ -3968,7 +4012,7 @@ PP(pp_pack)
                fromstr = NEXTFROM;
                aulong = SvUV(fromstr);
 #ifdef HAS_HTONL
-               aulong = htonl(aulong);
+               aulong = PerlSock_htonl(aulong);
 #endif
                CAT32(cat, &aulong);
            }
@@ -4392,7 +4436,7 @@ PP(pp_threadsv)
     if (op->op_private & OPpLVAL_INTRO)
        PUSHs(*save_threadsv(op->op_targ));
     else
-       PUSHs(*av_fetch(thr->threadsv, op->op_targ, FALSE));
+       PUSHs(THREADSV(op->op_targ));
     RETURN;
 #else
     DIE("tried to access per-thread data in non-threaded perl");