summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--embed.fnc1
-rw-r--r--embed.h1
-rw-r--r--mg.c15
-rw-r--r--mg_vtable.h2
-rw-r--r--pod/perldelta.pod10
-rw-r--r--proto.h6
-rw-r--r--regen/mg_vtable.pl2
-rw-r--r--t/op/each_array.t30
8 files changed, 64 insertions, 3 deletions
diff --git a/embed.fnc b/embed.fnc
index 1f62b9d4fc..568c980db6 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 260bee9974..efc19d80f8 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 4424bfebc3..4d6df84d4f 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 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
diff --git a/proto.h b/proto.h
index 3188170b77..6e8ae370fb 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 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) { }
+}