This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
tie array changes to core and tests
authorNick Ing-Simmons <nik@tiuk.ti.com>
Tue, 13 Jan 1998 20:52:38 +0000 (20:52 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Tue, 13 Jan 1998 20:52:38 +0000 (20:52 +0000)
p4raw-id: //depot/ansiperl@418

22 files changed:
MANIFEST
av.c
av.h
deb.c
embed.h
ext/DB_File/DB_File.pm
global.sym
gv.c
mg.c
op.c
perl.c
perl.h
pp.c
pp.h
pp_ctl.c
pp_hot.c
proto.h
sv.c
t/op/tiearray.t [new file with mode: 0644]
toke.c
universal.c
util.c

index 243039f..07a4742 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -426,6 +426,7 @@ lib/Text/ParseWords.pm      Perl module to split words on arbitrary delimiter
 lib/Text/Soundex.pm    Perl module to implement Soundex
 lib/Text/Tabs.pm       Do expand and unexpand
 lib/Text/Wrap.pm       Paragraph formatter
+lib/Tie/Array.pm       Base class for tied arrays
 lib/Tie/Hash.pm                Base class for tied hashes
 lib/Tie/RefHash.pm     Base class for tied hashes with references as keys
 lib/Tie/Scalar.pm      Base class for tied scalars
@@ -800,6 +801,7 @@ t/op/substr.t               See if substr works
 t/op/sysio.t           See if sysread and syswrite work
 t/op/taint.t           See if tainting works
 t/op/tie.t             See if tie/untie functions work
+t/op/tiearray.t                See if tied arrays work
 t/op/time.t            See if time functions work
 t/op/undef.t           See if undef works
 t/op/universal.t       See if UNIVERSAL class works
diff --git a/av.c b/av.c
index 1768442..45d4628 100644 (file)
--- a/av.c
+++ b/av.c
@@ -21,10 +21,14 @@ av_reify(AV *av)
     I32 key;
     SV* sv;
 
-    if (AvREAL(av))
-       return;
+    if (AvREAL(av))                           
+       return;          
+#ifdef DEBUGGING
+    if (SvRMAGICAL(av) && mg_find((SV*)av,'P')) 
+       warn("av_reify called on tied array");
+#endif
     key = AvMAX(av) + 1;
-    while (key > AvFILL(av) + 1)
+    while (key > AvFILLp(av) + 1)
        AvARRAY(av)[--key] = &sv_undef;
     while (key) {
        sv = AvARRAY(av)[--key];
@@ -44,15 +48,30 @@ void
 av_extend(AV *av, I32 key)
 {
     dTHR;                      /* only necessary if we have to extend stack */
+    MAGIC *mg;
+    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+       dSP;
+       ENTER;
+       SAVETMPS;
+       PUSHMARK(sp);
+       EXTEND(sp,2);
+       PUSHs(mg->mg_obj);
+       PUSHs(sv_2mortal(newSViv(key)));
+        PUTBACK;
+       perl_call_method("EXTEND", G_SCALAR|G_DISCARD);
+       FREETMPS;
+       LEAVE;
+       return;
+    }
     if (key > AvMAX(av)) {
        SV** ary;
        I32 tmp;
        I32 newmax;
 
        if (AvALLOC(av) != AvARRAY(av)) {
-           ary = AvALLOC(av) + AvFILL(av) + 1;
+           ary = AvALLOC(av) + AvFILLp(av) + 1;
            tmp = AvARRAY(av) - AvALLOC(av);
-           Move(AvARRAY(av), AvALLOC(av), AvFILL(av)+1, SV*);
+           Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
            AvMAX(av) += tmp;
            SvPVX(av) = (char*)AvALLOC(av);
            if (AvREAL(av)) {
@@ -127,6 +146,12 @@ av_fetch(register AV *av, I32 key, I32 lval)
     if (!av)
        return 0;
 
+    if (key < 0) {
+       key += AvFILL(av) + 1;
+       if (key < 0)
+           return 0;
+    }
+
     if (SvRMAGICAL(av)) {
        if (mg_find((SV*)av,'P')) {
            dTHR;
@@ -137,12 +162,7 @@ av_fetch(register AV *av, I32 key, I32 lval)
        }
     }
 
-    if (key < 0) {
-       key += AvFILL(av) + 1;
-       if (key < 0)
-           return 0;
-    }
-    else if (key > AvFILL(av)) {
+    if (key > AvFILLp(av)) {
        if (!lval)
            return 0;
        if (AvREALISH(av))
@@ -172,42 +192,47 @@ SV**
 av_store(register AV *av, I32 key, SV *val)
 {
     SV** ary;
+    U32  fill;
+
 
     if (!av)
        return 0;
     if (!val)
        val = &sv_undef;
 
-    if (SvRMAGICAL(av)) {
-       if (mg_find((SV*)av,'P')) {
-           if (val != &sv_undef)
-               mg_copy((SV*)av, val, 0, key);
-           return 0;
-       }
-    }
-
     if (key < 0) {
        key += AvFILL(av) + 1;
        if (key < 0)
            return 0;
     }
+
     if (SvREADONLY(av) && key >= AvFILL(av))
        croak(no_modify);
+
+    if (SvRMAGICAL(av)) {
+       if (mg_find((SV*)av,'P')) {
+           if (val != &sv_undef) {
+               mg_copy((SV*)av, val, 0, key);
+           }
+           return 0;
+       }
+    }
+
     if (!AvREAL(av) && AvREIFY(av))
        av_reify(av);
     if (key > AvMAX(av))
        av_extend(av,key);
     ary = AvARRAY(av);
-    if (AvFILL(av) < key) {
+    if (AvFILLp(av) < key) {
        if (!AvREAL(av)) {
            dTHR;
            if (av == curstack && key > stack_sp - stack_base)
                stack_sp = stack_base + key;    /* XPUSH in disguise */
            do
-               ary[++AvFILL(av)] = &sv_undef;
-           while (AvFILL(av) < key);
+               ary[++AvFILLp(av)] = &sv_undef;
+           while (AvFILLp(av) < key);
        }
-       AvFILL(av) = key;
+       AvFILLp(av) = key;
     }
     else if (AvREAL(av))
        SvREFCNT_dec(ary[key]);
@@ -232,7 +257,7 @@ newAV(void)
     AvREAL_on(av);
     AvALLOC(av) = 0;
     SvPVX(av) = 0;
-    AvMAX(av) = AvFILL(av) = -1;
+    AvMAX(av) = AvFILLp(av) = -1;
     return av;
 }
 
@@ -250,7 +275,7 @@ av_make(register I32 size, register SV **strp)
        New(4,ary,size,SV*);
        AvALLOC(av) = ary;
        SvPVX(av) = (char*)ary;
-       AvFILL(av) = size - 1;
+       AvFILLp(av) = size - 1;
        AvMAX(av) = size - 1;
        for (i = 0; i < size; i++) {
            assert (*strp);
@@ -275,7 +300,7 @@ av_fake(register I32 size, register SV **strp)
     Copy(strp,ary,size,SV*);
     AvFLAGS(av) = AVf_REIFY;
     SvPVX(av) = (char*)ary;
-    AvFILL(av) = size - 1;
+    AvFILLp(av) = size - 1;
     AvMAX(av) = size - 1;
     while (size--) {
        assert (*strp);
@@ -300,9 +325,13 @@ av_clear(register AV *av)
        return;
     /*SUPPRESS 560*/
 
+    /* Give any tie a chance to cleanup first */
+    if (SvRMAGICAL(av))
+       mg_clear((SV*)av); 
+
     if (AvREAL(av)) {
        ary = AvARRAY(av);
-       key = AvFILL(av) + 1;
+       key = AvFILLp(av) + 1;
        while (key) {
            SvREFCNT_dec(ary[--key]);
            ary[key] = &sv_undef;
@@ -312,10 +341,8 @@ av_clear(register AV *av)
        AvMAX(av) += key;
        SvPVX(av) = (char*)AvALLOC(av);
     }
-    AvFILL(av) = -1;
+    AvFILLp(av) = -1;
 
-    if (SvRMAGICAL(av))
-       mg_clear((SV*)av); 
 }
 
 void
@@ -326,15 +353,20 @@ av_undef(register AV *av)
     if (!av)
        return;
     /*SUPPRESS 560*/
+
+    /* Give any tie a chance to cleanup first */
+    if (SvRMAGICAL(av) && mg_find((SV*)av,'P')) 
+       av_fill(av, -1);   /* mg_clear() ? */
+
     if (AvREAL(av)) {
-       key = AvFILL(av) + 1;
+       key = AvFILLp(av) + 1;
        while (key)
            SvREFCNT_dec(AvARRAY(av)[--key]);
     }
     Safefree(AvALLOC(av));
     AvALLOC(av) = 0;
     SvPVX(av) = 0;
-    AvMAX(av) = AvFILL(av) = -1;
+    AvMAX(av) = AvFILLp(av) = -1;
     if (AvARYLEN(av)) {
        SvREFCNT_dec(AvARYLEN(av));
        AvARYLEN(av) = 0;
@@ -343,23 +375,50 @@ av_undef(register AV *av)
 
 void
 av_push(register AV *av, SV *val)
-{
+{             
+    MAGIC *mg;
     if (!av)
        return;
-    av_store(av,AvFILL(av)+1,val);
+    if (SvREADONLY(av))
+       croak(no_modify);
+
+    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+       dSP;
+       PUSHMARK(sp);
+       EXTEND(sp,2);
+       PUSHs(mg->mg_obj);
+       PUSHs(val);
+        PUTBACK;
+       perl_call_method("PUSH", G_SCALAR|G_DISCARD);
+       return;
+    }
+    av_store(av,AvFILLp(av)+1,val);
 }
 
 SV *
 av_pop(register AV *av)
 {
     SV *retval;
+    MAGIC* mg;
 
     if (!av || AvFILL(av) < 0)
        return &sv_undef;
     if (SvREADONLY(av))
        croak(no_modify);
-    retval = AvARRAY(av)[AvFILL(av)];
-    AvARRAY(av)[AvFILL(av)--] = &sv_undef;
+    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+       dSP;    
+       PUSHMARK(sp);
+       XPUSHs(mg->mg_obj);
+        PUTBACK;
+       if (perl_call_method("POP", G_SCALAR)) {
+           retval = newSVsv(*stack_sp--);    
+       } else {    
+           retval = &sv_undef;
+       }
+       return retval;
+    }
+    retval = AvARRAY(av)[AvFILLp(av)];
+    AvARRAY(av)[AvFILLp(av)--] = &sv_undef;
     if (SvSMAGICAL(av))
        mg_set((SV*)av);
     return retval;
@@ -370,11 +429,26 @@ av_unshift(register AV *av, register I32 num)
 {
     register I32 i;
     register SV **sstr,**dstr;
+    MAGIC* mg;
 
     if (!av || num <= 0)
        return;
     if (SvREADONLY(av))
        croak(no_modify);
+
+    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+       dSP;
+       PUSHMARK(sp);
+       EXTEND(sp,1+num);
+       PUSHs(mg->mg_obj);
+       while (num-- > 0) {
+           PUSHs(&sv_undef);
+       }
+       PUTBACK;
+       perl_call_method("UNSHIFT", G_SCALAR|G_DISCARD);
+       return;
+    }
+
     if (!AvREAL(av) && AvREIFY(av))
        av_reify(av);
     i = AvARRAY(av) - AvALLOC(av);
@@ -384,18 +458,18 @@ av_unshift(register AV *av, register I32 num)
        num -= i;
     
        AvMAX(av) += i;
-       AvFILL(av) += i;
+       AvFILLp(av) += i;
        SvPVX(av) = (char*)(AvARRAY(av) - i);
     }
     if (num) {
-       av_extend(av,AvFILL(av)+num);
-       AvFILL(av) += num;
-       dstr = AvARRAY(av) + AvFILL(av);
+       av_extend(av,AvFILLp(av)+num);
+       AvFILLp(av) += num;
+       dstr = AvARRAY(av) + AvFILLp(av);
        sstr = dstr - num;
 #ifdef BUGGY_MSC5
  # pragma loop_opt(off)        /* don't loop-optimize the following code */
 #endif /* BUGGY_MSC5 */
-       for (i = AvFILL(av) - num; i >= 0; --i) {
+       for (i = AvFILLp(av) - num; i >= 0; --i) {
            *dstr-- = *sstr--;
 #ifdef BUGGY_MSC5
  # pragma loop_opt()   /* loop-optimization back to command-line setting */
@@ -410,17 +484,30 @@ SV *
 av_shift(register AV *av)
 {
     SV *retval;
+    MAGIC* mg;
 
     if (!av || AvFILL(av) < 0)
        return &sv_undef;
     if (SvREADONLY(av))
        croak(no_modify);
+    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+       dSP;
+       PUSHMARK(sp);
+       XPUSHs(mg->mg_obj);
+        PUTBACK;
+       if (perl_call_method("SHIFT", G_SCALAR)) {
+           retval = newSVsv(*stack_sp--);            
+       } else {    
+           retval = &sv_undef;
+       }
+       return retval;
+    }
     retval = *AvARRAY(av);
     if (AvREAL(av))
        *AvARRAY(av) = &sv_undef;
     SvPVX(av) = (char*)(AvARRAY(av) + 1);
     AvMAX(av)--;
-    AvFILL(av)--;
+    AvFILLp(av)--;
     if (SvSMAGICAL(av))
        mg_set((SV*)av);
     return retval;
@@ -435,12 +522,27 @@ av_len(register AV *av)
 void
 av_fill(register AV *av, I32 fill)
 {
+    MAGIC *mg;
     if (!av)
        croak("panic: null array");
     if (fill < 0)
        fill = -1;
+    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+       dSP;            
+       ENTER;
+       SAVETMPS;
+       PUSHMARK(sp);
+       EXTEND(sp,2);
+       PUSHs(mg->mg_obj);
+       PUSHs(sv_2mortal(newSViv(fill)));
+       PUTBACK;
+       perl_call_method("STORESIZE", G_SCALAR|G_DISCARD);
+       FREETMPS;
+       LEAVE;
+       return;
+    }
     if (fill <= AvMAX(av)) {
-       I32 key = AvFILL(av);
+       I32 key = AvFILLp(av);
        SV** ary = AvARRAY(av);
 
        if (AvREAL(av)) {
@@ -454,7 +556,7 @@ av_fill(register AV *av, I32 fill)
                ary[++key] = &sv_undef;
        }
            
-       AvFILL(av) = fill;
+       AvFILLp(av) = fill;
        if (SvSMAGICAL(av))
            mg_set((SV*)av);
     }
diff --git a/av.h b/av.h
index a8dc60b..fd34cb0 100644 (file)
--- a/av.h
+++ b/av.h
@@ -1,6 +1,6 @@
 /*    av.h
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-1998, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -9,8 +9,8 @@
 
 struct xpvav {
     char*      xav_array;      /* pointer to first array element */
-    SSize_t    xav_fill;
-    SSize_t    xav_max;
+    SSize_t    xav_fill;       /* Index of last element present */
+    SSize_t    xav_max;        /* Number of elements for which array has space */
     IV         xof_off;        /* ptr is incremented by offset */
     double     xnv_nv;         /* numeric value, if any */
     MAGIC*     xmg_magic;      /* magic for scalar array */
@@ -30,7 +30,7 @@ struct xpvav {
 #define AvARRAY(av)    ((SV**)((XPVAV*)  SvANY(av))->xav_array)
 #define AvALLOC(av)    ((XPVAV*)  SvANY(av))->xav_alloc
 #define AvMAX(av)      ((XPVAV*)  SvANY(av))->xav_max
-#define AvFILL(av)     ((XPVAV*)  SvANY(av))->xav_fill
+#define AvFILLp(av)    ((XPVAV*)  SvANY(av))->xav_fill
 #define AvARYLEN(av)   ((XPVAV*)  SvANY(av))->xav_arylen
 #define AvFLAGS(av)    ((XPVAV*)  SvANY(av))->xav_flags
 
@@ -45,4 +45,8 @@ struct xpvav {
 #define AvREUSED_off(av) (AvFLAGS(av) &= ~AVf_REUSED)
 
 #define AvREALISH(av)  (AvFLAGS(av) & (AVf_REAL|AVf_REIFY))
+                                          
+#define AvFILL(av)     ((SvRMAGICAL((SV *) (av))) \
+                           ? mg_size((SV *) av) \
+                           : AvFILLp(av))
 
diff --git a/deb.c b/deb.c
index 95ea3f4..ea40c00 100644 (file)
--- a/deb.c
+++ b/deb.c
@@ -105,7 +105,7 @@ debstackptrs(void)
        (long)(stack_max-stack_base));
     PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
        (unsigned long)mainstack, (unsigned long)AvARRAY(curstack),
-       (long)mainstack, (long)AvFILL(curstack), (long)AvMAX(curstack));
+       (long)mainstack, (long)AvFILLp(curstack), (long)AvMAX(curstack));
     return 0;
 }
 
diff --git a/embed.h b/embed.h
index 60000ef..41a6af9 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define magic_settaint         Perl_magic_settaint
 #define magic_setuvar          Perl_magic_setuvar
 #define magic_setvec           Perl_magic_setvec
+#define magic_sizepack         Perl_magic_sizepack
 #define magic_wipepack         Perl_magic_wipepack
 #define magicname              Perl_magicname
 #define markstack_grow         Perl_markstack_grow
 #define mg_len                 Perl_mg_len
 #define mg_magical             Perl_mg_magical
 #define mg_set                 Perl_mg_set
+#define mg_size                        Perl_mg_size
 #define mod                    Perl_mod
 #define mod_amg                        Perl_mod_amg
 #define mod_ass_amg            Perl_mod_ass_amg
index d08b21c..4e7f0c6 100644 (file)
@@ -106,7 +106,7 @@ package DB_File::RECNOINFO ;
 
 use strict ;
 
-@DB_File::RECNOINFO::ISA = qw(DB_File::HASHINFO) ;
+@DB_File::RECNOINFO::ISA = qw(DB_File::HASHINFO) ;  
 
 sub TIEHASH
 {
@@ -189,7 +189,13 @@ require DynaLoader;
        R_SNAPSHOT
        __R_UNUSED
 
-);
+);  
+
+sub FETCHSIZE
+{ 
+    my $self = shift ;
+    return $self->length - 1;
+}
 
 sub AUTOLOAD {
     my($constname);
index 969f752..979f8d1 100644 (file)
@@ -416,6 +416,7 @@ magic_settaint
 magic_setuvar
 magic_setvec
 magic_set_all_env
+magic_sizepack
 magic_wipepack
 magicname
 markstack_grow
@@ -429,6 +430,7 @@ mg_get
 mg_len
 mg_magical
 mg_set
+mg_size
 mod
 modkids
 moreswitches
diff --git a/gv.c b/gv.c
index 7d8df6c..251e453 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -183,7 +183,8 @@ gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)
 
     if (av) {
        SV** svp = AvARRAY(av);
-       I32 items = AvFILL(av) + 1;
+       /* NOTE: No support for tied ISA */
+       I32 items = AvFILLp(av) + 1;
        while (items--) {
            SV* sv = *svp++;
            HV* basestash = gv_stashsv(sv, FALSE);
@@ -582,7 +583,8 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
            AV* av = GvAVn(gv);
            GvMULTI_on(gv);
            sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0);
-           if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILL(av) == -1)
+           /* NOTE: No support for tied ISA */
+           if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILLp(av) == -1)
            {
                char *pname;
                av_push(av, newSVpv(pname = "NDBM_File",0));
diff --git a/mg.c b/mg.c
index 1d00143..289dd3b 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -170,6 +170,37 @@ mg_len(SV *sv)
     return len;
 }
 
+I32
+mg_size(SV *sv)
+{
+    MAGIC* mg;
+    I32 len;
+    
+    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+       MGVTBL* vtbl = mg->mg_virtual;
+       if (vtbl && vtbl->svt_len) {
+           MGS mgs;
+           ENTER;
+           /* omit MGf_GSKIP -- not changed here */
+           len = (*vtbl->svt_len)(sv, mg);
+           LEAVE;
+           return len;
+       }
+    }
+
+    switch(SvTYPE(sv)) {
+       case SVt_PVAV:
+           len = AvFILLp((AV *) sv); /* Fallback to non-tied array */
+           return len;
+       case SVt_PVHV:
+           /* FIXME */
+       default:
+           croak("Size magic not implemented");
+           break;
+    }
+    return 0;
+}
+
 int
 mg_clear(SV *sv)
 {
@@ -865,8 +896,9 @@ magic_setisa(SV *sv, MAGIC *mg)
 
     stash = GvSTASH(mg->mg_obj);
     svp = AvARRAY((AV*)sv);
-    
-    for (fill = AvFILL((AV*)sv); fill >= 0; fill--, svp++) {
+                
+    /* NOTE: No support for tied ISA */
+    for (fill = AvFILLp((AV*)sv); fill >= 0; fill--, svp++) {
        HV *basestash = gv_stashsv(*svp, FALSE);
 
        if (!basestash) {
@@ -920,30 +952,46 @@ magic_setnkeys(SV *sv, MAGIC *mg)
        LvTARG(sv) = Nullsv;    /* Don't allow a ref to reassign this. */
     }
     return 0;
-}
+}          
 
 static int
-magic_methpack(SV *sv, MAGIC *mg, char *meth)
+magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val)
 {
     dSP;
 
-    ENTER;
-    SAVETMPS;
     PUSHMARK(sp);
-    EXTEND(sp, 2);
+    EXTEND(sp, n);
     PUSHs(mg->mg_obj);
-    if (mg->mg_ptr) {
-       if (mg->mg_len >= 0)
-           PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
-       else if (mg->mg_len == HEf_SVKEY)
-           PUSHs((SV*)mg->mg_ptr);
+    if (n > 1) { 
+       if (mg->mg_ptr) {
+           if (mg->mg_len >= 0)
+               PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
+           else if (mg->mg_len == HEf_SVKEY)
+               PUSHs((SV*)mg->mg_ptr);
+       }
+       else if (mg->mg_type == 'p') {
+           PUSHs(sv_2mortal(newSViv(mg->mg_len)));
+       }
+    }
+    if (n > 2) {
+       PUSHs(val);
     }
-    else if (mg->mg_type == 'p')
-       PUSHs(sv_2mortal(newSViv(mg->mg_len)));
     PUTBACK;
 
-    if (perl_call_method(meth, G_SCALAR))
+    return perl_call_method(meth, flags);
+}
+
+static int
+magic_methpack(SV *sv, MAGIC *mg, char *meth)
+{
+    dSP;
+
+    ENTER;
+    SAVETMPS;
+
+    if (magic_methcall(mg, meth, G_SCALAR, 2, NULL)) {
        sv_setsv(sv, *stack_sp--);
+    }
 
     FREETMPS;
     LEAVE;
@@ -962,24 +1010,7 @@ magic_getpack(SV *sv, MAGIC *mg)
 int
 magic_setpack(SV *sv, MAGIC *mg)
 {
-    dSP;
-
-    PUSHMARK(sp);
-    EXTEND(sp, 3);
-    PUSHs(mg->mg_obj);
-    if (mg->mg_ptr) {
-       if (mg->mg_len >= 0)
-           PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
-       else if (mg->mg_len == HEf_SVKEY)
-           PUSHs((SV*)mg->mg_ptr);
-    }
-    else if (mg->mg_type == 'p')
-       PUSHs(sv_2mortal(newSViv(mg->mg_len)));
-    PUSHs(sv);
-    PUTBACK;
-
-    perl_call_method("STORE", G_SCALAR|G_DISCARD);
-
+    magic_methcall(mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
     return 0;
 }
 
@@ -989,6 +1020,24 @@ magic_clearpack(SV *sv, MAGIC *mg)
     return magic_methpack(sv,mg,"DELETE");
 }
 
+
+U32
+magic_sizepack(SV *sv, MAGIC *mg)
+{         
+    dTHR;
+    U32 retval = 0;
+
+    ENTER;
+    SAVETMPS;
+    if (magic_methcall(mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
+       sv = *stack_sp--;
+       retval = (U32) SvIV(sv);
+    }
+    FREETMPS;
+    LEAVE;
+    return retval;
+}
+
 int magic_wipepack(SV *sv, MAGIC *mg)
 {
     dSP;
@@ -1208,7 +1257,7 @@ magic_getdefelem(SV *sv, MAGIC *mg)
                targ = HeVAL(he);
        }
        else {
-           AV* av = (AV*)LvTARG(sv);
+           AV* av = (AV*)LvTARG(sv); 
            if ((I32)LvTARGOFF(sv) <= AvFILL(av))
                targ = AvARRAY(av)[LvTARGOFF(sv)];
        }
@@ -1812,7 +1861,7 @@ sighandler(int sig)
 
     oldstack = curstack;
     if (curstack != signalstack)
-       AvFILL(signalstack) = 0;
+       AvFILLp(signalstack) = 0;
     SWITCHSTACK(curstack, signalstack);
 
     if(psig_name[sig]) {
diff --git a/op.c b/op.c
index 47f2f57..073569c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -108,9 +108,9 @@ pad_allocmy(char *name)
        }
        croak("Can't use global %s in \"my\"",name);
     }
-    if (dowarn && AvFILL(comppad_name) >= 0) {
+    if (dowarn && AvFILLp(comppad_name) >= 0) {
        SV **svp = AvARRAY(comppad_name);
-       for (off = AvFILL(comppad_name); off > comppad_name_floor; off--) {
+       for (off = AvFILLp(comppad_name); off > comppad_name_floor; off--) {
            if ((sv = svp[off])
                && sv != &sv_undef
                && SvIVX(sv) == 999999999       /* var is in open scope */
@@ -176,7 +176,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
            continue;
        curname = (AV*)*svp;
        svp = AvARRAY(curname);
-       for (off = AvFILL(curname); off > 0; off--) {
+       for (off = AvFILLp(curname); off > 0; off--) {
            if ((sv = svp[off]) &&
                sv != &sv_undef &&
                seq <= SvIVX(sv) &&
@@ -307,7 +307,7 @@ pad_findmy(char *name)
 #endif /* USE_THREADS */
 
     /* The one we're looking for is probably just before comppad_name_fill. */
-    for (off = AvFILL(comppad_name); off > 0; off--) {
+    for (off = AvFILLp(comppad_name); off > 0; off--) {
        if ((sv = svp[off]) &&
            sv != &sv_undef &&
            (!SvIVX(sv) ||
@@ -345,7 +345,7 @@ pad_leavemy(I32 fill)
        }
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
-    for (off = AvFILL(comppad_name); off > fill; off--) {
+    for (off = AvFILLp(comppad_name); off > fill; off--) {
        if ((sv = svp[off]) && sv != &sv_undef && SvIVX(sv) == 999999999)
            SvIVX(sv) = cop_seqmax;
     }
@@ -364,13 +364,13 @@ pad_alloc(I32 optype, U32 tmptype)
        pad_reset();
     if (tmptype & SVs_PADMY) {
        do {
-           sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE);
+           sv = *av_fetch(comppad, AvFILLp(comppad) + 1, TRUE);
        } while (SvPADBUSY(sv));                /* need a fresh one */
-       retval = AvFILL(comppad);
+       retval = AvFILLp(comppad);
     }
     else {
        SV **names = AvARRAY(comppad_name);
-       SSize_t names_fill = AvFILL(comppad_name);
+       SSize_t names_fill = AvFILLp(comppad_name);
        for (;;) {
            /*
             * "foreach" index vars temporarily become aliases to non-"my"
@@ -1502,7 +1502,7 @@ block_start(int full)
     int retval = savestack_ix;
     SAVEI32(comppad_name_floor);
     if (full) {
-       if ((comppad_name_fill = AvFILL(comppad_name)) > 0)
+       if ((comppad_name_fill = AvFILLp(comppad_name)) > 0)
            comppad_name_floor = comppad_name_fill;
        else
            comppad_name_floor = 0;
@@ -3026,7 +3026,7 @@ cv_undef(CV *cv)
     if (CvPADLIST(cv)) {
        /* may be during global destruction */
        if (SvREFCNT(CvPADLIST(cv))) {
-           I32 i = AvFILL(CvPADLIST(cv));
+           I32 i = AvFILLp(CvPADLIST(cv));
            while (i >= 0) {
                SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
                SV* sv = svp ? *svp : Nullsv;
@@ -3080,7 +3080,7 @@ CV* cv;
     pname = AvARRAY(pad_name);
     ppad = AvARRAY(pad);
 
-    for (ix = 1; ix <= AvFILL(pad_name); ix++) {
+    for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
        if (SvPOK(pname[ix]))
            PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n",
                          ix, ppad[ix],
@@ -3103,8 +3103,8 @@ cv_clone2(CV *proto, CV *outside)
     AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
     SV** pname = AvARRAY(protopad_name);
     SV** ppad = AvARRAY(protopad);
-    I32 fname = AvFILL(protopad_name);
-    I32 fpad = AvFILL(protopad);
+    I32 fname = AvFILLp(protopad_name);
+    I32 fpad = AvFILLp(protopad);
     AV* comppadlist;
     CV* cv;
 
@@ -3149,7 +3149,7 @@ cv_clone2(CV *proto, CV *outside)
     av_store(comppadlist, 0, (SV*)comppad_name);
     av_store(comppadlist, 1, (SV*)comppad);
     CvPADLIST(cv) = comppadlist;
-    av_fill(comppad, AvFILL(protopad));
+    av_fill(comppad, AvFILLp(protopad));
     curpad = AvARRAY(comppad);
 
     av = newAV();           /* will be @_ */
@@ -3386,12 +3386,12 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
        return cv;
     }
 
-    if (AvFILL(comppad_name) < AvFILL(comppad))
-       av_store(comppad_name, AvFILL(comppad), Nullsv);
+    if (AvFILLp(comppad_name) < AvFILLp(comppad))
+       av_store(comppad_name, AvFILLp(comppad), Nullsv);
 
     if (CvCLONE(cv)) {
        SV **namep = AvARRAY(comppad_name);
-       for (ix = AvFILL(comppad); ix > 0; ix--) {
+       for (ix = AvFILLp(comppad); ix > 0; ix--) {
            SV *namesv;
 
            if (SvIMMORTAL(curpad[ix]))
@@ -3417,7 +3417,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
        av_store(comppad, 0, (SV*)av);
        AvFLAGS(av) = AVf_REIFY;
 
-       for (ix = AvFILL(comppad); ix > 0; ix--) {
+       for (ix = AvFILLp(comppad); ix > 0; ix--) {
            if (SvIMMORTAL(curpad[ix]))
                continue;
            if (!SvPADMY(curpad[ix]))
@@ -3606,7 +3606,7 @@ newFORM(I32 floor, OP *o, OP *block)
     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
     CvFILEGV(cv) = curcop->cop_filegv;
 
-    for (ix = AvFILL(comppad); ix > 0; ix--) {
+    for (ix = AvFILLp(comppad); ix > 0; ix--) {
        if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix]))
            SvPADTMP_on(curpad[ix]);
     }
diff --git a/perl.c b/perl.c
index c0fa69f..a693f23 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2860,7 +2860,7 @@ call_list(I32 oldscope, AV *list)
     dJMPENV;
     int ret;
 
-    while (AvFILL(list) >= 0) {
+    while (AvFILL(list) >= 0) { 
        CV *cv = (CV*)av_shift(list);
 
        SAVEFREESV(cv);
diff --git a/perl.h b/perl.h
index bec110c..5c963ca 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -945,7 +945,7 @@ typedef union any ANY;
 typedef I32 (*filter_t) _((int, SV *, int));
 #define FILTER_READ(idx, sv, len)  filter_read(idx, sv, len)
 #define FILTER_DATA(idx)          (AvARRAY(rsfp_filters)[idx])
-#define FILTER_ISREADER(idx)      (idx >= AvFILL(rsfp_filters))
+#define FILTER_ISREADER(idx)      (idx >= AvFILLp(rsfp_filters))
 
 #ifdef DOSISH
 # if defined(OS2)
@@ -1750,7 +1750,7 @@ EXT MGVTBL vtbl_sigelem = {magic_getsig,
                                        magic_setsig,
                                        0,      magic_clearsig,
                                                        0};
-EXT MGVTBL vtbl_pack = {0,     0,      0,      magic_wipepack,
+EXT MGVTBL vtbl_pack = {0,     0,      magic_sizepack, magic_wipepack,
                                                        0};
 EXT MGVTBL vtbl_packelem =     {magic_getpack,
                                magic_setpack,
diff --git a/pp.c b/pp.c
index 7864089..3d02b09 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,23 @@ 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;
+       perl_call_method("SPLICE",GIMME_V);
+       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 +2488,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 +2538,7 @@ PP(pp_splice)
                    SvREFCNT_dec(*dst++);       /* free them now */
            }
        }
-       AvFILL(ary) += diff;
+       AvFILLp(ary) += diff;
 
        /* pull up or down? */
 
@@ -2540,7 +2559,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 +2593,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,8 +2651,19 @@ PP(pp_push)
 {
     djSP; dMARK; dORIGMARK; dTARGET;
     register AV *ary = (AV*)*++MARK;
-    register SV *sv = &sv_undef;
+    register SV *sv = &sv_undef; 
+    MAGIC *mg;
+                  
+    if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
+       *MARK-- = mg->mg_obj;
+       PUSHMARK(MARK);
+       PUTBACK;
+       perl_call_method("PUSH",GIMME_V);
+       SPAGAIN;
+       RETURN;
+    }
 
+    /* Why no pre-extend of ary here ? */
     for (++MARK; MARK <= SP; MARK++) {
        sv = NEWSV(51, 0);
        if (*MARK)
@@ -2676,14 +2706,23 @@ 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'))) {
+       *MARK-- = mg->mg_obj;
+       PUSHMARK(MARK);
+       PUTBACK;
+       perl_call_method("UNSHIFT",GIMME_V);
+       SPAGAIN;
+       RETURN;
+    }
+    
     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;
@@ -4070,7 +4109,7 @@ PP(pp_split)
        realarray = 1;
        if (!AvREAL(ary)) {
            AvREAL_on(ary);
-           for (i = AvFILL(ary); i >= 0; i--)
+           for (i = AvFILLp(ary); i >= 0; i--)
                AvARRAY(ary)[i] = &sv_undef;    /* don't free mere refs */
        }
        av_extend(ary,0);
diff --git a/pp.h b/pp.h
index 1914fcc..ab4140c 100644 (file)
--- a/pp.h
+++ b/pp.h
 #define ARGTARG                op->op_targ
 #define MAXARG         op->op_private
 
-#define SWITCHSTACK(f,t)       AvFILL(f) = sp - stack_base;            \
+#define SWITCHSTACK(f,t)       AvFILLp(f) = sp - stack_base;           \
                                stack_base = AvARRAY(t);                \
                                stack_max = stack_base + AvMAX(t);      \
-                               sp = stack_sp = stack_base + AvFILL(t); \
+                               sp = stack_sp = stack_base + AvFILLp(t);        \
                                curstack = t;
 
 #define EXTEND_MORTAL(n) \
index 8226274..9590271 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1214,10 +1214,10 @@ PP(pp_caller)
            AvREAL_off(dbargs);         /* XXX Should be REIFY */
        }
 
-       if (AvMAX(dbargs) < AvFILL(ary) + off)
-           av_extend(dbargs, AvFILL(ary) + off);
-       Copy(AvALLOC(ary), AvARRAY(dbargs), AvFILL(ary) + 1 + off, SV*);
-       AvFILL(dbargs) = AvFILL(ary) + off;
+       if (AvMAX(dbargs) < AvFILLp(ary) + off)
+           av_extend(dbargs, AvFILLp(ary) + off);
+       Copy(AvALLOC(ary), AvARRAY(dbargs), AvFILLp(ary) + 1 + off, SV*);
+       AvFILLp(dbargs) = AvFILLp(ary) + off;
     }
     RETURN;
 }
@@ -1348,7 +1348,7 @@ PP(pp_enteriter)
        cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
     else {
        cx->blk_loop.iterary = curstack;
-       AvFILL(curstack) = sp - stack_base;
+       AvFILLp(curstack) = sp - stack_base;
        cx->blk_loop.iterix = MARK - stack_base;
     }
 
@@ -1714,7 +1714,7 @@ PP(pp_goto)
            if (cx->blk_sub.hasargs) {   /* put @_ back onto stack */
                AV* av = cx->blk_sub.argarray;
                
-               items = AvFILL(av) + 1;
+               items = AvFILLp(av) + 1;
                stack_sp++;
                EXTEND(stack_sp, items); /* @_ could have been extended. */
                Copy(AvARRAY(av), stack_sp, items, SV*);
@@ -1764,10 +1764,10 @@ PP(pp_goto)
                else {  /* save temporaries on recursion? */
                    if (CvDEPTH(cv) == 100 && dowarn)
                        sub_crush_depth(cv);
-                   if (CvDEPTH(cv) > AvFILL(padlist)) {
+                   if (CvDEPTH(cv) > AvFILLp(padlist)) {
                        AV *newpad = newAV();
                        SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
-                       I32 ix = AvFILL((AV*)svp[1]);
+                       I32 ix = AvFILLp((AV*)svp[1]);
                        svp = AvARRAY(svp[0]);
                        for ( ;ix > 0; ix--) {
                            if (svp[ix] != &sv_undef) {
@@ -1801,7 +1801,7 @@ PP(pp_goto)
                            AvFLAGS(av) = AVf_REIFY;
                        }
                        av_store(padlist, CvDEPTH(cv), (SV*)newpad);
-                       AvFILL(padlist) = CvDEPTH(cv);
+                       AvFILLp(padlist) = CvDEPTH(cv);
                        svp = AvARRAY(padlist);
                    }
                }
@@ -1809,7 +1809,7 @@ PP(pp_goto)
                if (!cx->blk_sub.hasargs) {
                    AV* av = (AV*)curpad[0];
                    
-                   items = AvFILL(av) + 1;
+                   items = AvFILLp(av) + 1;
                    if (items) {
                        /* Mark is at the end of the stack. */
                        EXTEND(sp, items);
@@ -1849,7 +1849,7 @@ PP(pp_goto)
                        }
                    }
                    Copy(mark,AvARRAY(av),items,SV*);
-                   AvFILL(av) = items - 1;
+                   AvFILLp(av) = items - 1;
                    
                    while (items--) {
                        if (*mark)
@@ -2578,10 +2578,10 @@ PP(pp_leaveeval)
      * (Note that the fact that compcv and friends are still set here
      * is, AFAIK, an accident.)  --Chip
      */
-    if (AvFILL(comppad_name) >= 0) {
+    if (AvFILLp(comppad_name) >= 0) {
        SV **svp = AvARRAY(comppad_name);
        I32 ix;
-       for (ix = AvFILL(comppad_name); ix >= 0; ix--) {
+       for (ix = AvFILLp(comppad_name); ix >= 0; ix--) {
            SV *sv = svp[ix];
            if (sv && sv != &sv_undef && *SvPVX(sv) == '&') {
                SvREFCNT_dec(sv);
index 7c320b3..0462886 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -443,8 +443,17 @@ PP(pp_rv2av)
 
     if (GIMME == G_ARRAY) {
        I32 maxarg = AvFILL(av) + 1;
-       EXTEND(SP, maxarg);
-       Copy(AvARRAY(av), SP+1, maxarg, SV*);
+       EXTEND(SP, maxarg);          
+       if (SvRMAGICAL(av)) {
+           U32 i; 
+           for (i=0; i < maxarg; i++) {
+               SV **svp = av_fetch(av, i, FALSE);
+               SP[i+1] = (svp) ? *svp : &sv_undef;
+           }
+       } 
+       else {
+           Copy(AvARRAY(av), SP+1, maxarg, SV*);
+       }
        SP += maxarg;
     }
     else {
@@ -1378,7 +1387,9 @@ PP(pp_iter)
 
     SvREFCNT_dec(*cx->blk_loop.itervar);
 
-    if (sv = AvARRAY(av)[++cx->blk_loop.iterix])
+    if (sv = (SvMAGICAL(av)) 
+           ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE) 
+           : AvARRAY(av)[++cx->blk_loop.iterix])
        SvTEMP_off(sv);
     else
        sv = &sv_undef;
@@ -2038,7 +2049,7 @@ PP(pp_entersub)
 #else
                av = GvAV(defgv);
 #endif /* USE_THREADS */               
-               items = AvFILL(av) + 1;
+               items = AvFILLp(av) + 1;   /* @_ is not tieable */
 
                if (items) {
                    /* Mark is at the end of the stack. */
@@ -2085,11 +2096,11 @@ PP(pp_entersub)
            if (CvDEPTH(cv) == 100 && dowarn 
                  && !(PERLDB_SUB && cv == GvCV(DBsub)))
                sub_crush_depth(cv);
-           if (CvDEPTH(cv) > AvFILL(padlist)) {
+           if (CvDEPTH(cv) > AvFILLp(padlist)) {
                AV *av;
                AV *newpad = newAV();
                SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
-               I32 ix = AvFILL((AV*)svp[1]);
+               I32 ix = AvFILLp((AV*)svp[1]);
                svp = AvARRAY(svp[0]);
                for ( ;ix > 0; ix--) {
                    if (svp[ix] != &sv_undef) {
@@ -2119,7 +2130,7 @@ PP(pp_entersub)
                av_store(newpad, 0, (SV*)av);
                AvFLAGS(av) = AVf_REIFY;
                av_store(padlist, CvDEPTH(cv), (SV*)newpad);
-               AvFILL(padlist) = CvDEPTH(cv);
+               AvFILLp(padlist) = CvDEPTH(cv);
                svp = AvARRAY(padlist);
            }
        }
@@ -2127,7 +2138,7 @@ PP(pp_entersub)
        if (!hasargs) {
            AV* av = (AV*)curpad[0];
 
-           items = AvFILL(av) + 1;
+           items = AvFILLp(av) + 1;
            if (items) {
                /* Mark is at the end of the stack. */
                EXTEND(sp, items);
@@ -2176,7 +2187,7 @@ PP(pp_entersub)
                }
            }
            Copy(MARK,AvARRAY(av),items,SV*);
-           AvFILL(av) = items - 1;
+           AvFILLp(av) = items - 1;
            
            while (items--) {
                if (*MARK)
diff --git a/proto.h b/proto.h
index 67cebd1..19159c5 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -251,6 +251,7 @@ int magic_settaint  _((SV* sv, MAGIC* mg));
 int    magic_setuvar   _((SV* sv, MAGIC* mg));
 int    magic_setvec    _((SV* sv, MAGIC* mg));
 int    magic_set_all_env _((SV* sv, MAGIC* mg));
+U32    magic_sizepack  _((SV* sv, MAGIC* mg));
 int    magic_wipepack  _((SV* sv, MAGIC* mg));
 void   magicname _((char* sym, char* name, I32 namlen));
 int    main _((int argc, char** argv, char** env));
@@ -267,6 +268,7 @@ int mg_get _((SV* sv));
 U32    mg_len _((SV* sv));
 void   mg_magical _((SV* sv));
 int    mg_set _((SV* sv));
+I32    mg_size _((SV* sv));
 OP*    mod _((OP* o, I32 type));
 char*  moreswitches _((char* s));
 OP*    my _((OP* o));
diff --git a/sv.c b/sv.c
index d6c1039..645bbf8 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -785,7 +785,7 @@ sv_upgrade(register SV *sv, U32 mt)
            Safefree(pv);
        SvPVX(sv)       = 0;
        AvMAX(sv)       = -1;
-       AvFILL(sv)      = -1;
+       AvFILLp(sv)     = -1;
        SvIVX(sv)       = 0;
        SvNVX(sv)       = 0.0;
        SvMAGIC(sv)     = magic;
@@ -4772,7 +4772,7 @@ sv_dump(SV *sv)
     case SVt_PVAV:
        PerlIO_printf(Perl_debug_log, "  ARRAY = 0x%lx\n", (long)AvARRAY(sv));
        PerlIO_printf(Perl_debug_log, "  ALLOC = 0x%lx\n", (long)AvALLOC(sv));
-       PerlIO_printf(Perl_debug_log, "  FILL = %ld\n", (long)AvFILL(sv));
+       PerlIO_printf(Perl_debug_log, "  FILL = %ld\n", (long)AvFILLp(sv));
        PerlIO_printf(Perl_debug_log, "  MAX = %ld\n", (long)AvMAX(sv));
        PerlIO_printf(Perl_debug_log, "  ARYLEN = 0x%lx\n", (long)AvARYLEN(sv));
        flags = AvFLAGS(sv);
diff --git a/t/op/tiearray.t b/t/op/tiearray.t
new file mode 100644 (file)
index 0000000..028fe40
--- /dev/null
@@ -0,0 +1,185 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+my %seen;
+
+package Implement;
+
+sub TIEARRAY
+{
+ $seen{'TIEARRAY'}++;
+ my ($class,@val) = @_;
+ return bless \@val,$class;
+}
+
+sub STORESIZE
+{        
+ $seen{'STORESIZE'}++;
+ my ($ob,$sz) = @_; 
+ return @$ob = $sz;
+}
+
+sub EXTEND
+{        
+ $seen{'EXTEND'}++;
+ my ($ob,$sz) = @_; 
+ return @$ob = $sz;
+}
+
+sub FETCHSIZE
+{        
+ $seen{'FETCHSIZE'}++;
+ my ($ob) = @_; 
+ return @$ob-1;
+}
+
+sub FETCH
+{
+ $seen{'FETCH'}++;
+ my ($ob,$id) = @_;
+ return $ob->[$id]; 
+}
+
+sub STORE
+{
+ $seen{'STORE'}++;
+ my ($ob,$id,$val) = @_;
+ $ob->[$id] = $val; 
+}                 
+
+sub UNSHIFT
+{
+ $seen{'UNSHIFT'}++;
+ $ob = shift;
+ unshift(@$ob,@_);
+}                 
+
+sub PUSH
+{
+ $seen{'PUSH'}++;
+ my $ob = shift;;
+ push(@$ob,@_);
+}                 
+
+sub CLEAR
+{
+ $seen{'CLEAR'}++;
+}
+
+sub POP
+{
+ $seen{'POP'}++;
+ my ($ob) = @_;
+ return pop(@$ob);
+}
+
+sub SHIFT
+{
+ $seen{'SHIFT'}++;
+ my ($ob) = @_;
+ return shift(@$ob);
+}
+
+sub SPLICE
+{
+ $seen{'SPLICE'}++;
+ my $ob  = shift;                    
+ my $off = @_ ? shift : 0;
+ my $len = @_ ? shift : @$ob-1;
+ return splice(@$ob,$off,$len,@_);
+}
+
+package main;
+
+print "1..23\n";                   
+my $test = 1;
+
+{my @ary;
+
+{ my $ob = tie @ary,'Implement',3,2,1;
+  print "not " unless $ob;
+  print "ok ", $test++,"\n";
+  print "not " unless tied(@ary) == $ob;
+  print "ok ", $test++,"\n";
+}
+
+
+print "not " unless @ary == 3;
+print "ok ", $test++,"\n";
+
+print "not " unless $#ary == 2;
+print "ok ", $test++,"\n";
+
+print "not " unless join(':',@ary) eq '3:2:1';
+print "ok ", $test++,"\n";         
+
+print "not " unless $seen{'FETCH'} >= 3;
+print "ok ", $test++,"\n";
+
+@ary = (1,2,3);
+
+print "not " unless $seen{'STORE'} >= 3;
+print "ok ", $test++,"\n";
+
+print "not " unless join(':',@ary) eq '1:2:3';
+print "ok ", $test++,"\n";         
+
+print "not " unless pop(@ary) == 3;
+print "ok ", $test++,"\n";
+print "not " unless $seen{'POP'} == 1;
+print "ok ", $test++,"\n";
+print "not " unless join(':',@ary) eq '1:2';
+print "ok ", $test++,"\n";
+
+push(@ary,4);
+print "not " unless $seen{'PUSH'} == 1;
+print "ok ", $test++,"\n";
+print "not " unless join(':',@ary) eq '1:2:4';
+print "ok ", $test++,"\n";
+
+my @x = splice(@ary,1,1,7);
+
+
+print "not " unless $seen{'SPLICE'} == 1;
+print "ok ", $test++,"\n";
+
+print "not " unless @x == 1;
+print "ok ", $test++,"\n";
+print "not " unless $x[0] == 2;
+print "ok ", $test++,"\n";
+print "not " unless join(':',@ary) eq '1:7:4';
+print "ok ", $test++,"\n";             
+
+
+
+print "not " unless shift(@ary) == 1;
+print "ok ", $test++,"\n";
+print "not " unless $seen{'SHIFT'} == 1;
+print "ok ", $test++,"\n";
+print "not " unless join(':',@ary) eq '7:4';
+print "ok ", $test++,"\n";             
+
+
+unshift(@ary,5);
+print "not " unless $seen{'UNSHIFT'} == 1;
+print "ok ", $test++,"\n";
+print "not " unless join(':',@ary) eq '5:7:4';
+print "ok ", $test++,"\n";
+
+@ary = split(/:/,'1:2:3');
+print "not " unless join(':',@ary) eq '1:2:3';
+print "ok ", $test++,"\n";         
+
+untie @ary;   
+
+exit;
+
+}
+
+
+
+
diff --git a/toke.c b/toke.c
index 6773f3f..42da6a9 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1120,10 +1120,10 @@ filter_del(filter_t funcp)
 {
     if (filter_debug)
        warn("filter_del func %p", funcp);
-    if (!rsfp_filters || AvFILL(rsfp_filters)<0)
+    if (!rsfp_filters || AvFILLp(rsfp_filters)<0)
        return;
     /* if filter is on top of stack (usual case) just pop it off */
-    if (IoDIRP(FILTER_DATA(AvFILL(rsfp_filters))) == (void*)funcp){
+    if (IoDIRP(FILTER_DATA(AvFILLp(rsfp_filters))) == (void*)funcp){
        sv_free(av_pop(rsfp_filters));
 
         return;
@@ -1145,7 +1145,7 @@ filter_read(int idx, SV *buf_sv, int maxlen)
 
     if (!rsfp_filters)
        return -1;
-    if (idx > AvFILL(rsfp_filters)){       /* Any more filters?        */
+    if (idx > AvFILLp(rsfp_filters)){       /* Any more filters?       */
        /* Provide a default input filter to make life easy.    */
        /* Note that we append to the line. This is handy.      */
        if (filter_debug)
@@ -1503,7 +1503,7 @@ yylex(void)
            if (SvCUR(linestr))
                sv_catpv(linestr,";");
            if (preambleav){
-               while(AvFILL(preambleav) >= 0) {
+               while(AvFILLp(preambleav) >= 0) {
                    SV *tmpsv = av_shift(preambleav);
                    sv_catsv(linestr, tmpsv);
                    sv_catpv(linestr, ";");
index 9a86763..67f96c3 100644 (file)
@@ -48,7 +48,8 @@ isa_lookup(HV *stash, char *name, int len, int level)
        }
        if(hv) {
            SV** svp = AvARRAY(av);
-           I32 items = AvFILL(av) + 1;
+           /* NOTE: No support for tied ISA */
+           I32 items = AvFILLp(av) + 1;
            while (items--) {
                SV* sv = *svp++;
                HV* basestash = gv_stashsv(sv, FALSE);
diff --git a/util.c b/util.c
index 1c4b79a..b81a12c 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2543,7 +2543,7 @@ new_struct_thread(struct perl_thread *t)
     
     /* Initialise all per-thread SVs that the template thread used */
     svp = AvARRAY(t->threadsv);
-    for (i = 0; i <= AvFILL(t->threadsv); i++, svp++) {
+    for (i = 0; i <= AvFILLp(t->threadsv); i++, svp++) {
        if (*svp && *svp != &sv_undef) {
            SV *sv = newSVsv(*svp);
            av_store(thr->threadsv, i, sv);