diff options
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | embed.h | 1 | ||||
| -rw-r--r-- | mg.c | 15 | ||||
| -rw-r--r-- | mg_vtable.h | 2 | ||||
| -rw-r--r-- | pod/perldelta.pod | 10 | ||||
| -rw-r--r-- | proto.h | 6 | ||||
| -rw-r--r-- | regen/mg_vtable.pl | 2 | ||||
| -rw-r--r-- | t/op/each_array.t | 30 |
8 files changed, 64 insertions, 3 deletions
@@ -754,6 +754,7 @@ p |int |magic_regdatum_get|NN SV* sv|NN MAGIC* mg pr |int |magic_regdatum_set|NN SV* sv|NN MAGIC* mg p |int |magic_set |NN SV* sv|NN MAGIC* mg p |int |magic_setarylen|NN SV* sv|NN MAGIC* mg +p |int |magic_cleararylen_p|NN SV* sv|NN MAGIC* mg p |int |magic_freearylen_p|NN SV* sv|NN MAGIC* mg p |int |magic_setdbline|NN SV* sv|NN MAGIC* mg p |int |magic_setdefelem|NN SV* sv|NN MAGIC* mg @@ -1098,6 +1098,7 @@ #define list(a) Perl_list(aTHX_ a) #define localize(a,b) Perl_localize(aTHX_ a,b) #define magic_clear_all_env(a,b) Perl_magic_clear_all_env(aTHX_ a,b) +#define magic_cleararylen_p(a,b) Perl_magic_cleararylen_p(aTHX_ a,b) #define magic_clearenv(a,b) Perl_magic_clearenv(aTHX_ a,b) #define magic_clearhint(a,b) Perl_magic_clearhint(aTHX_ a,b) #define magic_clearhints(a,b) Perl_magic_clearhints(aTHX_ a,b) @@ -2043,6 +2043,21 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg) } int +Perl_magic_cleararylen_p(pTHX_ SV *sv, MAGIC *mg) +{ + dVAR; + + PERL_ARGS_ASSERT_MAGIC_CLEARARYLEN_P; + PERL_UNUSED_ARG(sv); + + /* Reset the iterator when the array is cleared */ + if (mg->mg_ptr) + *((IV *) mg->mg_ptr) = 0; + + return 0; +} + +int Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg) { dVAR; diff --git a/mg_vtable.h b/mg_vtable.h index d2379f26e9..3c73c2beff 100644 --- a/mg_vtable.h +++ b/mg_vtable.h @@ -147,7 +147,7 @@ EXTCONST char *PL_magic_vtable_names[magic_vtable_max]; #ifdef DOINIT EXT_MGVTBL PL_magic_vtables[magic_vtable_max] = { { (int (*)(pTHX_ SV *, MAGIC *))Perl_magic_getarylen, Perl_magic_setarylen, 0, 0, 0, 0, 0, 0 }, - { 0, 0, 0, 0, Perl_magic_freearylen_p, 0, 0, 0 }, + { 0, 0, 0, Perl_magic_cleararylen_p, Perl_magic_freearylen_p, 0, 0, 0 }, { 0, 0, 0, 0, Perl_magic_killbackrefs, 0, 0, 0 }, { 0, 0, 0, 0, 0, Perl_magic_copycallchecker, 0, 0 }, #ifdef USE_LOCALE_COLLATE diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 3d1733cd1f..a3ee589863 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -342,6 +342,16 @@ C<do FILE> now always either sets or clears C<$@>, even when the file can't be read. This ensures that testing C<$@> first (as recommended by the documentation) always returns the correct result. +=item * + +The array iterator used for the C<each @array> construct is now correctly +reset when C<@array> is cleared (RT #75596). This happens for example when the +array is globally assigned to, as in C<@array = (...)>, but not when its +B<values> are assigned to. In terms of the XS API, it means that C<av_clear()> +will now reset the iterator. + +This mirrors the behaviour of the hash iterator when the hash is cleared. + =back =head1 Known Problems @@ -2026,6 +2026,12 @@ PERL_CALLCONV int Perl_magic_clear_all_env(pTHX_ SV* sv, MAGIC* mg) #define PERL_ARGS_ASSERT_MAGIC_CLEAR_ALL_ENV \ assert(sv); assert(mg) +PERL_CALLCONV int Perl_magic_cleararylen_p(pTHX_ SV* sv, MAGIC* mg) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); +#define PERL_ARGS_ASSERT_MAGIC_CLEARARYLEN_P \ + assert(sv); assert(mg) + PERL_CALLCONV int Perl_magic_clearenv(pTHX_ SV* sv, MAGIC* mg) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl index 5d0710f904..bfc13e264d 100644 --- a/regen/mg_vtable.pl +++ b/regen/mg_vtable.pl @@ -121,7 +121,7 @@ my %sig = 'isa' => {set => 'setisa', clear => 'clearisa'}, 'isaelem' => {set => 'setisa'}, 'arylen' => {get => 'getarylen', set => 'setarylen', const => 1}, - 'arylen_p' => {free => 'freearylen_p'}, + 'arylen_p' => {clear => 'cleararylen_p', free => 'freearylen_p'}, 'mglob' => {set => 'setmglob'}, 'nkeys' => {get => 'getnkeys', set => 'setnkeys'}, 'taint' => {get => 'gettaint', set => 'settaint'}, diff --git a/t/op/each_array.t b/t/op/each_array.t index 95710e259e..0c1e0804ea 100644 --- a/t/op/each_array.t +++ b/t/op/each_array.t @@ -9,7 +9,7 @@ use strict; use warnings; use vars qw(@array @r $k $v $c); -plan tests => 57; +plan tests => 63; @array = qw(crunch zam bloop); @@ -137,3 +137,31 @@ for (; $k = each(@array) ;) { is ($k, $v); $v++; } + +# Reset the iterator when the array is cleared [RT #75596] +{ + my @a = 'a' .. 'c'; + my ($i, $v) = each @a; + is ("$i-$v", '0-a'); + @a = 'A' .. 'C'; + ($i, $v) = each @a; + is ("$i-$v", '0-A'); +} + +# Check that the iterator is reset when localization ends +{ + @array = 'a' .. 'c'; + my ($i, $v) = each @array; + is ("$i-$v", '0-a'); + { + local @array = 'A' .. 'C'; + my ($i, $v) = each @array; + is ("$i-$v", '0-A'); + ($i, $v) = each @array; + is ("$i-$v", '1-B'); + } + ($i, $v) = each @array; + is ("$i-$v", '1-b'); + # Explicit reset + while (each @array) { } +} |