if (AvREAL(av))
return;
#ifdef DEBUGGING
- if (SvTIED_mg((SV*)av, 'P'))
- warn("av_reify called on tied array");
+ if (SvTIED_mg((SV*)av, 'P') && ckWARN_d(WARN_DEBUGGING))
+ Perl_warner(aTHX_ WARN_DEBUGGING, "av_reify called on tied array");
#endif
key = AvMAX(av) + 1;
while (key > AvFILLp(av) + 1)
else {
if (AvALLOC(av)) {
#ifndef STRANGE_MALLOC
- U32 bytes;
+ MEM_SIZE bytes;
+ IV itmp;
#endif
#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST)
#else
bytes = (newmax + 1) * sizeof(SV*);
#define MALLOC_OVERHEAD 16
- tmp = MALLOC_OVERHEAD;
- while (tmp - MALLOC_OVERHEAD < bytes)
- tmp += tmp;
- tmp -= MALLOC_OVERHEAD;
- tmp /= sizeof(SV*);
- assert(tmp > newmax);
- newmax = tmp - 1;
+ itmp = MALLOC_OVERHEAD;
+ while (itmp - MALLOC_OVERHEAD < bytes)
+ itmp += itmp;
+ itmp -= MALLOC_OVERHEAD;
+ itmp /= sizeof(SV*);
+ assert(itmp > newmax);
+ newmax = itmp - 1;
+ assert(newmax >= AvMAX(av));
New(2,ary, newmax+1, SV*);
Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
if (AvMAX(av) > 64)
}
if (SvREADONLY(av) && key >= AvFILL(av))
- croak(PL_no_modify);
+ Perl_croak(aTHX_ PL_no_modify);
if (SvRMAGICAL(av)) {
if (mg_find((SV*)av,'P')) {
SV** ary;
#ifdef DEBUGGING
- if (SvREFCNT(av) <= 0) {
- warn("Attempt to clear deleted array");
+ if (SvREFCNT(av) <= 0 && ckWARN_d(WARN_DEBUGGING)) {
+ Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array");
}
#endif
if (!av)
/*SUPPRESS 560*/
if (SvREADONLY(av))
- croak(PL_no_modify);
+ Perl_croak(aTHX_ PL_no_modify);
/* Give any tie a chance to cleanup first */
if (SvRMAGICAL(av))
if (!av)
return;
if (SvREADONLY(av))
- croak(PL_no_modify);
+ Perl_croak(aTHX_ PL_no_modify);
if (mg = SvTIED_mg((SV*)av, 'P')) {
dSP;
if (!av || AvFILL(av) < 0)
return &PL_sv_undef;
if (SvREADONLY(av))
- croak(PL_no_modify);
+ Perl_croak(aTHX_ PL_no_modify);
if (mg = SvTIED_mg((SV*)av, 'P')) {
dSP;
PUSHSTACKi(PERLSI_MAGIC);
if (!av || num <= 0)
return;
if (SvREADONLY(av))
- croak(PL_no_modify);
+ Perl_croak(aTHX_ PL_no_modify);
if (mg = SvTIED_mg((SV*)av, 'P')) {
dSP;
if (!av || AvFILL(av) < 0)
return &PL_sv_undef;
if (SvREADONLY(av))
- croak(PL_no_modify);
+ Perl_croak(aTHX_ PL_no_modify);
if (mg = SvTIED_mg((SV*)av, 'P')) {
dSP;
PUSHSTACKi(PERLSI_MAGIC);
{
MAGIC *mg;
if (!av)
- croak("panic: null array");
+ Perl_croak(aTHX_ "panic: null array");
if (fill < 0)
fill = -1;
if (mg = SvTIED_mg((SV*)av, 'P')) {
*/
STATIC I32
-avhv_index_sv(pTHX_ SV* sv)
+S_avhv_index_sv(pTHX_ SV* sv)
{
I32 index = SvIV(sv);
if (index < 1)
- croak("Bad index while coercing array into hash");
+ Perl_croak(aTHX_ "Bad index while coercing array into hash");
return index;
}
return (HV*)sv;
}
}
- croak("Can't coerce array into hash");
+ Perl_croak(aTHX_ "Can't coerce array into hash");
return Nullhv;
}
SV **indsvp;
HV *keys = avhv_keys(av);
HE *he;
-
+ STRLEN n_a;
+
he = hv_fetch_ent(keys, keysv, FALSE, hash);
if (!he)
- croak("No such array field");
+ Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a));
return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
}
+/* Check for the existence of an element named by a given key.
+ *
+ * This relies on the fact that uninitialized array elements
+ * are set to &PL_sv_undef.
+ */
bool
Perl_avhv_exists_ent(pTHX_ AV *av, SV *keysv, U32 hash)
{
HV *keys = avhv_keys(av);
- return hv_exists_ent(keys, keysv, hash);
+ HE *he;
+ IV ix;
+
+ he = hv_fetch_ent(keys, keysv, FALSE, hash);
+ if (!he || !SvOK(HeVAL(he)))
+ return FALSE;
+
+ ix = SvIV(HeVAL(he));
+
+ /* If the array hasn't been extended to reach the key yet then
+ * it hasn't been accessed and thus does not exist. We use
+ * AvFILL() rather than AvFILLp() to handle tied av. */
+ if (ix > 0 && ix <= AvFILL(av)
+ && (SvRMAGICAL(av)
+ || (AvARRAY(av)[ix] && AvARRAY(av)[ix] != &PL_sv_undef)))
+ {
+ return TRUE;
+ }
+ return FALSE;
}
HE *