This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make exists() work better on pseudo-hashes (reworked a patch suggested
[perl5.git] / av.c
CommitLineData
a0d0e21e 1/* av.c
79072805 2 *
4eb8286e 3 * Copyright (c) 1991-1999, Larry Wall
79072805
LW
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
LW
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
LW
13 */
14
15#include "EXTERN.h"
864dbfa3 16#define PERL_IN_AV_C
79072805
LW
17#include "perl.h"
18
fb73857a 19void
864dbfa3 20Perl_av_reify(pTHX_ AV *av)
a0d0e21e
LW
21{
22 I32 key;
23 SV* sv;
fb73857a 24
3c78fafa
GS
25 if (AvREAL(av))
26 return;
93965878 27#ifdef DEBUGGING
0453d815
PM
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
LW
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
CS
42 key = AvARRAY(av) - AvALLOC(av);
43 while (key)
3280af22 44 AvALLOC(av)[--key] = &PL_sv_undef;
62b1ebc2 45 AvREIFY_off(av);
a0d0e21e
LW
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
NIS
55 dSP;
56 ENTER;
57 SAVETMPS;
e788e7d3 58 PUSHSTACKi(PERLSI_MAGIC);
924508f0
GS
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
NIS
66 FREETMPS;
67 LEAVE;
68 return;
69 }
a0d0e21e
LW
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
LW
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
LW
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
SB
94 MEM_SIZE bytes;
95 IV itmp;
c07a80fd 96#endif
4633a7c4 97
1fe09876 98#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST)
8d6dde3e
IZ
99 newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
100
101 if (key <= newmax)
102 goto resized;
103#endif
a0d0e21e
LW
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
LW
108#else
109 bytes = (newmax + 1) * sizeof(SV*);
110#define MALLOC_OVERHEAD 16
c1f7b11a
SB
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
LW
119 New(2,ary, newmax+1, SV*);
120 Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
fba3b22e
MB
121 if (AvMAX(av) > 64)
122 offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
4633a7c4
LW
123 else
124 Safefree(AvALLOC(av));
125 AvALLOC(av) = ary;
126#endif
8d6dde3e 127 resized:
a0d0e21e
LW
128 ary = AvALLOC(av) + AvMAX(av) + 1;
129 tmp = newmax - AvMAX(av);
3280af22
NIS
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
LW
134 }
135 }
136 else {
8d6dde3e 137 newmax = key < 3 ? 3 : key;
a0d0e21e
LW
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
LW
142 }
143 if (AvREAL(av)) {
144 while (tmp)
3280af22 145 ary[--tmp] = &PL_sv_undef;
a0d0e21e
LW
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
LW
156{
157 SV *sv;
158
a0d0e21e
LW
159 if (!av)
160 return 0;
161
93965878
NIS
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
NIS
173 PL_av_fetch_sv = sv;
174 return &PL_av_fetch_sv;
463ee0b2
LW
175 }
176 }
177
93965878 178 if (key > AvFILLp(av)) {
a0d0e21e
LW
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
LW
186 if (lval) {
187 sv = NEWSV(6,0);
463ee0b2 188 return av_store(av,key,sv);
79072805
LW
189 }
190 return 0;
191 }
4dbf4341
PP
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
PP
196 goto emptyness;
197 }
463ee0b2 198 return &AvARRAY(av)[key];
79072805
LW
199}
200
201SV**
864dbfa3 202Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
79072805 203{
79072805 204 SV** ary;
93965878
NIS
205 U32 fill;
206
79072805 207
a0d0e21e
LW
208 if (!av)
209 return 0;
43fcc5d2 210 if (!val)
3280af22 211 val = &PL_sv_undef;
463ee0b2 212
a0d0e21e
LW
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
NIS
221
222 if (SvRMAGICAL(av)) {
223 if (mg_find((SV*)av,'P')) {
3280af22 224 if (val != &PL_sv_undef) {
93965878
NIS
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
LW
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
NIS
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
LW
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
LW
252 MAGIC* mg = SvMAGIC(av);
253 sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
254 }
463ee0b2
LW
255 mg_set((SV*)av);
256 }
79072805
LW
257 return &ary[key];
258}
259
260AV *
864dbfa3 261Perl_newAV(pTHX)
79072805 262{
463ee0b2 263 register AV *av;
79072805 264
a0d0e21e
LW
265 av = (AV*)NEWSV(3,0);
266 sv_upgrade((SV *)av, SVt_PVAV);
463ee0b2
LW
267 AvREAL_on(av);
268 AvALLOC(av) = 0;
269 SvPVX(av) = 0;
93965878 270 AvMAX(av) = AvFILLp(av) = -1;
463ee0b2 271 return av;
79072805
LW
272}
273
274AV *
864dbfa3 275Perl_av_make(pTHX_ register I32 size, register SV **strp)
79072805 276{
463ee0b2 277 register AV *av;
79072805
LW
278 register I32 i;
279 register SV** ary;
280
a0d0e21e
LW
281 av = (AV*)NEWSV(8,0);
282 sv_upgrade((SV *) av,SVt_PVAV);
a0d0e21e 283 AvFLAGS(av) = AVf_REAL;
573fa4ea
TB
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
TB
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
LW
298}
299
300AV *
864dbfa3 301Perl_av_fake(pTHX_ register I32 size, register SV **strp)
79072805 302{
463ee0b2 303 register AV *av;
79072805
LW
304 register SV** ary;
305
a0d0e21e
LW
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
LW
316 assert (*strp);
317 SvTEMP_off(*strp);
79072805
LW
318 strp++;
319 }
463ee0b2 320 return av;
79072805
LW
321}
322
323void
864dbfa3 324Perl_av_clear(pTHX_ register AV *av)
79072805
LW
325{
326 register I32 key;
a0d0e21e 327 SV** ary;
79072805 328
7d55f622 329#ifdef DEBUGGING
0453d815
PM
330 if (SvREFCNT(av) <= 0 && ckWARN_d(WARN_DEBUGGING)) {
331 Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array");
7d55f622
PP
332 }
333#endif
a60c0954 334 if (!av)
79072805
LW
335 return;
336 /*SUPPRESS 560*/
a0d0e21e 337
39caa665 338 if (SvREADONLY(av))
cea2e8a9 339 Perl_croak(aTHX_ PL_no_modify);
39caa665 340
93965878
NIS
341 /* Give any tie a chance to cleanup first */
342 if (SvRMAGICAL(av))
343 mg_clear((SV*)av);
344
a60c0954
NIS
345 if (AvMAX(av) < 0)
346 return;
347
a0d0e21e
LW
348 if (AvREAL(av)) {
349 ary = AvARRAY(av);
93965878 350 key = AvFILLp(av) + 1;
a0d0e21e
LW
351 while (key) {
352 SvREFCNT_dec(ary[--key]);
3280af22 353 ary[key] = &PL_sv_undef;
a0d0e21e
LW
354 }
355 }
463ee0b2
LW
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
LW
362}
363
364void
864dbfa3 365Perl_av_undef(pTHX_ register AV *av)
79072805
LW
366{
367 register I32 key;
368
463ee0b2 369 if (!av)
79072805
LW
370 return;
371 /*SUPPRESS 560*/
93965878
NIS
372
373 /* Give any tie a chance to cleanup first */
33c27489 374 if (SvTIED_mg((SV*)av, 'P'))
93965878
NIS
375 av_fill(av, -1); /* mg_clear() ? */
376
a0d0e21e 377 if (AvREAL(av)) {
93965878 378 key = AvFILLp(av) + 1;
a0d0e21e
LW
379 while (key)
380 SvREFCNT_dec(AvARRAY(av)[--key]);
381 }
463ee0b2
LW
382 Safefree(AvALLOC(av));
383 AvALLOC(av) = 0;
384 SvPVX(av) = 0;
93965878 385 AvMAX(av) = AvFILLp(av) = -1;
748a9306
LW
386 if (AvARYLEN(av)) {
387 SvREFCNT_dec(AvARYLEN(av));
388 AvARYLEN(av) = 0;
389 }
79072805
LW
390}
391
a0d0e21e 392void
864dbfa3 393Perl_av_push(pTHX_ register AV *av, SV *val)
93965878
NIS
394{
395 MAGIC *mg;
a0d0e21e
LW
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
GS
404 PUSHMARK(SP);
405 EXTEND(SP,2);
33c27489 406 PUSHs(SvTIED_obj((SV*)av, mg));
93965878 407 PUSHs(val);
a60c0954
NIS
408 PUTBACK;
409 ENTER;
864dbfa3 410 call_method("PUSH", G_SCALAR|G_DISCARD);
a60c0954 411 LEAVE;
d3acc0f7 412 POPSTACK;
93965878
NIS
413 return;
414 }
415 av_store(av,AvFILLp(av)+1,val);
79072805
LW
416}
417
418SV *
864dbfa3 419Perl_av_pop(pTHX_ register AV *av)
79072805
LW
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
NIS
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
NIS
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
LW
448 return retval;
449}
450
451void
864dbfa3 452Perl_av_unshift(pTHX_ register AV *av, register I32 num)
79072805
LW
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
GS
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
NIS
471 }
472 PUTBACK;
a60c0954 473 ENTER;
864dbfa3 474 call_method("UNSHIFT", G_SCALAR|G_DISCARD);
a60c0954 475 LEAVE;
d3acc0f7 476 POPSTACK;
93965878
NIS
477 return;
478 }
479
49beac48
CS
480 if (!AvREAL(av) && AvREIFY(av))
481 av_reify(av);
a0d0e21e
LW
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
LW
490 SvPVX(av) = (char*)(AvARRAY(av) - i);
491 }
d2719217 492 if (num) {
67a38de0
NIS
493 i = AvFILLp(av);
494 av_extend(av, i + num);
93965878 495 AvFILLp(av) += num;
67a38de0
NIS
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
LW
501 }
502}
503
504SV *
864dbfa3 505Perl_av_shift(pTHX_ register AV *av)
79072805
LW
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
NIS
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
NIS
525 }
526 LEAVE;
d3acc0f7 527 POPSTACK;
93965878
NIS
528 return retval;
529 }
463ee0b2 530 retval = *AvARRAY(av);
a0d0e21e 531 if (AvREAL(av))
3280af22 532 *AvARRAY(av) = &PL_sv_undef;
463ee0b2
LW
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
LW
538 return retval;
539}
540
541I32
864dbfa3 542Perl_av_len(pTHX_ register AV *av)
79072805 543{
463ee0b2 544 return AvFILL(av);
79072805
LW
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
LW
553 if (fill < 0)
554 fill = -1;
33c27489 555 if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878
NIS
556 dSP;
557 ENTER;
558 SAVETMPS;
e788e7d3 559 PUSHSTACKi(PERLSI_MAGIC);
924508f0
GS
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
NIS
567 FREETMPS;
568 LEAVE;
569 return;
570 }
463ee0b2 571 if (fill <= AvMAX(av)) {
93965878 572 I32 key = AvFILLp(av);
a0d0e21e
LW
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
LW
579 }
580 }
581 else {
582 while (key < fill)
3280af22 583 ary[++key] = &PL_sv_undef;
a0d0e21e
LW
584 }
585
93965878 586 AvFILLp(av) = fill;
8990e307 587 if (SvSMAGICAL(av))
463ee0b2
LW
588 mg_set((SV*)av);
589 }
a0d0e21e 590 else
3280af22 591 (void)av_store(av,fill,&PL_sv_undef);
79072805 592}
c750a3ec 593
57079c46
GA
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
GA
602{
603 I32 index = SvIV(sv);
604 if (index < 1)
cea2e8a9 605 Perl_croak(aTHX_ "Bad index while coercing array into hash");
57079c46
GA
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
MB
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
JP
621 }
622 }
cea2e8a9 623 Perl_croak(aTHX_ "Can't coerce array into hash");
72311751 624 return Nullhv;
c750a3ec
MB
625}
626
627SV**
864dbfa3 628Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
97fcbf96 629{
5d5aaa5e
JP
630 SV **indsvp;
631 HV *keys = avhv_keys(av);
97fcbf96 632 HE *he;
5bc6513d 633
5d5aaa5e 634 he = hv_fetch_ent(keys, keysv, FALSE, hash);
57079c46 635 if (!he)
cea2e8a9 636 Perl_croak(aTHX_ "No such array field");
57079c46 637 return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
5bc6513d
MB
638}
639
4bd46447
GS
640/* Check for the existence of an element named by a given key.
641 *
642 * This relies on the fact that uninitialized array elements
643 * are set to &PL_sv_undef.
644 */
c750a3ec 645bool
864dbfa3 646Perl_avhv_exists_ent(pTHX_ AV *av, SV *keysv, U32 hash)
97fcbf96 647{
5d5aaa5e 648 HV *keys = avhv_keys(av);
4bd46447
GS
649 HE *he;
650 IV ix;
651
652 he = hv_fetch_ent(keys, keysv, FALSE, hash);
653 if (!he || !SvOK(HeVAL(he)))
654 return FALSE;
655
656 ix = SvIV(HeVAL(he));
657
658 /* If the array hasn't been extended to reach the key yet then
659 * it hasn't been accessed and thus does not exist. We use
660 * AvFILL() rather than AvFILLp() to handle tied av. */
661 if (ix > 0 && ix <= AvFILL(av)
662 && (SvRMAGICAL(av)
663 || (AvARRAY(av)[ix] && AvARRAY(av)[ix] != &PL_sv_undef)))
664 {
665 return TRUE;
666 }
667 return FALSE;
97fcbf96
MB
668}
669
c750a3ec 670HE *
864dbfa3 671Perl_avhv_iternext(pTHX_ AV *av)
c750a3ec 672{
5d5aaa5e
JP
673 HV *keys = avhv_keys(av);
674 return hv_iternext(keys);
c750a3ec
MB
675}
676
677SV *
864dbfa3 678Perl_avhv_iterval(pTHX_ AV *av, register HE *entry)
c750a3ec 679{
57079c46
GA
680 SV *sv = hv_iterval(avhv_keys(av), entry);
681 return *av_fetch(av, avhv_index_sv(sv), TRUE);
c750a3ec 682}