diff options
| -rw-r--r-- | MANIFEST | 2 | ||||
| -rw-r--r-- | av.c | 190 | ||||
| -rw-r--r-- | av.h | 12 | ||||
| -rw-r--r-- | deb.c | 2 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | ext/DB_File/DB_File.pm | 10 | ||||
| -rw-r--r-- | global.sym | 2 | ||||
| -rw-r--r-- | gv.c | 6 | ||||
| -rw-r--r-- | mg.c | 119 | ||||
| -rw-r--r-- | op.c | 38 | ||||
| -rw-r--r-- | perl.c | 2 | ||||
| -rw-r--r-- | perl.h | 4 | ||||
| -rw-r--r-- | pp.c | 71 | ||||
| -rw-r--r-- | pp.h | 4 | ||||
| -rw-r--r-- | pp_ctl.c | 26 | ||||
| -rw-r--r-- | pp_hot.c | 29 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rw-r--r-- | sv.c | 4 | ||||
| -rw-r--r-- | t/op/tiearray.t | 185 | ||||
| -rw-r--r-- | toke.c | 8 | ||||
| -rw-r--r-- | universal.c | 3 | ||||
| -rw-r--r-- | util.c | 2 |
22 files changed, 565 insertions, 158 deletions
@@ -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 @@ -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); } @@ -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)) @@ -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; } @@ -314,6 +314,7 @@ #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 @@ -327,6 +328,7 @@ #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 diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index d08b21ceab..4e7f0c696a 100644 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@ -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); diff --git a/global.sym b/global.sym index 969f752ab6..979f8d1818 100644 --- a/global.sym +++ b/global.sym @@ -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 @@ -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)); @@ -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]) { @@ -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]); } @@ -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); @@ -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, @@ -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); @@ -154,10 +154,10 @@ #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) \ @@ -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); @@ -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) @@ -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)); @@ -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 index 0000000000..028fe40c60 --- /dev/null +++ b/t/op/tiearray.t @@ -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; + +} + + + + @@ -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, ";"); diff --git a/universal.c b/universal.c index 9a867631d0..67f96c381b 100644 --- a/universal.c +++ b/universal.c @@ -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); @@ -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); |