severe bugs in change#3786 fixed
[p5sagit/p5-mst-13.2.git] / av.c
CommitLineData
a0d0e21e 1/* av.c
79072805 2 *
4eb8286e 3 * Copyright (c) 1991-1999, Larry Wall
79072805 4 *
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
7 *
a0d0e21e 8 */
9
10/*
11 * "...for the Entwives desired order, and plenty, and peace (by which they
12 * meant that things should remain where they had set them)." --Treebeard
79072805 13 */
14
15#include "EXTERN.h"
864dbfa3 16#define PERL_IN_AV_C
79072805 17#include "perl.h"
18
fb73857a 19void
864dbfa3 20Perl_av_reify(pTHX_ AV *av)
a0d0e21e 21{
22 I32 key;
23 SV* sv;
fb73857a 24
3c78fafa 25 if (AvREAL(av))
26 return;
93965878 27#ifdef DEBUGGING
0453d815 28 if (SvTIED_mg((SV*)av, 'P') && ckWARN_d(WARN_DEBUGGING))
29 Perl_warner(aTHX_ WARN_DEBUGGING, "av_reify called on tied array");
93965878 30#endif
a0d0e21e 31 key = AvMAX(av) + 1;
93965878 32 while (key > AvFILLp(av) + 1)
3280af22 33 AvARRAY(av)[--key] = &PL_sv_undef;
a0d0e21e 34 while (key) {
35 sv = AvARRAY(av)[--key];
36 assert(sv);
3280af22 37 if (sv != &PL_sv_undef) {
11343788 38 dTHR;
a0d0e21e 39 (void)SvREFCNT_inc(sv);
11343788 40 }
a0d0e21e 41 }
29de640a 42 key = AvARRAY(av) - AvALLOC(av);
43 while (key)
3280af22 44 AvALLOC(av)[--key] = &PL_sv_undef;
62b1ebc2 45 AvREIFY_off(av);
a0d0e21e 46 AvREAL_on(av);
47}
48
49void
864dbfa3 50Perl_av_extend(pTHX_ AV *av, I32 key)
a0d0e21e 51{
11343788 52 dTHR; /* only necessary if we have to extend stack */
93965878 53 MAGIC *mg;
33c27489 54 if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 55 dSP;
56 ENTER;
57 SAVETMPS;
e788e7d3 58 PUSHSTACKi(PERLSI_MAGIC);
924508f0 59 PUSHMARK(SP);
60 EXTEND(SP,2);
33c27489 61 PUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 62 PUSHs(sv_2mortal(newSViv(key+1)));
93965878 63 PUTBACK;
864dbfa3 64 call_method("EXTEND", G_SCALAR|G_DISCARD);
d3acc0f7 65 POPSTACK;
93965878 66 FREETMPS;
67 LEAVE;
68 return;
69 }
a0d0e21e 70 if (key > AvMAX(av)) {
71 SV** ary;
72 I32 tmp;
73 I32 newmax;
74
75 if (AvALLOC(av) != AvARRAY(av)) {
93965878 76 ary = AvALLOC(av) + AvFILLp(av) + 1;
a0d0e21e 77 tmp = AvARRAY(av) - AvALLOC(av);
93965878 78 Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
a0d0e21e 79 AvMAX(av) += tmp;
80 SvPVX(av) = (char*)AvALLOC(av);
81 if (AvREAL(av)) {
82 while (tmp)
3280af22 83 ary[--tmp] = &PL_sv_undef;
a0d0e21e 84 }
85
86 if (key > AvMAX(av) - 10) {
87 newmax = key + AvMAX(av);
88 goto resize;
89 }
90 }
91 else {
92 if (AvALLOC(av)) {
c07a80fd 93#ifndef STRANGE_MALLOC
c1f7b11a 94 MEM_SIZE bytes;
95 IV itmp;
c07a80fd 96#endif
4633a7c4 97
1fe09876 98#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST)
8d6dde3e 99 newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
100
101 if (key <= newmax)
102 goto resized;
103#endif
a0d0e21e 104 newmax = key + AvMAX(av) / 5;
105 resize:
8d6dde3e 106#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
a0d0e21e 107 Renew(AvALLOC(av),newmax+1, SV*);
4633a7c4 108#else
109 bytes = (newmax + 1) * sizeof(SV*);
110#define MALLOC_OVERHEAD 16
c1f7b11a 111 itmp = MALLOC_OVERHEAD;
112 while (itmp - MALLOC_OVERHEAD < bytes)
113 itmp += itmp;
114 itmp -= MALLOC_OVERHEAD;
115 itmp /= sizeof(SV*);
116 assert(itmp > newmax);
117 newmax = itmp - 1;
118 assert(newmax >= AvMAX(av));
4633a7c4 119 New(2,ary, newmax+1, SV*);
120 Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
fba3b22e 121 if (AvMAX(av) > 64)
122 offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
4633a7c4 123 else
124 Safefree(AvALLOC(av));
125 AvALLOC(av) = ary;
126#endif
8d6dde3e 127 resized:
a0d0e21e 128 ary = AvALLOC(av) + AvMAX(av) + 1;
129 tmp = newmax - AvMAX(av);
3280af22 130 if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */
131 PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
132 PL_stack_base = AvALLOC(av);
133 PL_stack_max = PL_stack_base + newmax;
a0d0e21e 134 }
135 }
136 else {
8d6dde3e 137 newmax = key < 3 ? 3 : key;
a0d0e21e 138 New(2,AvALLOC(av), newmax+1, SV*);
139 ary = AvALLOC(av) + 1;
140 tmp = newmax;
3280af22 141 AvALLOC(av)[0] = &PL_sv_undef; /* For the stacks */
a0d0e21e 142 }
143 if (AvREAL(av)) {
144 while (tmp)
3280af22 145 ary[--tmp] = &PL_sv_undef;
a0d0e21e 146 }
147
148 SvPVX(av) = (char*)AvALLOC(av);
149 AvMAX(av) = newmax;
150 }
151 }
152}
153
79072805 154SV**
864dbfa3 155Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
79072805 156{
157 SV *sv;
158
a0d0e21e 159 if (!av)
160 return 0;
161
93965878 162 if (key < 0) {
163 key += AvFILL(av) + 1;
164 if (key < 0)
165 return 0;
166 }
167
8990e307 168 if (SvRMAGICAL(av)) {
6cef1e77 169 if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) {
11343788 170 dTHR;
8990e307 171 sv = sv_newmortal();
463ee0b2 172 mg_copy((SV*)av, sv, 0, key);
3280af22 173 PL_av_fetch_sv = sv;
174 return &PL_av_fetch_sv;
463ee0b2 175 }
176 }
177
93965878 178 if (key > AvFILLp(av)) {
a0d0e21e 179 if (!lval)
180 return 0;
352edd90 181 sv = NEWSV(5,0);
a0d0e21e 182 return av_store(av,key,sv);
79072805 183 }
3280af22 184 if (AvARRAY(av)[key] == &PL_sv_undef) {
4dbf4341 185 emptyness:
79072805 186 if (lval) {
187 sv = NEWSV(6,0);
463ee0b2 188 return av_store(av,key,sv);
79072805 189 }
190 return 0;
191 }
4dbf4341 192 else if (AvREIFY(av)
193 && (!AvARRAY(av)[key] /* eg. @_ could have freed elts */
194 || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
3280af22 195 AvARRAY(av)[key] = &PL_sv_undef; /* 1/2 reify */
4dbf4341 196 goto emptyness;
197 }
463ee0b2 198 return &AvARRAY(av)[key];
79072805 199}
200
201SV**
864dbfa3 202Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
79072805 203{
79072805 204 SV** ary;
93965878 205 U32 fill;
206
79072805 207
a0d0e21e 208 if (!av)
209 return 0;
43fcc5d2 210 if (!val)
3280af22 211 val = &PL_sv_undef;
463ee0b2 212
a0d0e21e 213 if (key < 0) {
214 key += AvFILL(av) + 1;
215 if (key < 0)
216 return 0;
79072805 217 }
93965878 218
43fcc5d2 219 if (SvREADONLY(av) && key >= AvFILL(av))
cea2e8a9 220 Perl_croak(aTHX_ PL_no_modify);
93965878 221
222 if (SvRMAGICAL(av)) {
223 if (mg_find((SV*)av,'P')) {
3280af22 224 if (val != &PL_sv_undef) {
93965878 225 mg_copy((SV*)av, val, 0, key);
226 }
227 return 0;
228 }
229 }
230
49beac48 231 if (!AvREAL(av) && AvREIFY(av))
a0d0e21e 232 av_reify(av);
a0d0e21e 233 if (key > AvMAX(av))
234 av_extend(av,key);
463ee0b2 235 ary = AvARRAY(av);
93965878 236 if (AvFILLp(av) < key) {
a0d0e21e 237 if (!AvREAL(av)) {
11343788 238 dTHR;
3280af22 239 if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
240 PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
a0d0e21e 241 do
3280af22 242 ary[++AvFILLp(av)] = &PL_sv_undef;
93965878 243 while (AvFILLp(av) < key);
79072805 244 }
93965878 245 AvFILLp(av) = key;
79072805 246 }
a0d0e21e 247 else if (AvREAL(av))
248 SvREFCNT_dec(ary[key]);
79072805 249 ary[key] = val;
8990e307 250 if (SvSMAGICAL(av)) {
3280af22 251 if (val != &PL_sv_undef) {
a0d0e21e 252 MAGIC* mg = SvMAGIC(av);
253 sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
254 }
463ee0b2 255 mg_set((SV*)av);
256 }
79072805 257 return &ary[key];
258}
259
260AV *
864dbfa3 261Perl_newAV(pTHX)
79072805 262{
463ee0b2 263 register AV *av;
79072805 264
a0d0e21e 265 av = (AV*)NEWSV(3,0);
266 sv_upgrade((SV *)av, SVt_PVAV);
463ee0b2 267 AvREAL_on(av);
268 AvALLOC(av) = 0;
269 SvPVX(av) = 0;
93965878 270 AvMAX(av) = AvFILLp(av) = -1;
463ee0b2 271 return av;
79072805 272}
273
274AV *
864dbfa3 275Perl_av_make(pTHX_ register I32 size, register SV **strp)
79072805 276{
463ee0b2 277 register AV *av;
79072805 278 register I32 i;
279 register SV** ary;
280
a0d0e21e 281 av = (AV*)NEWSV(8,0);
282 sv_upgrade((SV *) av,SVt_PVAV);
a0d0e21e 283 AvFLAGS(av) = AVf_REAL;
573fa4ea 284 if (size) { /* `defined' was returning undef for size==0 anyway. */
285 New(4,ary,size,SV*);
286 AvALLOC(av) = ary;
287 SvPVX(av) = (char*)ary;
93965878 288 AvFILLp(av) = size - 1;
573fa4ea 289 AvMAX(av) = size - 1;
290 for (i = 0; i < size; i++) {
291 assert (*strp);
292 ary[i] = NEWSV(7,0);
293 sv_setsv(ary[i], *strp);
294 strp++;
295 }
79072805 296 }
463ee0b2 297 return av;
79072805 298}
299
300AV *
864dbfa3 301Perl_av_fake(pTHX_ register I32 size, register SV **strp)
79072805 302{
463ee0b2 303 register AV *av;
79072805 304 register SV** ary;
305
a0d0e21e 306 av = (AV*)NEWSV(9,0);
307 sv_upgrade((SV *)av, SVt_PVAV);
79072805 308 New(4,ary,size+1,SV*);
463ee0b2 309 AvALLOC(av) = ary;
79072805 310 Copy(strp,ary,size,SV*);
a0d0e21e 311 AvFLAGS(av) = AVf_REIFY;
463ee0b2 312 SvPVX(av) = (char*)ary;
93965878 313 AvFILLp(av) = size - 1;
463ee0b2 314 AvMAX(av) = size - 1;
79072805 315 while (size--) {
a0d0e21e 316 assert (*strp);
317 SvTEMP_off(*strp);
79072805 318 strp++;
319 }
463ee0b2 320 return av;
79072805 321}
322
323void
864dbfa3 324Perl_av_clear(pTHX_ register AV *av)
79072805 325{
326 register I32 key;
a0d0e21e 327 SV** ary;
79072805 328
7d55f622 329#ifdef DEBUGGING
0453d815 330 if (SvREFCNT(av) <= 0 && ckWARN_d(WARN_DEBUGGING)) {
331 Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array");
7d55f622 332 }
333#endif
a60c0954 334 if (!av)
79072805 335 return;
336 /*SUPPRESS 560*/
a0d0e21e 337
39caa665 338 if (SvREADONLY(av))
cea2e8a9 339 Perl_croak(aTHX_ PL_no_modify);
39caa665 340
93965878 341 /* Give any tie a chance to cleanup first */
342 if (SvRMAGICAL(av))
343 mg_clear((SV*)av);
344
a60c0954 345 if (AvMAX(av) < 0)
346 return;
347
a0d0e21e 348 if (AvREAL(av)) {
349 ary = AvARRAY(av);
93965878 350 key = AvFILLp(av) + 1;
a0d0e21e 351 while (key) {
352 SvREFCNT_dec(ary[--key]);
3280af22 353 ary[key] = &PL_sv_undef;
a0d0e21e 354 }
355 }
463ee0b2 356 if (key = AvARRAY(av) - AvALLOC(av)) {
357 AvMAX(av) += key;
a0d0e21e 358 SvPVX(av) = (char*)AvALLOC(av);
79072805 359 }
93965878 360 AvFILLp(av) = -1;
fb73857a 361
79072805 362}
363
364void
864dbfa3 365Perl_av_undef(pTHX_ register AV *av)
79072805 366{
367 register I32 key;
368
463ee0b2 369 if (!av)
79072805 370 return;
371 /*SUPPRESS 560*/
93965878 372
373 /* Give any tie a chance to cleanup first */
33c27489 374 if (SvTIED_mg((SV*)av, 'P'))
93965878 375 av_fill(av, -1); /* mg_clear() ? */
376
a0d0e21e 377 if (AvREAL(av)) {
93965878 378 key = AvFILLp(av) + 1;
a0d0e21e 379 while (key)
380 SvREFCNT_dec(AvARRAY(av)[--key]);
381 }
463ee0b2 382 Safefree(AvALLOC(av));
383 AvALLOC(av) = 0;
384 SvPVX(av) = 0;
93965878 385 AvMAX(av) = AvFILLp(av) = -1;
748a9306 386 if (AvARYLEN(av)) {
387 SvREFCNT_dec(AvARYLEN(av));
388 AvARYLEN(av) = 0;
389 }
79072805 390}
391
a0d0e21e 392void
864dbfa3 393Perl_av_push(pTHX_ register AV *av, SV *val)
93965878 394{
395 MAGIC *mg;
a0d0e21e 396 if (!av)
397 return;
93965878 398 if (SvREADONLY(av))
cea2e8a9 399 Perl_croak(aTHX_ PL_no_modify);
93965878 400
33c27489 401 if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 402 dSP;
e788e7d3 403 PUSHSTACKi(PERLSI_MAGIC);
924508f0 404 PUSHMARK(SP);
405 EXTEND(SP,2);
33c27489 406 PUSHs(SvTIED_obj((SV*)av, mg));
93965878 407 PUSHs(val);
a60c0954 408 PUTBACK;
409 ENTER;
864dbfa3 410 call_method("PUSH", G_SCALAR|G_DISCARD);
a60c0954 411 LEAVE;
d3acc0f7 412 POPSTACK;
93965878 413 return;
414 }
415 av_store(av,AvFILLp(av)+1,val);
79072805 416}
417
418SV *
864dbfa3 419Perl_av_pop(pTHX_ register AV *av)
79072805 420{
421 SV *retval;
93965878 422 MAGIC* mg;
79072805 423
a0d0e21e 424 if (!av || AvFILL(av) < 0)
3280af22 425 return &PL_sv_undef;
43fcc5d2 426 if (SvREADONLY(av))
cea2e8a9 427 Perl_croak(aTHX_ PL_no_modify);
33c27489 428 if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 429 dSP;
e788e7d3 430 PUSHSTACKi(PERLSI_MAGIC);
924508f0 431 PUSHMARK(SP);
33c27489 432 XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 433 PUTBACK;
434 ENTER;
864dbfa3 435 if (call_method("POP", G_SCALAR)) {
3280af22 436 retval = newSVsv(*PL_stack_sp--);
93965878 437 } else {
3280af22 438 retval = &PL_sv_undef;
93965878 439 }
a60c0954 440 LEAVE;
d3acc0f7 441 POPSTACK;
93965878 442 return retval;
443 }
444 retval = AvARRAY(av)[AvFILLp(av)];
3280af22 445 AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
8990e307 446 if (SvSMAGICAL(av))
463ee0b2 447 mg_set((SV*)av);
79072805 448 return retval;
449}
450
451void
864dbfa3 452Perl_av_unshift(pTHX_ register AV *av, register I32 num)
79072805 453{
454 register I32 i;
67a38de0 455 register SV **ary;
93965878 456 MAGIC* mg;
79072805 457
a0d0e21e 458 if (!av || num <= 0)
79072805 459 return;
43fcc5d2 460 if (SvREADONLY(av))
cea2e8a9 461 Perl_croak(aTHX_ PL_no_modify);
93965878 462
33c27489 463 if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 464 dSP;
e788e7d3 465 PUSHSTACKi(PERLSI_MAGIC);
924508f0 466 PUSHMARK(SP);
467 EXTEND(SP,1+num);
33c27489 468 PUSHs(SvTIED_obj((SV*)av, mg));
93965878 469 while (num-- > 0) {
3280af22 470 PUSHs(&PL_sv_undef);
93965878 471 }
472 PUTBACK;
a60c0954 473 ENTER;
864dbfa3 474 call_method("UNSHIFT", G_SCALAR|G_DISCARD);
a60c0954 475 LEAVE;
d3acc0f7 476 POPSTACK;
93965878 477 return;
478 }
479
49beac48 480 if (!AvREAL(av) && AvREIFY(av))
481 av_reify(av);
a0d0e21e 482 i = AvARRAY(av) - AvALLOC(av);
483 if (i) {
484 if (i > num)
485 i = num;
486 num -= i;
487
488 AvMAX(av) += i;
93965878 489 AvFILLp(av) += i;
a0d0e21e 490 SvPVX(av) = (char*)(AvARRAY(av) - i);
491 }
d2719217 492 if (num) {
67a38de0 493 i = AvFILLp(av);
494 av_extend(av, i + num);
93965878 495 AvFILLp(av) += num;
67a38de0 496 ary = AvARRAY(av);
497 Move(ary, ary + num, i + 1, SV*);
498 do {
3280af22 499 ary[--num] = &PL_sv_undef;
67a38de0 500 } while (num);
79072805 501 }
502}
503
504SV *
864dbfa3 505Perl_av_shift(pTHX_ register AV *av)
79072805 506{
507 SV *retval;
93965878 508 MAGIC* mg;
79072805 509
a0d0e21e 510 if (!av || AvFILL(av) < 0)
3280af22 511 return &PL_sv_undef;
43fcc5d2 512 if (SvREADONLY(av))
cea2e8a9 513 Perl_croak(aTHX_ PL_no_modify);
33c27489 514 if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 515 dSP;
e788e7d3 516 PUSHSTACKi(PERLSI_MAGIC);
924508f0 517 PUSHMARK(SP);
33c27489 518 XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 519 PUTBACK;
520 ENTER;
864dbfa3 521 if (call_method("SHIFT", G_SCALAR)) {
3280af22 522 retval = newSVsv(*PL_stack_sp--);
93965878 523 } else {
3280af22 524 retval = &PL_sv_undef;
a60c0954 525 }
526 LEAVE;
d3acc0f7 527 POPSTACK;
93965878 528 return retval;
529 }
463ee0b2 530 retval = *AvARRAY(av);
a0d0e21e 531 if (AvREAL(av))
3280af22 532 *AvARRAY(av) = &PL_sv_undef;
463ee0b2 533 SvPVX(av) = (char*)(AvARRAY(av) + 1);
534 AvMAX(av)--;
93965878 535 AvFILLp(av)--;
8990e307 536 if (SvSMAGICAL(av))
463ee0b2 537 mg_set((SV*)av);
79072805 538 return retval;
539}
540
541I32
864dbfa3 542Perl_av_len(pTHX_ register AV *av)
79072805 543{
463ee0b2 544 return AvFILL(av);
79072805 545}
546
547void
864dbfa3 548Perl_av_fill(pTHX_ register AV *av, I32 fill)
79072805 549{
93965878 550 MAGIC *mg;
a0d0e21e 551 if (!av)
cea2e8a9 552 Perl_croak(aTHX_ "panic: null array");
79072805 553 if (fill < 0)
554 fill = -1;
33c27489 555 if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 556 dSP;
557 ENTER;
558 SAVETMPS;
e788e7d3 559 PUSHSTACKi(PERLSI_MAGIC);
924508f0 560 PUSHMARK(SP);
561 EXTEND(SP,2);
33c27489 562 PUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 563 PUSHs(sv_2mortal(newSViv(fill+1)));
93965878 564 PUTBACK;
864dbfa3 565 call_method("STORESIZE", G_SCALAR|G_DISCARD);
d3acc0f7 566 POPSTACK;
93965878 567 FREETMPS;
568 LEAVE;
569 return;
570 }
463ee0b2 571 if (fill <= AvMAX(av)) {
93965878 572 I32 key = AvFILLp(av);
a0d0e21e 573 SV** ary = AvARRAY(av);
574
575 if (AvREAL(av)) {
576 while (key > fill) {
577 SvREFCNT_dec(ary[key]);
3280af22 578 ary[key--] = &PL_sv_undef;
a0d0e21e 579 }
580 }
581 else {
582 while (key < fill)
3280af22 583 ary[++key] = &PL_sv_undef;
a0d0e21e 584 }
585
93965878 586 AvFILLp(av) = fill;
8990e307 587 if (SvSMAGICAL(av))
463ee0b2 588 mg_set((SV*)av);
589 }
a0d0e21e 590 else
3280af22 591 (void)av_store(av,fill,&PL_sv_undef);
79072805 592}
c750a3ec 593
57079c46 594
595/* AVHV: Support for treating arrays as if they were hashes. The
596 * first element of the array should be a hash reference that maps
597 * hash keys to array indices.
598 */
599
72311751 600STATIC I32
cea2e8a9 601S_avhv_index_sv(pTHX_ SV* sv)
57079c46 602{
603 I32 index = SvIV(sv);
604 if (index < 1)
cea2e8a9 605 Perl_croak(aTHX_ "Bad index while coercing array into hash");
57079c46 606 return index;
607}
608
5d5aaa5e 609HV*
864dbfa3 610Perl_avhv_keys(pTHX_ AV *av)
5d5aaa5e 611{
57079c46 612 SV **keysp = av_fetch(av, 0, FALSE);
5d5aaa5e 613 if (keysp) {
d627ae4e 614 SV *sv = *keysp;
615 if (SvGMAGICAL(sv))
616 mg_get(sv);
617 if (SvROK(sv)) {
618 sv = SvRV(sv);
619 if (SvTYPE(sv) == SVt_PVHV)
57079c46 620 return (HV*)sv;
5d5aaa5e 621 }
622 }
cea2e8a9 623 Perl_croak(aTHX_ "Can't coerce array into hash");
72311751 624 return Nullhv;
c750a3ec 625}
626
627SV**
864dbfa3 628Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
97fcbf96 629{
5d5aaa5e 630 SV **indsvp;
631 HV *keys = avhv_keys(av);
97fcbf96 632 HE *he;
ab612ae3 633 STRLEN n_a;
634
5d5aaa5e 635 he = hv_fetch_ent(keys, keysv, FALSE, hash);
57079c46 636 if (!he)
88e9b055 637 Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a));
57079c46 638 return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
5bc6513d 639}
640
4bd46447 641/* Check for the existence of an element named by a given key.
642 *
643 * This relies on the fact that uninitialized array elements
644 * are set to &PL_sv_undef.
645 */
c750a3ec 646bool
864dbfa3 647Perl_avhv_exists_ent(pTHX_ AV *av, SV *keysv, U32 hash)
97fcbf96 648{
5d5aaa5e 649 HV *keys = avhv_keys(av);
4bd46447 650 HE *he;
651 IV ix;
652
653 he = hv_fetch_ent(keys, keysv, FALSE, hash);
654 if (!he || !SvOK(HeVAL(he)))
655 return FALSE;
656
657 ix = SvIV(HeVAL(he));
658
659 /* If the array hasn't been extended to reach the key yet then
660 * it hasn't been accessed and thus does not exist. We use
661 * AvFILL() rather than AvFILLp() to handle tied av. */
662 if (ix > 0 && ix <= AvFILL(av)
663 && (SvRMAGICAL(av)
664 || (AvARRAY(av)[ix] && AvARRAY(av)[ix] != &PL_sv_undef)))
665 {
666 return TRUE;
667 }
668 return FALSE;
97fcbf96 669}
670
c750a3ec 671HE *
864dbfa3 672Perl_avhv_iternext(pTHX_ AV *av)
c750a3ec 673{
5d5aaa5e 674 HV *keys = avhv_keys(av);
675 return hv_iternext(keys);
c750a3ec 676}
677
678SV *
864dbfa3 679Perl_avhv_iterval(pTHX_ AV *av, register HE *entry)
c750a3ec 680{
57079c46 681 SV *sv = hv_iterval(avhv_keys(av), entry);
682 return *av_fetch(av, avhv_index_sv(sv), TRUE);
c750a3ec 683}