X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=av.c;h=1b540656abc6ad9c0c800c7a61a2fb6de3760172;hb=c067b4bea65bd7b97b0ae4f7b058dd94b44a4c48;hp=e7e4e5e047a1b2eadb3f210e43bed298af5b6273;hpb=a3b680e6b77dd7f88268fad8b1dbdf4f641dd836;p=p5sagit%2Fp5-mst-13.2.git diff --git a/av.c b/av.c index e7e4e5e..1b54065 100644 --- a/av.c +++ b/av.c @@ -132,7 +132,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key) assert(itmp > newmax); newmax = itmp - 1; assert(newmax >= AvMAX(av)); - New(2,ary, newmax+1, SV*); + Newx(ary, newmax+1, SV*); Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*); if (AvMAX(av) > 64) offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*)); @@ -154,7 +154,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key) else { newmax = key < 3 ? 3 : key; MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend); - New(2,AvALLOC(av), newmax+1, SV*); + Newx(AvALLOC(av), newmax+1, SV*); ary = AvALLOC(av) + 1; tmp = newmax; AvALLOC(av)[0] = &PL_sv_undef; /* For the stacks */ @@ -358,7 +358,7 @@ Perl_newAV(pTHX) av = (AV*)NEWSV(3,0); sv_upgrade((SV *)av, SVt_PVAV); - AvREAL_on(av); + /* sv_upgrade does AvREAL_only() */ AvALLOC(av) = 0; SvPV_set(av, (char*)0); AvMAX(av) = AvFILLp(av) = -1; @@ -382,11 +382,11 @@ Perl_av_make(pTHX_ register I32 size, register SV **strp) av = (AV*)NEWSV(8,0); sv_upgrade((SV *) av,SVt_PVAV); - AvFLAGS(av) = AVf_REAL; - if (size) { /* `defined' was returning undef for size==0 anyway. */ + /* sv_upgrade does AvREAL_only() */ + if (size) { /* "defined" was returning undef for size==0 anyway. */ register SV** ary; register I32 i; - New(4,ary,size,SV*); + Newx(ary,size,SV*); AvALLOC(av) = ary; SvPV_set(av, (char*)ary); AvFILLp(av) = size - 1; @@ -409,10 +409,10 @@ Perl_av_fake(pTHX_ register I32 size, register SV **strp) av = (AV*)NEWSV(9,0); sv_upgrade((SV *)av, SVt_PVAV); - New(4,ary,size+1,SV*); + Newx(ary,size+1,SV*); AvALLOC(av) = ary; Copy(strp,ary,size,SV*); - AvFLAGS(av) = AVf_REIFY; + AvREIFY_only(av); SvPV_set(av, (char*)ary); AvFILLp(av) = size - 1; AvMAX(av) = size - 1; @@ -445,7 +445,6 @@ Perl_av_clear(pTHX_ register AV *av) #endif if (!av) return; - /*SUPPRESS 560*/ if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); @@ -489,7 +488,6 @@ Perl_av_undef(pTHX_ register AV *av) { if (!av) return; - /*SUPPRESS 560*/ /* Give any tie a chance to cleanup first */ if (SvTIED_mg((SV*)av, PERL_MAGIC_tied)) @@ -504,10 +502,8 @@ Perl_av_undef(pTHX_ register AV *av) AvALLOC(av) = 0; SvPV_set(av, (char*)0); AvMAX(av) = AvFILLp(av) = -1; - if (AvARYLEN(av)) { - SvREFCNT_dec(AvARYLEN(av)); - AvARYLEN(av) = 0; - } + /* It's in magic - it must already be gone. */ + assert (!AvARYLEN(av)); } /* @@ -936,6 +932,24 @@ Perl_av_exists(pTHX_ AV *av, I32 key) return FALSE; } +SV ** +Perl_av_arylen_p(pTHX_ AV *av) { + dVAR; + MAGIC *mg = mg_find((SV*)av, PERL_MAGIC_arylen_p); + + if (!mg) { + mg = sv_magicext((SV*)av, 0, PERL_MAGIC_arylen_p, &PL_vtbl_arylen_p, + 0, 0); + + if (!mg) { + Perl_die(aTHX_ "panic: av_arylen_p"); + } + /* sv_magicext won't set this for us because we pass in a NULL obj */ + mg->mg_flags |= MGf_REFCOUNTED; + } + return &(mg->mg_obj); +} + /* * Local variables: * c-indentation-style: bsd