Not working yet - split problems ...

p4raw-id: //depot/ansiperl@425

diff --git a/pp.c b/pp.c
index b6b3065..e7305d8 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4088,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*);
@@ -4114,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 = AvFILLp(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;
@@ -4273,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 {

diff --git a/t/lib/thread.t b/t/lib/thread.t
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/t/op/tiearray.t b/t/op/tiearray.t
index da25760..9e709bc 100755 (executable)
--- a/t/op/tiearray.t
+++ b/t/op/tiearray.t
@@ -101,7 +101,7 @@ sub SPLICE
 
 package main;
 
-print "1..29\n";                   
+print "1..30\n";                   
 my $test = 1;
 
 {my @ary;
@@ -130,10 +130,19 @@ print "ok ", $test++,"\n";
 
 print "not " unless $seen{'STORE'} >= 3;
 print "ok ", $test++,"\n";
-
 print "not " unless join(':',@ary) eq '1:2:3';
 print "ok ", $test++,"\n";         
 
+{my @thing = @ary;
+print "not " unless join(':',@thing) eq '1:2:3';
+print "ok ", $test++,"\n";         
+
+tie @thing,'Implement';
+@thing = @ary;
+print "not " unless join(':',@thing) eq '1:2:3';
+print "ok ", $test++,"\n";
+} 
+
 print "not " unless pop(@ary) == 3;
 print "ok ", $test++,"\n";
 print "not " unless $seen{'POP'} == 1;
@@ -194,7 +203,7 @@ untie @ary;
 
 }
                            
-print "not " unless $seen{'DESTROY'} == 1;
+print "not " unless $seen{'DESTROY'} == 2;
 print "ok ", $test++,"\n";