From 83f29afad70b612d23a170f28fca57f0c8ca24af Mon Sep 17 00:00:00 2001 From: Vincent Pit Date: Fri, 22 Jun 2012 15:55:55 +0200 Subject: [PATCH] Reset the iterator when an array is cleared This fixes RT #75596. --- embed.fnc | 1 + embed.h | 1 + mg.c | 15 +++++++++++++++ mg_vtable.h | 2 +- pod/perldelta.pod | 10 ++++++++++ proto.h | 6 ++++++ regen/mg_vtable.pl | 2 +- t/op/each_array.t | 30 +++++++++++++++++++++++++++++- 8 files changed, 64 insertions(+), 3 deletions(-) diff --git a/embed.fnc b/embed.fnc index 1f62b9d..568c980 100644 --- a/embed.fnc +++ b/embed.fnc @@ -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 diff --git a/embed.h b/embed.h index 260bee9..efc19d8 100644 --- a/embed.h +++ b/embed.h @@ -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) diff --git a/mg.c b/mg.c index 4424bfe..4d6df84 100644 --- a/mg.c +++ b/mg.c @@ -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 d2379f2..3c73c2b 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 3d1733c..a3ee589 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -342,6 +342,16 @@ C 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 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 are assigned to. In terms of the XS API, it means that C +will now reset the iterator. + +This mirrors the behaviour of the hash iterator when the hash is cleared. + =back =head1 Known Problems diff --git a/proto.h b/proto.h index 3188170..6e8ae37 100644 --- a/proto.h +++ b/proto.h @@ -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 5d0710f..bfc13e2 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 95710e2..0c1e080 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) { } +} -- 1.8.3.1