Not working yet - split problems ...

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

diff --git a/pp.c b/pp.c
index 7864089..e7305d8 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -140,8 +140,17 @@ PP(pp_padav)
     }
     if (GIMME == G_ARRAY) {
        I32 maxarg = AvFILL((AV*)TARG) + 1;
-       EXTEND(SP, maxarg);
-       Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
+       EXTEND(SP, maxarg);                
+       if (SvMAGICAL(TARG)) {
+           U32 i;
+           for (i=0; i < maxarg; i++) {
+               SV **svp = av_fetch((AV*)TARG, i, FALSE);
+               SP[i+1] = (svp) ? *svp : &sv_undef;
+           }
+       }
+       else {
+           Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
+       }
        SP += maxarg;
     }
     else {
@@ -2446,13 +2455,25 @@ PP(pp_splice)
     I32 after;
     I32 diff;
     SV **tmparyval = 0;
+    MAGIC *mg;
+
+    if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
+       *MARK-- = mg->mg_obj;
+       PUSHMARK(MARK);
+       PUTBACK;       
+       ENTER;
+       perl_call_method("SPLICE",GIMME_V);
+       LEAVE;
+       SPAGAIN;
+       RETURN;
+    }
 
     SP++;
 
     if (++MARK < SP) {
        offset = i = SvIVx(*MARK);
        if (offset < 0)
-           offset += AvFILL(ary) + 1;
+           offset += AvFILLp(ary) + 1;
        else
            offset -= curcop->cop_arybase;
        if (offset < 0)
@@ -2469,9 +2490,9 @@ PP(pp_splice)
        offset = 0;
        length = AvMAX(ary) + 1;
     }
-    if (offset > AvFILL(ary) + 1)
-       offset = AvFILL(ary) + 1;
-    after = AvFILL(ary) + 1 - (offset + length);
+    if (offset > AvFILLp(ary) + 1)
+       offset = AvFILLp(ary) + 1;
+    after = AvFILLp(ary) + 1 - (offset + length);
     if (after < 0) {                           /* not that much array */
        length += after;                        /* offset+length now in array */
        after = 0;
@@ -2519,7 +2540,7 @@ PP(pp_splice)
                    SvREFCNT_dec(*dst++);       /* free them now */
            }
        }
-       AvFILL(ary) += diff;
+       AvFILLp(ary) += diff;
 
        /* pull up or down? */
 
@@ -2540,7 +2561,7 @@ PP(pp_splice)
                dst = src + diff;               /* diff is negative */
                Move(src, dst, after, SV*);
            }
-           dst = &AvARRAY(ary)[AvFILL(ary)+1];
+           dst = &AvARRAY(ary)[AvFILLp(ary)+1];
                                                /* avoid later double free */
        }
        i = -diff;
@@ -2574,15 +2595,15 @@ PP(pp_splice)
                }
                SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
                AvMAX(ary) += diff;
