if (AvREAL(av))
return;
#ifdef DEBUGGING
- if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied) && ckWARN_d(WARN_DEBUGGING))
- Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array");
+ if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array");
#endif
key = AvMAX(av) + 1;
while (key > AvFILLp(av) + 1)
mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied);
if (mg) {
- dSP;
- ENTER;
- SAVETMPS;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- EXTEND(SP,2);
- PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
- mPUSHi(key + 1);
- PUTBACK;
- call_method("EXTEND", G_SCALAR|G_DISCARD);
- POPSTACK;
- FREETMPS;
- LEAVE;
+ SV *arg1 = sv_newmortal();
+ sv_setiv(arg1, (IV)(key + 1));
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1,
+ arg1);
return;
}
if (key > AvMAX(av)) {
=for apidoc av_fetch
Returns the SV at the specified index in the array. The C<key> is the
-index. If C<lval> is set then the fetch will be part of a store. Check
-that the return value is non-null before dereferencing it to a C<SV*>.
+index. If lval is true, you are guaranteed to get a real SV back (in case
+it wasn't real before), which you can then modify. Check that the return
+value is non-null before dereferencing it to a C<SV*>.
See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
more information on how to use this function on tied arrays.
+The rough perl equivalent is C<$myarray[$idx]>.
=cut
*/
sv = sv_newmortal();
sv_upgrade(sv, SVt_PVLV);
mg_copy(MUTABLE_SV(av), sv, 0, key);
+ if (!tied_magic) /* for regdata, force leavesub to make copies */
+ SvTEMP_off(sv);
LvTYPE(sv) = 't';
LvTARG(sv) = sv; /* fake (SV**) */
return &(LvTARG(sv));
sv_magic(val, MUTABLE_SV(av), toLOWER(mg->mg_type), 0, key);
}
if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa)
- PL_delaymagic |= DM_ARRAY;
+ PL_delaymagic |= DM_ARRAY_ISA;
else
mg_set(MUTABLE_SV(av));
}
into the array, so they may be freed after the call to av_make. The new AV
will have a reference count of 1.
+Perl equivalent: C<my @new_array = ($scalar1, $scalar2, $scalar3...);>
+
=cut
*/
AvFILLp(av) = AvMAX(av) = size - 1;
for (i = 0; i < size; i++) {
assert (*strp);
+
+ /* Don't let sv_setsv swipe, since our source array might
+ have multiple references to the same temp scalar (e.g.
+ from a list slice) */
+
ary[i] = newSV(0);
- sv_setsv(ary[i], *strp);
+ sv_setsv_flags(ary[i], *strp,
+ SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL);
strp++;
}
}
=for apidoc av_clear
Clears an array, making it empty. Does not free the memory used by the
-array itself.
+array itself. Perl equivalent: C<@myarray = ();>.
=cut
*/
assert(SvTYPE(av) == SVt_PVAV);
#ifdef DEBUGGING
- if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
- Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
+ if (SvREFCNT(av) == 0) {
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
}
#endif
if (SvRMAGICAL(av)) {
const MAGIC* const mg = SvMAGIC(av);
if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa)
- PL_delaymagic |= DM_ARRAY;
+ PL_delaymagic |= DM_ARRAY_ISA;
else
mg_clear(MUTABLE_SV(av));
}
Perl_croak(aTHX_ "%s", PL_no_modify);
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- dSP;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- EXTEND(SP,2);
- PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
- PUSHs(val);
- PUTBACK;
- ENTER;
- call_method("PUSH", G_SCALAR|G_DISCARD);
- LEAVE;
- POPSTACK;
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
+ val);
return;
}
av_store(av,AvFILLp(av)+1,val);
if (SvREADONLY(av))
Perl_croak(aTHX_ "%s", PL_no_modify);
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- dSP;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
- PUTBACK;
- ENTER;
- if (call_method("POP", G_SCALAR)) {
- retval = newSVsv(*PL_stack_sp--);
- } else {
- retval = &PL_sv_undef;
- }
- LEAVE;
- POPSTACK;
+ retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
+ if (retval)
+ retval = newSVsv(retval);
return retval;
}
if (AvFILL(av) < 0)
Perl_croak(aTHX_ "%s", PL_no_modify);
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- dSP;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- EXTEND(SP,1+num);
- PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
- while (num-- > 0) {
- PUSHs(&PL_sv_undef);
- }
- PUTBACK;
- ENTER;
- call_method("UNSHIFT", G_SCALAR|G_DISCARD);
- LEAVE;
- POPSTACK;
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
+ G_DISCARD | G_UNDEF_FILL, num);
return;
}
if (SvREADONLY(av))
Perl_croak(aTHX_ "%s", PL_no_modify);
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- dSP;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
- PUTBACK;
- ENTER;
- if (call_method("SHIFT", G_SCALAR)) {
- retval = newSVsv(*PL_stack_sp--);
- } else {
- retval = &PL_sv_undef;
- }
- LEAVE;
- POPSTACK;
+ retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
+ if (retval)
+ retval = newSVsv(retval);
return retval;
}
if (AvFILL(av) < 0)
Returns the highest index in the array. The number of elements in the
array is C<av_len(av) + 1>. Returns -1 if the array is empty.
+The Perl equivalent for this is C<$#myarray>.
+
=cut
*/
Perl's C<$#array = $fill;>.
The number of elements in the an array will be C<fill + 1> after
-av_fill() returns. If the array was previously shorter then the
+av_fill() returns. If the array was previously shorter, then the
additional elements appended are set to C<PL_sv_undef>. If the array
was longer, then the excess elements are freed. C<av_fill(av, -1)> is
the same as C<av_clear(av)>.
if (fill < 0)
fill = -1;
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- dSP;
- ENTER;
- SAVETMPS;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- EXTEND(SP,2);
- PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
- mPUSHi(fill + 1);
- PUTBACK;
- call_method("STORESIZE", G_SCALAR|G_DISCARD);
- POPSTACK;
- FREETMPS;
- LEAVE;
+ SV *arg1 = sv_newmortal();
+ sv_setiv(arg1, (IV)(fill + 1));
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
+ 1, arg1);
return;
}
if (fill <= AvMAX(av)) {
Deletes the element indexed by C<key> from the array. Returns the
deleted element. If C<flags> equals C<G_DISCARD>, the element is freed
-and null is returned.
+and null is returned. Perl equivalent: C<my $elem = delete($myarray[$idx]);>
+for the non-C<G_DISCARD> version and a void-context C<delete($myarray[$idx]);>
+for the C<G_DISCARD> version.
=cut
*/
This relies on the fact that uninitialized array elements are set to
C<&PL_sv_undef>.
+Perl equivalent: C<exists($myarray[$key])>.
+
=cut
*/
bool
mg = mg_find(sv, PERL_MAGIC_tiedelem);
if (mg) {
magic_existspack(sv, mg);
- return (bool)SvTRUE(sv);
+ return cBOOL(SvTRUE(sv));
}
}