Test case for #10433/#10424.
[p5sagit/p5-mst-13.2.git] / av.c
CommitLineData
a0d0e21e 1/* av.c
79072805 2 *
bc89e66f 3 * Copyright (c) 1991-2001, 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
14befaf4 28 if (SvTIED_mg((SV*)av, PERL_MAGIC_tied) && ckWARN_d(WARN_DEBUGGING))
0453d815 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);
411caa50 37 if (sv != &PL_sv_undef)
a0d0e21e 38 (void)SvREFCNT_inc(sv);
39 }
29de640a 40 key = AvARRAY(av) - AvALLOC(av);
41 while (key)
3280af22 42 AvALLOC(av)[--key] = &PL_sv_undef;
62b1ebc2 43 AvREIFY_off(av);
a0d0e21e 44 AvREAL_on(av);
45}
46
cb50131a 47/*
48=for apidoc av_extend
49
50Pre-extend an array. The C<key> is the index to which the array should be
51extended.
52
53=cut
54*/
55
a0d0e21e 56void
864dbfa3 57Perl_av_extend(pTHX_ AV *av, I32 key)
a0d0e21e 58{
93965878 59 MAGIC *mg;
14befaf4 60 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 61 dSP;
62 ENTER;
63 SAVETMPS;
e788e7d3 64 PUSHSTACKi(PERLSI_MAGIC);
924508f0 65 PUSHMARK(SP);
66 EXTEND(SP,2);
33c27489 67 PUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 68 PUSHs(sv_2mortal(newSViv(key+1)));
93965878 69 PUTBACK;
864dbfa3 70 call_method("EXTEND", G_SCALAR|G_DISCARD);
d3acc0f7 71 POPSTACK;
93965878 72 FREETMPS;
73 LEAVE;
74 return;
75 }
a0d0e21e 76 if (key > AvMAX(av)) {
77 SV** ary;
78 I32 tmp;
79 I32 newmax;
80
81 if (AvALLOC(av) != AvARRAY(av)) {
93965878 82 ary = AvALLOC(av) + AvFILLp(av) + 1;
a0d0e21e 83 tmp = AvARRAY(av) - AvALLOC(av);
93965878 84 Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
a0d0e21e 85 AvMAX(av) += tmp;
86 SvPVX(av) = (char*)AvALLOC(av);
87 if (AvREAL(av)) {
88 while (tmp)
3280af22 89 ary[--tmp] = &PL_sv_undef;
a0d0e21e 90 }
91
92 if (key > AvMAX(av) - 10) {
93 newmax = key + AvMAX(av);
94 goto resize;
95 }
96 }
97 else {
98 if (AvALLOC(av)) {
516a5887 99#if !defined(STRANGE_MALLOC) && !defined(MYMALLOC)
c1f7b11a 100 MEM_SIZE bytes;
101 IV itmp;
c07a80fd 102#endif
4633a7c4 103
f5a32c7f 104#if defined(MYMALLOC) && !defined(LEAKTEST)
8d6dde3e 105 newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
106
107 if (key <= newmax)
108 goto resized;
109#endif
a0d0e21e 110 newmax = key + AvMAX(av) / 5;
111 resize:
8d6dde3e 112#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
a0d0e21e 113 Renew(AvALLOC(av),newmax+1, SV*);
4633a7c4 114#else
115 bytes = (newmax + 1) * sizeof(SV*);
116#define MALLOC_OVERHEAD 16
c1f7b11a 117 itmp = MALLOC_OVERHEAD;
118 while (itmp - MALLOC_OVERHEAD < bytes)
119 itmp += itmp;
120 itmp -= MALLOC_OVERHEAD;
121 itmp /= sizeof(SV*);
122 assert(itmp > newmax);
123 newmax = itmp - 1;
124 assert(newmax >= AvMAX(av));
4633a7c4 125 New(2,ary, newmax+1, SV*);
126 Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
fba3b22e 127 if (AvMAX(av) > 64)
128 offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
4633a7c4 129 else
130 Safefree(AvALLOC(av));
131 AvALLOC(av) = ary;
132#endif
9c5ffd7c 133#if defined(MYMALLOC) && !defined(LEAKTEST)
8d6dde3e 134 resized:
9c5ffd7c 135#endif
a0d0e21e 136 ary = AvALLOC(av) + AvMAX(av) + 1;
137 tmp = newmax - AvMAX(av);
3280af22 138 if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */
139 PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
140 PL_stack_base = AvALLOC(av);
141 PL_stack_max = PL_stack_base + newmax;
a0d0e21e 142 }
143 }
144 else {
8d6dde3e 145 newmax = key < 3 ? 3 : key;
a0d0e21e 146 New(2,AvALLOC(av), newmax+1, SV*);
147 ary = AvALLOC(av) + 1;
148 tmp = newmax;
3280af22 149 AvALLOC(av)[0] = &PL_sv_undef; /* For the stacks */
a0d0e21e 150 }
151 if (AvREAL(av)) {
152 while (tmp)
3280af22 153 ary[--tmp] = &PL_sv_undef;
a0d0e21e 154 }
155
156 SvPVX(av) = (char*)AvALLOC(av);
157 AvMAX(av) = newmax;
158 }
159 }
160}
161
cb50131a 162/*
163=for apidoc av_fetch
164
165Returns the SV at the specified index in the array. The C<key> is the
166index. If C<lval> is set then the fetch will be part of a store. Check
167that the return value is non-null before dereferencing it to a C<SV*>.
168
169See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
170more information on how to use this function on tied arrays.
171
172=cut
173*/
174
79072805 175SV**
864dbfa3 176Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
79072805 177{
178 SV *sv;
179
a0d0e21e 180 if (!av)
181 return 0;
182
93965878 183 if (key < 0) {
184 key += AvFILL(av) + 1;
185 if (key < 0)
186 return 0;
187 }
188
8990e307 189 if (SvRMAGICAL(av)) {
14befaf4 190 if (mg_find((SV*)av, PERL_MAGIC_tied) ||
191 mg_find((SV*)av, PERL_MAGIC_regdata))
192 {
8990e307 193 sv = sv_newmortal();
463ee0b2 194 mg_copy((SV*)av, sv, 0, key);
3280af22 195 PL_av_fetch_sv = sv;
196 return &PL_av_fetch_sv;
463ee0b2 197 }
198 }
199
93965878 200 if (key > AvFILLp(av)) {
a0d0e21e 201 if (!lval)
202 return 0;
352edd90 203 sv = NEWSV(5,0);
a0d0e21e 204 return av_store(av,key,sv);
79072805 205 }
3280af22 206 if (AvARRAY(av)[key] == &PL_sv_undef) {
4dbf4341 207 emptyness:
79072805 208 if (lval) {
209 sv = NEWSV(6,0);
463ee0b2 210 return av_store(av,key,sv);
79072805 211 }
212 return 0;
213 }
4dbf4341 214 else if (AvREIFY(av)
215 && (!AvARRAY(av)[key] /* eg. @_ could have freed elts */
216 || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
3280af22 217 AvARRAY(av)[key] = &PL_sv_undef; /* 1/2 reify */
4dbf4341 218 goto emptyness;
219 }
463ee0b2 220 return &AvARRAY(av)[key];
79072805 221}
222
cb50131a 223/*
224=for apidoc av_store
225
226Stores an SV in an array. The array index is specified as C<key>. The
227return value will be NULL if the operation failed or if the value did not
228need to be actually stored within the array (as in the case of tied
229arrays). Otherwise it can be dereferenced to get the original C<SV*>. Note
230that the caller is responsible for suitably incrementing the reference
231count of C<val> before the call, and decrementing it if the function
232returned NULL.
233
234See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
235more information on how to use this function on tied arrays.
236
237=cut
238*/
239
79072805 240SV**
864dbfa3 241Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
79072805 242{
79072805 243 SV** ary;
244
a0d0e21e 245 if (!av)
246 return 0;
43fcc5d2 247 if (!val)
3280af22 248 val = &PL_sv_undef;
463ee0b2 249
a0d0e21e 250 if (key < 0) {
251 key += AvFILL(av) + 1;
252 if (key < 0)
253 return 0;
79072805 254 }
93965878 255
43fcc5d2 256 if (SvREADONLY(av) && key >= AvFILL(av))
cea2e8a9 257 Perl_croak(aTHX_ PL_no_modify);
93965878 258
259 if (SvRMAGICAL(av)) {
14befaf4 260 if (mg_find((SV*)av, PERL_MAGIC_tied)) {
3280af22 261 if (val != &PL_sv_undef) {
93965878 262 mg_copy((SV*)av, val, 0, key);
263 }
264 return 0;
265 }
266 }
267
49beac48 268 if (!AvREAL(av) && AvREIFY(av))
a0d0e21e 269 av_reify(av);
a0d0e21e 270 if (key > AvMAX(av))
271 av_extend(av,key);
463ee0b2 272 ary = AvARRAY(av);
93965878 273 if (AvFILLp(av) < key) {
a0d0e21e 274 if (!AvREAL(av)) {
3280af22 275 if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
276 PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
a0d0e21e 277 do
3280af22 278 ary[++AvFILLp(av)] = &PL_sv_undef;
93965878 279 while (AvFILLp(av) < key);
79072805 280 }
93965878 281 AvFILLp(av) = key;
79072805 282 }
a0d0e21e 283 else if (AvREAL(av))
284 SvREFCNT_dec(ary[key]);
79072805 285 ary[key] = val;
8990e307 286 if (SvSMAGICAL(av)) {
3280af22 287 if (val != &PL_sv_undef) {
a0d0e21e 288 MAGIC* mg = SvMAGIC(av);
289 sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
290 }
463ee0b2 291 mg_set((SV*)av);
292 }
79072805 293 return &ary[key];
294}
295
cb50131a 296/*
297=for apidoc newAV
298
299Creates a new AV. The reference count is set to 1.
300
301=cut
302*/
303
79072805 304AV *
864dbfa3 305Perl_newAV(pTHX)
79072805 306{
463ee0b2 307 register AV *av;
79072805 308
a0d0e21e 309 av = (AV*)NEWSV(3,0);
310 sv_upgrade((SV *)av, SVt_PVAV);
463ee0b2 311 AvREAL_on(av);
312 AvALLOC(av) = 0;
313 SvPVX(av) = 0;
93965878 314 AvMAX(av) = AvFILLp(av) = -1;
463ee0b2 315 return av;
79072805 316}
317
cb50131a 318/*
319=for apidoc av_make
320
321Creates a new AV and populates it with a list of SVs. The SVs are copied
322into the array, so they may be freed after the call to av_make. The new AV
323will have a reference count of 1.
324
325=cut
326*/
327
79072805 328AV *
864dbfa3 329Perl_av_make(pTHX_ register I32 size, register SV **strp)
79072805 330{
463ee0b2 331 register AV *av;
79072805 332 register I32 i;
333 register SV** ary;
334
a0d0e21e 335 av = (AV*)NEWSV(8,0);
336 sv_upgrade((SV *) av,SVt_PVAV);
a0d0e21e 337 AvFLAGS(av) = AVf_REAL;
573fa4ea 338 if (size) { /* `defined' was returning undef for size==0 anyway. */
339 New(4,ary,size,SV*);
340 AvALLOC(av) = ary;
341 SvPVX(av) = (char*)ary;
93965878 342 AvFILLp(av) = size - 1;
573fa4ea 343 AvMAX(av) = size - 1;
344 for (i = 0; i < size; i++) {
345 assert (*strp);
346 ary[i] = NEWSV(7,0);
347 sv_setsv(ary[i], *strp);
348 strp++;
349 }
79072805 350 }
463ee0b2 351 return av;
79072805 352}
353
354AV *
864dbfa3 355Perl_av_fake(pTHX_ register I32 size, register SV **strp)
79072805 356{
463ee0b2 357 register AV *av;
79072805 358 register SV** ary;
359
a0d0e21e 360 av = (AV*)NEWSV(9,0);
361 sv_upgrade((SV *)av, SVt_PVAV);
79072805 362 New(4,ary,size+1,SV*);
463ee0b2 363 AvALLOC(av) = ary;
79072805 364 Copy(strp,ary,size,SV*);
a0d0e21e 365 AvFLAGS(av) = AVf_REIFY;
463ee0b2 366 SvPVX(av) = (char*)ary;
93965878 367 AvFILLp(av) = size - 1;
463ee0b2 368 AvMAX(av) = size - 1;
79072805 369 while (size--) {
a0d0e21e 370 assert (*strp);
371 SvTEMP_off(*strp);
79072805 372 strp++;
373 }
463ee0b2 374 return av;
79072805 375}
376
cb50131a 377/*
378=for apidoc av_clear
379
380Clears an array, making it empty. Does not free the memory used by the
381array itself.
382
383=cut
384*/
385
79072805 386void
864dbfa3 387Perl_av_clear(pTHX_ register AV *av)
79072805 388{
389 register I32 key;
a0d0e21e 390 SV** ary;
79072805 391
7d55f622 392#ifdef DEBUGGING
32da55ab 393 if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
0453d815 394 Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array");
7d55f622 395 }
396#endif
a60c0954 397 if (!av)
79072805 398 return;
399 /*SUPPRESS 560*/
a0d0e21e 400
39caa665 401 if (SvREADONLY(av))
cea2e8a9 402 Perl_croak(aTHX_ PL_no_modify);
39caa665 403
93965878 404 /* Give any tie a chance to cleanup first */
405 if (SvRMAGICAL(av))
406 mg_clear((SV*)av);
407
a60c0954 408 if (AvMAX(av) < 0)
409 return;
410
a0d0e21e 411 if (AvREAL(av)) {
412 ary = AvARRAY(av);
93965878 413 key = AvFILLp(av) + 1;
a0d0e21e 414 while (key) {
415 SvREFCNT_dec(ary[--key]);
3280af22 416 ary[key] = &PL_sv_undef;
a0d0e21e 417 }
418 }
155aba94 419 if ((key = AvARRAY(av) - AvALLOC(av))) {
463ee0b2 420 AvMAX(av) += key;
a0d0e21e 421 SvPVX(av) = (char*)AvALLOC(av);
79072805 422 }
93965878 423 AvFILLp(av) = -1;
fb73857a 424
79072805 425}
426
cb50131a 427/*
428=for apidoc av_undef
429
430Undefines the array. Frees the memory used by the array itself.
431
432=cut
433*/
434
79072805 435void
864dbfa3 436Perl_av_undef(pTHX_ register AV *av)
79072805 437{
438 register I32 key;
439
463ee0b2 440 if (!av)
79072805 441 return;
442 /*SUPPRESS 560*/
93965878 443
444 /* Give any tie a chance to cleanup first */
14befaf4 445 if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
93965878 446 av_fill(av, -1); /* mg_clear() ? */
447
a0d0e21e 448 if (AvREAL(av)) {
93965878 449 key = AvFILLp(av) + 1;
a0d0e21e 450 while (key)
451 SvREFCNT_dec(AvARRAY(av)[--key]);
452 }
463ee0b2 453 Safefree(AvALLOC(av));
454 AvALLOC(av) = 0;
455 SvPVX(av) = 0;
93965878 456 AvMAX(av) = AvFILLp(av) = -1;
748a9306 457 if (AvARYLEN(av)) {
458 SvREFCNT_dec(AvARYLEN(av));
459 AvARYLEN(av) = 0;
460 }
79072805 461}
462
cb50131a 463/*
464=for apidoc av_push
465
466Pushes an SV onto the end of the array. The array will grow automatically
467to accommodate the addition.
468
469=cut
470*/
471
a0d0e21e 472void
864dbfa3 473Perl_av_push(pTHX_ register AV *av, SV *val)
93965878 474{
475 MAGIC *mg;
a0d0e21e 476 if (!av)
477 return;
93965878 478 if (SvREADONLY(av))
cea2e8a9 479 Perl_croak(aTHX_ PL_no_modify);
93965878 480
14befaf4 481 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 482 dSP;
e788e7d3 483 PUSHSTACKi(PERLSI_MAGIC);
924508f0 484 PUSHMARK(SP);
485 EXTEND(SP,2);
33c27489 486 PUSHs(SvTIED_obj((SV*)av, mg));
93965878 487 PUSHs(val);
a60c0954 488 PUTBACK;
489 ENTER;
864dbfa3 490 call_method("PUSH", G_SCALAR|G_DISCARD);
a60c0954 491 LEAVE;
d3acc0f7 492 POPSTACK;
93965878 493 return;
494 }
495 av_store(av,AvFILLp(av)+1,val);
79072805 496}
497
cb50131a 498/*
499=for apidoc av_pop
500
501Pops an SV off the end of the array. Returns C<&PL_sv_undef> if the array
502is empty.
503
504=cut
505*/
506
79072805 507SV *
864dbfa3 508Perl_av_pop(pTHX_ register AV *av)
79072805 509{
510 SV *retval;
93965878 511 MAGIC* mg;
79072805 512
a0d0e21e 513 if (!av || AvFILL(av) < 0)
3280af22 514 return &PL_sv_undef;
43fcc5d2 515 if (SvREADONLY(av))
cea2e8a9 516 Perl_croak(aTHX_ PL_no_modify);
14befaf4 517 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 518 dSP;
e788e7d3 519 PUSHSTACKi(PERLSI_MAGIC);
924508f0 520 PUSHMARK(SP);
33c27489 521 XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 522 PUTBACK;
523 ENTER;
864dbfa3 524 if (call_method("POP", G_SCALAR)) {
3280af22 525 retval = newSVsv(*PL_stack_sp--);
93965878 526 } else {
3280af22 527 retval = &PL_sv_undef;
93965878 528 }
a60c0954 529 LEAVE;
d3acc0f7 530 POPSTACK;
93965878 531 return retval;
532 }
533 retval = AvARRAY(av)[AvFILLp(av)];
3280af22 534 AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
8990e307 535 if (SvSMAGICAL(av))
463ee0b2 536 mg_set((SV*)av);
79072805 537 return retval;
538}
539
cb50131a 540/*
541=for apidoc av_unshift
542
543Unshift the given number of C<undef> values onto the beginning of the
544array. The array will grow automatically to accommodate the addition. You
545must then use C<av_store> to assign values to these new elements.
546
547=cut
548*/
549
79072805 550void
864dbfa3 551Perl_av_unshift(pTHX_ register AV *av, register I32 num)
79072805 552{
553 register I32 i;
67a38de0 554 register SV **ary;
93965878 555 MAGIC* mg;
e2b534e7 556 I32 slide;
79072805 557
a0d0e21e 558 if (!av || num <= 0)
79072805 559 return;
43fcc5d2 560 if (SvREADONLY(av))
cea2e8a9 561 Perl_croak(aTHX_ PL_no_modify);
93965878 562
14befaf4 563 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 564 dSP;
e788e7d3 565 PUSHSTACKi(PERLSI_MAGIC);
924508f0 566 PUSHMARK(SP);
567 EXTEND(SP,1+num);
33c27489 568 PUSHs(SvTIED_obj((SV*)av, mg));
93965878 569 while (num-- > 0) {
3280af22 570 PUSHs(&PL_sv_undef);
93965878 571 }
572 PUTBACK;
a60c0954 573 ENTER;
864dbfa3 574 call_method("UNSHIFT", G_SCALAR|G_DISCARD);
a60c0954 575 LEAVE;
d3acc0f7 576 POPSTACK;
93965878 577 return;
578 }
579
49beac48 580 if (!AvREAL(av) && AvREIFY(av))
581 av_reify(av);
a0d0e21e 582 i = AvARRAY(av) - AvALLOC(av);
583 if (i) {
584 if (i > num)
585 i = num;
586 num -= i;
587
588 AvMAX(av) += i;
93965878 589 AvFILLp(av) += i;
a0d0e21e 590 SvPVX(av) = (char*)(AvARRAY(av) - i);
591 }
d2719217 592 if (num) {
67a38de0 593 i = AvFILLp(av);
e2b534e7 594 /* Create extra elements */
595 slide = i > 0 ? i : 0;
596 num += slide;
67a38de0 597 av_extend(av, i + num);
93965878 598 AvFILLp(av) += num;
67a38de0 599 ary = AvARRAY(av);
600 Move(ary, ary + num, i + 1, SV*);
601 do {
3280af22 602 ary[--num] = &PL_sv_undef;
67a38de0 603 } while (num);
e2b534e7 604 /* Make extra elements into a buffer */
605 AvMAX(av) -= slide;
606 AvFILLp(av) -= slide;
607 SvPVX(av) = (char*)(AvARRAY(av) + slide);
79072805 608 }
609}
610
cb50131a 611/*
612=for apidoc av_shift
613
614Shifts an SV off the beginning of the array.
615
616=cut
617*/
618
79072805 619SV *
864dbfa3 620Perl_av_shift(pTHX_ register AV *av)
79072805 621{
622 SV *retval;
93965878 623 MAGIC* mg;
79072805 624
a0d0e21e 625 if (!av || AvFILL(av) < 0)
3280af22 626 return &PL_sv_undef;
43fcc5d2 627 if (SvREADONLY(av))
cea2e8a9 628 Perl_croak(aTHX_ PL_no_modify);
14befaf4 629 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 630 dSP;
e788e7d3 631 PUSHSTACKi(PERLSI_MAGIC);
924508f0 632 PUSHMARK(SP);
33c27489 633 XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 634 PUTBACK;
635 ENTER;
864dbfa3 636 if (call_method("SHIFT", G_SCALAR)) {
3280af22 637 retval = newSVsv(*PL_stack_sp--);
93965878 638 } else {
3280af22 639 retval = &PL_sv_undef;
a60c0954 640 }
641 LEAVE;
d3acc0f7 642 POPSTACK;
93965878 643 return retval;
644 }
463ee0b2 645 retval = *AvARRAY(av);
a0d0e21e 646 if (AvREAL(av))
3280af22 647 *AvARRAY(av) = &PL_sv_undef;
463ee0b2 648 SvPVX(av) = (char*)(AvARRAY(av) + 1);
649 AvMAX(av)--;
93965878 650 AvFILLp(av)--;
8990e307 651 if (SvSMAGICAL(av))
463ee0b2 652 mg_set((SV*)av);
79072805 653 return retval;
654}
655
cb50131a 656/*
657=for apidoc av_len
658
659Returns the highest index in the array. Returns -1 if the array is
660empty.
661
662=cut
663*/
664
79072805 665I32
864dbfa3 666Perl_av_len(pTHX_ register AV *av)
79072805 667{
463ee0b2 668 return AvFILL(av);
79072805 669}
670
f3b76584 671/*
672=for apidoc av_fill
673
674Ensure than an array has a given number of elements, equivalent to
675Perl's C<$#array = $fill;>.
676
677=cut
678*/
79072805 679void
864dbfa3 680Perl_av_fill(pTHX_ register AV *av, I32 fill)
79072805 681{
93965878 682 MAGIC *mg;
a0d0e21e 683 if (!av)
cea2e8a9 684 Perl_croak(aTHX_ "panic: null array");
79072805 685 if (fill < 0)
686 fill = -1;
14befaf4 687 if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
93965878 688 dSP;
689 ENTER;
690 SAVETMPS;
e788e7d3 691 PUSHSTACKi(PERLSI_MAGIC);
924508f0 692 PUSHMARK(SP);
693 EXTEND(SP,2);
33c27489 694 PUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 695 PUSHs(sv_2mortal(newSViv(fill+1)));
93965878 696 PUTBACK;
864dbfa3 697 call_method("STORESIZE", G_SCALAR|G_DISCARD);
d3acc0f7 698 POPSTACK;
93965878 699 FREETMPS;
700 LEAVE;
701 return;
702 }
463ee0b2 703 if (fill <= AvMAX(av)) {
93965878 704 I32 key = AvFILLp(av);
a0d0e21e 705 SV** ary = AvARRAY(av);
706
707 if (AvREAL(av)) {
708 while (key > fill) {
709 SvREFCNT_dec(ary[key]);
3280af22 710 ary[key--] = &PL_sv_undef;
a0d0e21e 711 }
712 }
713 else {
714 while (key < fill)
3280af22 715 ary[++key] = &PL_sv_undef;
a0d0e21e 716 }
717
93965878 718 AvFILLp(av) = fill;
8990e307 719 if (SvSMAGICAL(av))
463ee0b2 720 mg_set((SV*)av);
721 }
a0d0e21e 722 else
3280af22 723 (void)av_store(av,fill,&PL_sv_undef);
79072805 724}
c750a3ec 725
f3b76584 726/*
727=for apidoc av_delete
728
729Deletes the element indexed by C<key> from the array. Returns the
730deleted element. C<flags> is currently ignored.
731
732=cut
733*/
146174a9 734SV *
735Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
736{
737 SV *sv;
738
739 if (!av)
740 return Nullsv;
741 if (SvREADONLY(av))
742 Perl_croak(aTHX_ PL_no_modify);
743 if (key < 0) {
744 key += AvFILL(av) + 1;
745 if (key < 0)
746 return Nullsv;
747 }
748 if (SvRMAGICAL(av)) {
749 SV **svp;
14befaf4 750 if ((mg_find((SV*)av, PERL_MAGIC_tied) ||
751 mg_find((SV*)av, PERL_MAGIC_regdata))
146174a9 752 && (svp = av_fetch(av, key, TRUE)))
753 {
754 sv = *svp;
755 mg_clear(sv);
14befaf4 756 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
757 sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
146174a9 758 return sv;
759 }
760 return Nullsv; /* element cannot be deleted */
761 }
762 }
763 if (key > AvFILLp(av))
764 return Nullsv;
765 else {
766 sv = AvARRAY(av)[key];
767 if (key == AvFILLp(av)) {
768 do {
769 AvFILLp(av)--;
770 } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
771 }
772 else
773 AvARRAY(av)[key] = &PL_sv_undef;
774 if (SvSMAGICAL(av))
775 mg_set((SV*)av);
776 }
777 if (flags & G_DISCARD) {
778 SvREFCNT_dec(sv);
779 sv = Nullsv;
780 }
781 return sv;
782}
783
784/*
f3b76584 785=for apidoc av_exists
786
787Returns true if the element indexed by C<key> has been initialized.
146174a9 788
f3b76584 789This relies on the fact that uninitialized array elements are set to
790C<&PL_sv_undef>.
791
792=cut
793*/
146174a9 794bool
795Perl_av_exists(pTHX_ AV *av, I32 key)
796{
797 if (!av)
798 return FALSE;
799 if (key < 0) {
800 key += AvFILL(av) + 1;
801 if (key < 0)
802 return FALSE;
803 }
804 if (SvRMAGICAL(av)) {
14befaf4 805 if (mg_find((SV*)av, PERL_MAGIC_tied) ||
806 mg_find((SV*)av, PERL_MAGIC_regdata))
807 {
146174a9 808 SV *sv = sv_newmortal();
e38197b3 809 MAGIC *mg;
810
146174a9 811 mg_copy((SV*)av, sv, 0, key);
14befaf4 812 mg = mg_find(sv, PERL_MAGIC_tiedelem);
e38197b3 813 if (mg) {
814 magic_existspack(sv, mg);
815 return SvTRUE(sv);
816 }
146174a9 817 }
818 }
819 if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
820 && AvARRAY(av)[key])
821 {
822 return TRUE;
823 }
824 else
825 return FALSE;
826}
57079c46 827
828/* AVHV: Support for treating arrays as if they were hashes. The
829 * first element of the array should be a hash reference that maps
830 * hash keys to array indices.
831 */
832
72311751 833STATIC I32
cea2e8a9 834S_avhv_index_sv(pTHX_ SV* sv)
57079c46 835{
836 I32 index = SvIV(sv);
837 if (index < 1)
cea2e8a9 838 Perl_croak(aTHX_ "Bad index while coercing array into hash");
57079c46 839 return index;
840}
841
10c8fecd 842STATIC I32
843S_avhv_index(pTHX_ AV *av, SV *keysv, U32 hash)
844{
845 HV *keys;
846 HE *he;
847 STRLEN n_a;
848
849 keys = avhv_keys(av);
850 he = hv_fetch_ent(keys, keysv, FALSE, hash);
851 if (!he)
852 Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a));
853 return avhv_index_sv(HeVAL(he));
854}
855
5d5aaa5e 856HV*
864dbfa3 857Perl_avhv_keys(pTHX_ AV *av)
5d5aaa5e 858{
57079c46 859 SV **keysp = av_fetch(av, 0, FALSE);
5d5aaa5e 860 if (keysp) {
d627ae4e 861 SV *sv = *keysp;
862 if (SvGMAGICAL(sv))
863 mg_get(sv);
864 if (SvROK(sv)) {
865 sv = SvRV(sv);
866 if (SvTYPE(sv) == SVt_PVHV)
57079c46 867 return (HV*)sv;
5d5aaa5e 868 }
869 }
cea2e8a9 870 Perl_croak(aTHX_ "Can't coerce array into hash");
72311751 871 return Nullhv;
c750a3ec 872}
873
874SV**
10c8fecd 875Perl_avhv_store_ent(pTHX_ AV *av, SV *keysv, SV *val, U32 hash)
876{
877 return av_store(av, avhv_index(av, keysv, hash), val);
878}
879
880SV**
864dbfa3 881Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
97fcbf96 882{
10c8fecd 883 return av_fetch(av, avhv_index(av, keysv, hash), lval);
5bc6513d 884}
885
146174a9 886SV *
887Perl_avhv_delete_ent(pTHX_ AV *av, SV *keysv, I32 flags, U32 hash)
888{
889 HV *keys = avhv_keys(av);
890 HE *he;
891
892 he = hv_fetch_ent(keys, keysv, FALSE, hash);
893 if (!he || !SvOK(HeVAL(he)))
894 return Nullsv;
895
896 return av_delete(av, avhv_index_sv(HeVAL(he)), flags);
897}
898
899/* Check for the existence of an element named by a given key.
900 *
901 */
c750a3ec 902bool
864dbfa3 903Perl_avhv_exists_ent(pTHX_ AV *av, SV *keysv, U32 hash)
97fcbf96 904{
5d5aaa5e 905 HV *keys = avhv_keys(av);
146174a9 906 HE *he;
907
908 he = hv_fetch_ent(keys, keysv, FALSE, hash);
909 if (!he || !SvOK(HeVAL(he)))
910 return FALSE;
911
912 return av_exists(av, avhv_index_sv(HeVAL(he)));
97fcbf96 913}
914
c750a3ec 915HE *
864dbfa3 916Perl_avhv_iternext(pTHX_ AV *av)
c750a3ec 917{
5d5aaa5e 918 HV *keys = avhv_keys(av);
919 return hv_iternext(keys);
c750a3ec 920}
921
922SV *
864dbfa3 923Perl_avhv_iterval(pTHX_ AV *av, register HE *entry)
c750a3ec 924{
57079c46 925 SV *sv = hv_iterval(avhv_keys(av), entry);
926 return *av_fetch(av, avhv_index_sv(sv), TRUE);
c750a3ec 927}