-               AvFILL(ary) += diff;
+               AvFILLp(ary) += diff;
            }
            else {
-               if (AvFILL(ary) + diff >= AvMAX(ary))   /* oh, well */
-                   av_extend(ary, AvFILL(ary) + diff);
-               AvFILL(ary) += diff;
+               if (AvFILLp(ary) + diff >= AvMAX(ary))  /* oh, well */
+                   av_extend(ary, AvFILLp(ary) + diff);
+               AvFILLp(ary) += diff;
 
                if (after) {
-                   dst = AvARRAY(ary) + AvFILL(ary);
+                   dst = AvARRAY(ary) + AvFILLp(ary);
                    src = dst - diff;
                    for (i = after; i; i--) {
                        *dst-- = *src--;
@@ -2632,13 +2653,26 @@ PP(pp_push)
 {
     djSP; dMARK; dORIGMARK; dTARGET;
     register AV *ary = (AV*)*++MARK;
-    register SV *sv = &sv_undef;
-
-    for (++MARK; MARK <= SP; MARK++) {
-       sv = NEWSV(51, 0);
-       if (*MARK)
-           sv_setsv(sv, *MARK);
-       av_push(ary, sv);
+    register SV *sv = &sv_undef; 
+    MAGIC *mg;
+                  
+    if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
+       *MARK-- = mg->mg_obj;
+       PUSHMARK(MARK);
+       PUTBACK;
+       ENTER;
+       perl_call_method("PUSH",G_SCALAR|G_DISCARD);
+       LEAVE;
+       SPAGAIN;
+    }
+    else {
+       /* Why no pre-extend of ary here ? */
+       for (++MARK; MARK <= SP; MARK++) {
+           sv = NEWSV(51, 0);
+           if (*MARK)
+               sv_setsv(sv, *MARK);
+           av_push(ary, sv);
+       }
     }
     SP = ORIGMARK;
     PUSHi( AvFILL(ary) + 1 );
@@ -2676,14 +2710,26 @@ PP(pp_unshift)
     register AV *ary = (AV*)*++MARK;
     register SV *sv;
     register I32 i = 0;
+    MAGIC *mg;
+
+    if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {            
 
-    av_unshift(ary, SP - MARK);
-    while (MARK < SP) {
-       sv = NEWSV(27, 0);
-       sv_setsv(sv, *++MARK);
-       (void)av_store(ary, i++, sv);
-    }
 
+       *MARK-- = mg->mg_obj;
+       PUTBACK;
+       ENTER;
+       perl_call_method("UNSHIFT",G_SCALAR|G_DISCARD);
+       LEAVE;
+       SPAGAIN;
+    }
+    else {
+       av_unshift(ary, SP - MARK);
+       while (MARK < SP) {
+           sv = NEWSV(27, 0);
+           sv_setsv(sv, *++MARK);
+           (void)av_store(ary, i++, sv);
+       }
+    }
     SP = ORIGMARK;
     PUSHi( AvFILL(ary) + 1 );
     RETURN;
@@ -4042,7 +4088,8 @@ PP(pp_split)
     I32 base;
     AV *oldstack = curstack;
     I32 gimme = GIMME_V;
-    I32 oldsave = savestack_ix;
+    I32 oldsave = savestack_ix; 
+    I32 stacks_switched = 0;
 
 #ifdef DEBUGGING
     Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
@@ -4068,15 +4115,18 @@ PP(pp_split)
        ary = Nullav;
     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
        realarray = 1;
-       if (!AvREAL(ary)) {
-           AvREAL_on(ary);
-           for (i = AvFILL(ary); i >= 0; i--)
-               AvARRAY(ary)[i] = &sv_undef;    /* don't free mere refs */
-       }
        av_extend(ary,0);
-       av_clear(ary);
-       /* temporarily switch stacks */
-       SWITCHSTACK(curstack, ary);
+       av_clear(ary);                 
+       if (!SvRMAGICAL(ary) || !mg_find((SV *) ary, 'P')) {
+           if (!AvREAL(ary)) {
+               AvREAL_on(ary);
+               for (i = AvFILLp(ary); i >= 0; i--)
+                   AvARRAY(ary)[i] = &sv_undef;        /* don't free mere refs */
+           }
+           /* temporarily switch stacks */
+           SWITCHSTACK(curstack, ary);
+           stacks_switched = 1;
+       }
     }
     base = SP - stack_base;
     orig = s;
@@ -4227,17 +4277,44 @@ PP(pp_split)
            iters--, SP--;
     }
     if (realarray) {
-       SWITCHSTACK(ary, oldstack);
-       if (SvSMAGICAL(ary)) {
-           PUTBACK;
-           mg_set((SV*)ary);
-           SPAGAIN;
-       }
-       if (gimme == G_ARRAY) {
-           EXTEND(SP, iters);
-           Copy(AvARRAY(ary), SP + 1, iters, SV*);
-           SP += iters;
-           RETURN;
+       if (stacks_switched) {
+           SWITCHSTACK(ary, oldstack);
+           if (SvSMAGICAL(ary)) {
+               PUTBACK;
+               mg_set((SV*)ary);
+               SPAGAIN;
+           }
+           if (gimme == G_ARRAY) {
+               EXTEND(SP, iters);
+               Copy(AvARRAY(ary), SP + 1, iters, SV*);
+               SP += iters;
+               RETURN;
+           }
+       } 
+       else {
+           av_extend(ary, iters -1); 
+           for (i= 0; i < iters; i++) {
+               dstr = SP[i+1-iters];           
+               PUTBACK;
+               fprintf(stderr,"%d:%p %d '%s'\n",i,dstr,SvREFCNT(dstr), SvPV(dstr,na));
+               av_store(ary, i, dstr);
+               SPAGAIN;
+           }
+           if (SvSMAGICAL(ary)) {
+               PUTBACK;
+               mg_set((SV*)ary);
+               SPAGAIN;
+           }
+           for (i= 0; i < iters; i++) {
+               dstr = *av_fetch(ary,i,FALSE);
+               if (SvGMAGICAL(dstr))
+                   mg_get(dstr);
+               fprintf(stderr,"%d:%p '%s'\n",i,dstr,SvPV(dstr,na));
+           }
+           if (gimme != G_ARRAY) {
+               SP -= iters;
+               RETURN;
+           }
        }
     }
     else {