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