X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/67549bd2d9da9e6710cdab4542e708ef4d4346b6..803f274831f937654d48f8cf0468521cbf8f5dff:/av.c diff --git a/av.c b/av.c index acedd00..86aaae0 100644 --- a/av.c +++ b/av.c @@ -76,7 +76,8 @@ Perl_av_extend(pTHX_ AV *av, I32 key) if (mg) { SV *arg1 = sv_newmortal(); sv_setiv(arg1, (IV)(key + 1)); - magic_methcall(MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1, arg1, NULL); + Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1, + arg1); return; } if (key > AvMAX(av)) { @@ -190,12 +191,14 @@ Perl_av_extend(pTHX_ AV *av, I32 key) =for apidoc av_fetch Returns the SV at the specified index in the array. The C is the -index. If C 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. +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. See L for more information on how to use this function on tied arrays. +The rough perl equivalent is C<$myarray[$idx]>. =cut */ @@ -336,7 +339,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val) } if (SvREADONLY(av) && key >= AvFILL(av)) - Perl_croak(aTHX_ "%s", PL_no_modify); + Perl_croak_no_modify(aTHX); if (!AvREAL(av) && AvREIFY(av)) av_reify(av); @@ -362,7 +365,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val) 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)); } @@ -376,6 +379,8 @@ Creates a new AV and populates it with a list of SVs. The SVs are copied 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 + =cut */ @@ -414,7 +419,7 @@ Perl_av_make(pTHX_ register I32 size, register SV **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 */ @@ -435,13 +440,13 @@ Perl_av_clear(pTHX_ register AV *av) #endif if (SvREADONLY(av)) - Perl_croak(aTHX_ "%s", PL_no_modify); + Perl_croak_no_modify(aTHX); /* Give any tie a chance to cleanup first */ 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)); } @@ -541,10 +546,11 @@ Perl_av_push(pTHX_ register AV *av, SV *val) assert(SvTYPE(av) == SVt_PVAV); if (SvREADONLY(av)) - Perl_croak(aTHX_ "%s", PL_no_modify); + Perl_croak_no_modify(aTHX); if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - magic_methcall(MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1, val, NULL); + Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1, + val); return; } av_store(av,AvFILLp(av)+1,val); @@ -570,9 +576,9 @@ Perl_av_pop(pTHX_ register AV *av) assert(SvTYPE(av) == SVt_PVAV); if (SvREADONLY(av)) - Perl_croak(aTHX_ "%s", PL_no_modify); + Perl_croak_no_modify(aTHX); if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - retval = magic_methcall(MUTABLE_SV(av), mg, "POP", 0, 0, NULL, NULL); + retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0); if (retval) retval = newSVsv(retval); return retval; @@ -629,11 +635,11 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num) assert(SvTYPE(av) == SVt_PVAV); if (SvREADONLY(av)) - Perl_croak(aTHX_ "%s", PL_no_modify); + Perl_croak_no_modify(aTHX); if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - magic_methcall(MUTABLE_SV(av), mg, "UNSHIFT", G_DISCARD | G_UNDEF_FILL, - num, NULL, NULL); + Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT", + G_DISCARD | G_UNDEF_FILL, num); return; } @@ -691,9 +697,9 @@ Perl_av_shift(pTHX_ register AV *av) assert(SvTYPE(av) == SVt_PVAV); if (SvREADONLY(av)) - Perl_croak(aTHX_ "%s", PL_no_modify); + Perl_croak_no_modify(aTHX); if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - retval = magic_methcall(MUTABLE_SV(av), mg, "SHIFT", 0, 0, NULL, NULL); + retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0); if (retval) retval = newSVsv(retval); return retval; @@ -717,6 +723,8 @@ Perl_av_shift(pTHX_ register AV *av) Returns the highest index in the array. The number of elements in the array is C. Returns -1 if the array is empty. +The Perl equivalent for this is C<$#myarray>. + =cut */ @@ -736,7 +744,7 @@ Set the highest index in the array to the given number, equivalent to Perl's C<$#array = $fill;>. The number of elements in the an array will be C 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. If the array was longer, then the excess elements are freed. C is the same as C. @@ -757,8 +765,8 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill) if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { SV *arg1 = sv_newmortal(); sv_setiv(arg1, (IV)(fill + 1)); - magic_methcall(MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD, - 1, arg1, NULL); + Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD, + 1, arg1); return; } if (fill <= AvMAX(av)) { @@ -789,7 +797,9 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill) Deletes the element indexed by C from the array. Returns the deleted element. If C equals C, the element is freed -and null is returned. +and null is returned. Perl equivalent: C +for the non-C version and a void-context C +for the C version. =cut */ @@ -803,7 +813,7 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags) assert(SvTYPE(av) == SVt_PVAV); if (SvREADONLY(av)) - Perl_croak(aTHX_ "%s", PL_no_modify); + Perl_croak_no_modify(aTHX); if (SvRMAGICAL(av)) { const MAGIC * const tied_magic @@ -881,6 +891,8 @@ Returns true if the element indexed by C has been initialized. This relies on the fact that uninitialized array elements are set to C<&PL_sv_undef>. +Perl equivalent: C. + =cut */ bool