X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=av.c;h=4d73e4094626c2876743416db00f14c67efbd61e;hb=9cffef09bb5dd26e11c82b982f4e8d8597449682;hp=086c75e56feb3c817fd152d69dc4ce4436c3f214;hpb=14befaf4eaa6e79d87aacb106e0b701e925483ee;p=p5sagit%2Fp5-mst-13.2.git diff --git a/av.c b/av.c index 086c75e..4d73e40 100644 --- a/av.c +++ b/av.c @@ -1,6 +1,6 @@ /* av.c * - * Copyright (c) 1991-2001, Larry Wall + * Copyright (c) 1991-2002, 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. @@ -12,6 +12,10 @@ * meant that things should remain where they had set them)." --Treebeard */ +/* +=head1 Array Manipulation Functions +*/ + #include "EXTERN.h" #define PERL_IN_AV_C #include "perl.h" @@ -26,7 +30,7 @@ Perl_av_reify(pTHX_ AV *av) return; #ifdef DEBUGGING if (SvTIED_mg((SV*)av, PERL_MAGIC_tied) && ckWARN_d(WARN_DEBUGGING)) - Perl_warner(aTHX_ WARN_DEBUGGING, "av_reify called on tied array"); + Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array"); #endif key = AvMAX(av) + 1; while (key > AvFILLp(av) + 1) @@ -96,7 +100,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key) } else { if (AvALLOC(av)) { -#ifndef STRANGE_MALLOC +#if !defined(STRANGE_MALLOC) && !defined(MYMALLOC) MEM_SIZE bytes; IV itmp; #endif @@ -115,7 +119,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key) bytes = (newmax + 1) * sizeof(SV*); #define MALLOC_OVERHEAD 16 itmp = MALLOC_OVERHEAD; - while (itmp - MALLOC_OVERHEAD < bytes) + while ((MEM_SIZE)(itmp - MALLOC_OVERHEAD) < bytes) itmp += itmp; itmp -= MALLOC_OVERHEAD; itmp /= sizeof(SV*); @@ -130,7 +134,9 @@ Perl_av_extend(pTHX_ AV *av, I32 key) Safefree(AvALLOC(av)); AvALLOC(av) = ary; #endif +#if defined(MYMALLOC) && !defined(LEAKTEST) resized: +#endif ary = AvALLOC(av) + AvMAX(av) + 1; tmp = newmax - AvMAX(av); if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */ @@ -389,7 +395,7 @@ Perl_av_clear(pTHX_ register AV *av) #ifdef DEBUGGING if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) { - Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array"); + Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array"); } #endif if (!av) @@ -508,8 +514,8 @@ Perl_av_pop(pTHX_ register AV *av) SV *retval; MAGIC* mg; - if (!av || AvFILL(av) < 0) - return &PL_sv_undef; + if (!av) + return &PL_sv_undef; if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) { @@ -528,6 +534,8 @@ Perl_av_pop(pTHX_ register AV *av) POPSTACK; return retval; } + if (AvFILL(av) < 0) + return &PL_sv_undef; retval = AvARRAY(av)[AvFILLp(av)]; AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef; if (SvSMAGICAL(av)) @@ -553,7 +561,7 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num) MAGIC* mg; I32 slide; - if (!av || num <= 0) + if (!av) return; if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); @@ -575,6 +583,8 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num) return; } + if (num <= 0) + return; if (!AvREAL(av) && AvREIFY(av)) av_reify(av); i = AvARRAY(av) - AvALLOC(av); @@ -620,7 +630,7 @@ Perl_av_shift(pTHX_ register AV *av) SV *retval; MAGIC* mg; - if (!av || AvFILL(av) < 0) + if (!av) return &PL_sv_undef; if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); @@ -640,6 +650,8 @@ Perl_av_shift(pTHX_ register AV *av) POPSTACK; return retval; } + if (AvFILL(av) < 0) + return &PL_sv_undef; retval = *AvARRAY(av); if (AvREAL(av)) *AvARRAY(av) = &PL_sv_undef; @@ -763,6 +775,7 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags) else { sv = AvARRAY(av)[key]; if (key == AvFILLp(av)) { + AvARRAY(av)[key] = &PL_sv_undef; do { AvFILLp(av)--; } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef); @@ -810,7 +823,7 @@ Perl_av_exists(pTHX_ AV *av, I32 key) mg = mg_find(sv, PERL_MAGIC_tiedelem); if (mg) { magic_existspack(sv, mg); - return SvTRUE(sv); + return (bool)SvTRUE(sv); } } }