In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/2a05854a1ad5472d00de22f8fcc284cdc8fd1503?hp=6de18f4499a45f0d6876f2aca180b8a9f06e9240>
- Log -----------------------------------------------------------------
commit 2a05854a1ad5472d00de22f8fcc284cdc8fd1503
Merge: 6de18f4499 957ac2541b
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Feb 18 16:41:09 2018 -0800
[Merge] ‘Nonelem’ scalars
commit 957ac2541beb14cbb7de197c83c0f7132c06a9ed
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Feb 18 16:41:02 2018 -0800
perldelta for non-elems
I don’t think the bug involving defelems, which this branch partially
fixes is significant enough to be mentioned in the bugs section.
Likewise, the memory leaks fixed (some of them introduced in the
same dev cycle) are so rare that it would add unnecessary verbiage
to perldelta.
commit 9ef753fe465d865deeba96157242bc98c0afe412
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Feb 18 16:12:11 2018 -0800
Fix ary shifting when sparse ary is passed to sub
This commit fixes #132729 in the specific case where a nonexistent
element within a sparse array is passed to a subroutine.
Prior to this commit,
some_sub($sparse_array[$n])
where $n <= $#sparse_array and the element does not exist, would exhi-
bit erroneous behaviour if some_sub shifted or unshifted the original
@sparse_array. Any ‘holes’ (nonexistent elements) in the array would
show up in @_ as deferred element (defelem) scalars, magic scalars
that remember their index in the array. This index is not updated and
gets out of synch when the array is shifted.
This commit fixes the bug for elements within the array by using the
new ‘nonelem’ magic introduced a few commits ago. It stores within
the array a magic scalar that is marked as being nonexistent.
It also reduced the number of scalars that need to be created if such
a sub call happens repeatedly.
commit 7406cffe8ec122fcc2500115f8ed1742385893e1
Author: Father Chrysostomos <spr...@cpan.org>
Date: Tue Feb 13 13:36:22 2018 -0800
Fix two bugs when calling &xsub when @_ has holes
This fixes #132729 in the particular instance where an XSUB is
called via ampersand syntax when @_ has ‘holes’, or nonexistent ele-
ments, as in:
@_ = ();
$_[1] = 1;
&xsub;
This means that if the XSUB or something it calls unshifts @_, the
first argument passed to the XSUB will now refer to $_[1], not $_[0];
i.e., as of this commit it is correctly shifted over. Previously, a
‘defelem’ was used, which is a magical scalar that remembers its index
in the array, independent of whether the array was shifted.
In addition, the old code failed to mortalize the defelem, so this
commit fixes a memory leak with the new ‘non-elem’ mechanism (a spe-
cially-marked element stored in the array itself).
commit c46431c409d5cdb3c1c17c039a19e0e03356c7a6
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Feb 11 17:14:20 2018 -0800
Test #132729 with array flattening
Other instances of this bug have not yet been fixed. This commit’s
grandparent fixed the case where an array with holes in it is flat-
tened in lvalue context, and then gets shifted/unshifted before
an element is vivified.
commit eb2991224f3c7972426fe6ab6b3fe5c08699e502
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Feb 11 17:01:26 2018 -0800
svleak.t: Test for leak fixed by prev. commit
commit 1f1dcfb516e063c29a4b9823ad97b1fc58ffc930
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Jan 21 21:55:00 2018 -0800
‘Nonelems’ for pushing sparse array on the stack
To avoid having to create deferred elements every time a sparse array
is pushed on to the stack, store a magic scalar in the array itself,
which av_exists and refto recognise as not existing.
This means there is only a one-time cost for putting such arrays on
the stack.
It also means that deferred elements that live long enough don’t
start pointing to the wrong array entry if the array gets shifted (or
unshifted/spliced) in the mean time. Instead, the scalar is already
in the array, so it cannot lose its place. This fix only applies
when the array as a whole is pushed on to the stack, but it could be
extended in future commits to apply to other places where we currently
use deferred elements.
-----------------------------------------------------------------------
Summary of changes:
av.c | 13 +++++++++++++
embed.fnc | 2 ++
embed.h | 2 ++
ext/XS-APItest/APItest.xs | 7 +++++++
mg.c | 9 +++++++++
mg_names.inc | 1 +
mg_raw.h | 2 ++
mg_vtable.h | 5 +++++
pod/perldelta.pod | 13 +++++++++++++
pod/perlguts.pod | 2 ++
pp.c | 2 ++
pp_hot.c | 44 +++++++++++++++++++++++++++----------------
proto.h | 6 ++++++
regen/mg_vtable.pl | 3 +++
t/op/array.t | 48 ++++++++++++++++++++++++++++++++++++++++++++++-
t/op/sub.t | 12 +++++++++++-
t/op/svleak.t | 14 +++++++++++++-
17 files changed, 166 insertions(+), 19 deletions(-)
diff --git a/av.c b/av.c
index ba97fed31c..f6ffea627b 100644
--- a/av.c
+++ b/av.c
@@ -1015,6 +1015,9 @@ Perl_av_exists(pTHX_ AV *av, SSize_t key)
if (key <= AvFILLp(av) && AvARRAY(av)[key])
{
+ if (SvSMAGICAL(AvARRAY(av)[key])
+ && mg_find(AvARRAY(av)[key], PERL_MAGIC_nonelem))
+ return FALSE;
return TRUE;
}
else
@@ -1070,6 +1073,16 @@ Perl_av_iter_p(pTHX_ AV *av) {
}
}
+SV *
+Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
+ SV * const sv = newSV(0);
+ PERL_ARGS_ASSERT_AV_NONELEM;
+ if (!av_store(av,ix,sv))
+ return sv_2mortal(sv); /* has tie magic */
+ sv_magic(sv, NULL, PERL_MAGIC_nonelem, NULL, 0);
+ return sv;
+}
+
/*
* ex: set ts=8 sts=4 sw=4 et:
*/
diff --git a/embed.fnc b/embed.fnc
index e748639e1a..3c66fa426b 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -282,6 +282,7 @@ ApdR |SV** |av_fetch |NN AV *av|SSize_t
key|I32 lval
Apd |void |av_fill |NN AV *av|SSize_t fill
ApdR |SSize_t|av_len |NN AV *av
ApdR |AV* |av_make |SSize_t size|NN SV **strp
+p |SV* |av_nonelem |NN AV *av|SSize_t ix
Apd |SV* |av_pop |NN AV *av
ApdoxM |void |av_create_and_push|NN AV **const avp|NN SV *const val
Apd |void |av_push |NN AV *av|NN SV *val
@@ -1026,6 +1027,7 @@ p |int |magic_freearylen_p|NN SV* sv|NN MAGIC* mg
p |int |magic_setdbline|NN SV* sv|NN MAGIC* mg
p |int |magic_setdebugvar|NN SV* sv|NN MAGIC* mg
p |int |magic_setdefelem|NN SV* sv|NN MAGIC* mg
+p |int |magic_setnonelem|NN SV* sv|NN MAGIC* mg
p |int |magic_setenv |NN SV* sv|NN MAGIC* mg
dp |int |magic_sethint |NN SV* sv|NN MAGIC* mg
p |int |magic_setisa |NN SV* sv|NN MAGIC* mg
diff --git a/embed.h b/embed.h
index b417aaf083..f964e99245 100644
--- a/embed.h
+++ b/embed.h
@@ -1169,6 +1169,7 @@
#define amagic_is_enabled(a) Perl_amagic_is_enabled(aTHX_ a)
#define apply(a,b,c) Perl_apply(aTHX_ a,b,c)
#define av_extend_guts(a,b,c,d,e) Perl_av_extend_guts(aTHX_ a,b,c,d,e)
+#define av_nonelem(a,b) Perl_av_nonelem(aTHX_ a,b)
#define bind_match(a,b,c) Perl_bind_match(aTHX_ a,b,c)
#define boot_core_PerlIO() Perl_boot_core_PerlIO(aTHX)
#define boot_core_UNIVERSAL() Perl_boot_core_UNIVERSAL(aTHX)
@@ -1324,6 +1325,7 @@
#define magic_setlvref(a,b) Perl_magic_setlvref(aTHX_ a,b)
#define magic_setmglob(a,b) Perl_magic_setmglob(aTHX_ a,b)
#define magic_setnkeys(a,b) Perl_magic_setnkeys(aTHX_ a,b)
+#define magic_setnonelem(a,b) Perl_magic_setnonelem(aTHX_ a,b)
#define magic_setpack(a,b) Perl_magic_setpack(aTHX_ a,b)
#define magic_setpos(a,b) Perl_magic_setpos(aTHX_ a,b)
#define magic_setregexp(a,b) Perl_magic_setregexp(aTHX_ a,b)
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 4e5bf3cf1a..1fead70ee9 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -4398,6 +4398,13 @@ get_cv_flags(SV *sv, UV flags)
OUTPUT:
RETVAL
+void
+unshift_and_set_defav(SV *sv,...)
+ CODE:
+ av_unshift(GvAVn(PL_defgv), 1);
+ av_store(GvAV(PL_defgv), 0, newSVuv(42));
+ sv_setuv(sv, 43);
+
PerlIO *
PerlIO_stderr()
diff --git a/mg.c b/mg.c
index c8bb49e27b..331f96639e 100644
--- a/mg.c
+++ b/mg.c
@@ -2527,6 +2527,15 @@ Perl_vivify_defelem(pTHX_ SV *sv)
mg->mg_flags &= ~MGf_REFCOUNTED;
}
+int
+Perl_magic_setnonelem(pTHX_ SV *sv, MAGIC *mg)
+{
+ PERL_ARGS_ASSERT_MAGIC_SETNONELEM;
+ PERL_UNUSED_ARG(mg);
+ sv_unmagic(sv, PERL_MAGIC_nonelem);
+ return 0;
+}
+
int
Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
{
diff --git a/mg_names.inc b/mg_names.inc
index fde6872fa9..7eb9033675 100644
--- a/mg_names.inc
+++ b/mg_names.inc
@@ -45,6 +45,7 @@
{ PERL_MAGIC_vec, "vec(v)" },
{ PERL_MAGIC_utf8, "utf8(w)" },
{ PERL_MAGIC_substr, "substr(x)" },
+ { PERL_MAGIC_nonelem, "nonelem(Y)" },
{ PERL_MAGIC_defelem, "defelem(y)" },
{ PERL_MAGIC_lvref, "lvref(\\)" },
{ PERL_MAGIC_checkcall, "checkcall(])" },
diff --git a/mg_raw.h b/mg_raw.h
index b3e25d646b..2f4863b08e 100644
--- a/mg_raw.h
+++ b/mg_raw.h
@@ -78,6 +78,8 @@
"/* utf8 'w' Cached UTF-8 information */" },
{ 'x', "want_vtbl_substr | PERL_MAGIC_VALUE_MAGIC",
"/* substr 'x' substr() lvalue */" },
+ { 'Y', "want_vtbl_nonelem | PERL_MAGIC_VALUE_MAGIC",
+ "/* nonelem 'Y' Array element that does not exist */" },
{ 'y', "want_vtbl_defelem | PERL_MAGIC_VALUE_MAGIC",
"/* defelem 'y' Shadow \"foreach\" iterator variable / smart parameter
vivification */" },
{ '\\', "want_vtbl_lvref",
diff --git a/mg_vtable.h b/mg_vtable.h
index c71a988cf7..e4f3f3889d 100644
--- a/mg_vtable.h
+++ b/mg_vtable.h
@@ -52,6 +52,7 @@
#define PERL_MAGIC_vec 'v' /* vec() lvalue */
#define PERL_MAGIC_utf8 'w' /* Cached UTF-8 information */
#define PERL_MAGIC_substr 'x' /* substr() lvalue */
+#define PERL_MAGIC_nonelem 'Y' /* Array element that does not exist */
#define PERL_MAGIC_defelem 'y' /* Shadow "foreach" iterator variable /
smart parameter vivification */
#define PERL_MAGIC_lvref '\\' /* Lvalue reference constructor */
@@ -76,6 +77,7 @@ enum { /* pass one of these to get_vtbl */
want_vtbl_lvref,
want_vtbl_mglob,
want_vtbl_nkeys,
+ want_vtbl_nonelem,
want_vtbl_ovrld,
want_vtbl_pack,
want_vtbl_packelem,
@@ -112,6 +114,7 @@ EXTCONST char * const
PL_magic_vtable_names[magic_vtable_max] = {
"lvref",
"mglob",
"nkeys",
+ "nonelem",
"ovrld",
"pack",
"packelem",
@@ -171,6 +174,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max] = {
{ 0, Perl_magic_setlvref, 0, 0, 0, 0, 0, 0 },
{ 0, Perl_magic_setmglob, 0, 0, 0, 0, 0, 0 },
{ Perl_magic_getnkeys, Perl_magic_setnkeys, 0, 0, 0, 0, 0, 0 },
+ { 0, Perl_magic_setnonelem, 0, 0, 0, 0, 0, 0 },
{ 0, 0, 0, 0, Perl_magic_freeovrld, 0, 0, 0 },
{ 0, 0, Perl_magic_sizepack, Perl_magic_wipepack, 0, 0, 0, 0 },
{ Perl_magic_getpack, Perl_magic_setpack, 0, Perl_magic_clearpack, 0, 0, 0,
0 },
@@ -216,6 +220,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max];
#define PL_vtbl_lvref PL_magic_vtables[want_vtbl_lvref]
#define PL_vtbl_mglob PL_magic_vtables[want_vtbl_mglob]
#define PL_vtbl_nkeys PL_magic_vtables[want_vtbl_nkeys]
+#define PL_vtbl_nonelem PL_magic_vtables[want_vtbl_nonelem]
#define PL_vtbl_ovrld PL_magic_vtables[want_vtbl_ovrld]
#define PL_vtbl_pack PL_magic_vtables[want_vtbl_pack]
#define PL_vtbl_packelem PL_magic_vtables[want_vtbl_packelem]
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 00a33b60c2..e640f76c9a 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -390,6 +390,19 @@ A new API function L<perlapi/Perl_setlocale> has been
added.
L<perlapi/sync_locale> has been revised to return a boolean as to
whether the system was using the global locale or not.
+=item *
+
+A new kind of magic scalar, called a "nonelem" scalar, has been introduced.
+It is stored in an array to denote a nonexistent element, whenever such an
+element is accessed in a potential lvalue context. It replaces the
+existing "defelem" (deferred element) magic wherever this is possible,
+being significantly more efficient. This means that
+C<some_sub($sparse_array[$nonelem])> no longer has to create a new magic
+defelem scalar each time, as long as the element is within the array.
+
+It partially fixes the rare bug of deferred elements getting out of synch
+with their arrays when the array is shifted or unshifted. [perl #132729]
+
=back
=head1 Selected Bug Fixes
diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index 54a76dac45..5d11da6bfc 100644
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -1271,6 +1271,8 @@ will be lost.
v PERL_MAGIC_vec vtbl_vec vec() lvalue
w PERL_MAGIC_utf8 vtbl_utf8 Cached UTF-8 information
x PERL_MAGIC_substr vtbl_substr substr() lvalue
+ Y PERL_MAGIC_nonelem vtbl_nonelem Array element that does not
+ exist
y PERL_MAGIC_defelem vtbl_defelem Shadow "foreach" iterator
variable / smart parameter
vivification
diff --git a/pp.c b/pp.c
index b3bf35d17e..4c0a5b34b7 100644
--- a/pp.c
+++ b/pp.c
@@ -467,6 +467,8 @@ S_refto(pTHX_ SV *sv)
else if (SvPADTMP(sv)) {
sv = newSVsv(sv);
}
+ else if (UNLIKELY(SvSMAGICAL(sv) && mg_find(sv, PERL_MAGIC_nonelem)))
+ sv_unmagic(SvREFCNT_inc_simple_NN(sv), PERL_MAGIC_nonelem);
else {
SvTEMP_off(sv);
SvREFCNT_inc_void_NN(sv);
diff --git a/pp_hot.c b/pp_hot.c
index 1b9fb9427a..328d6f0659 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1167,7 +1167,7 @@ S_pushav(pTHX_ AV* const av)
SP[i+1] = LIKELY(svp)
? *svp
: UNLIKELY(PL_op->op_flags & OPf_MOD)
- ? newSVavdefelem(av,i,1)
+ ? av_nonelem(av,i)
: &PL_sv_undef;
}
}
@@ -1178,7 +1178,7 @@ S_pushav(pTHX_ AV* const av)
SP[i+1] = LIKELY(sv)
? sv
: UNLIKELY(PL_op->op_flags & OPf_MOD)
- ? newSVavdefelem(av,i,1)
+ ? av_nonelem(av,i)
: &PL_sv_undef;
}
}
@@ -3630,13 +3630,19 @@ PP(pp_multideref)
if (!defer)
DIE(aTHX_ PL_no_aelem, elem);
len = av_tindex(av);
- sv = sv_2mortal(newSVavdefelem(av,
- /* Resolve a negative index now, unless it points
- * before the beginning of the array, in which
- * case record it for error reporting in
- * magic_setdefelem. */
- elem < 0 && len + elem >= 0
- ? len + elem : elem, 1));
+ /* Resolve a negative index that falls within
+ * the array. Leave it negative it if falls
+ * outside the array. */
+ if (elem < 0 && len + elem >= 0)
+ elem = len + elem;
+ if (elem >= 0 && elem <= len)
+ /* Falls within the array. */
+ sv = av_nonelem(av,elem);
+ else
+ /* Falls outside the array. If it is neg-
+ ative, magic_setdefelem will use the
+ index for error reporting. */
+ sv = sv_2mortal(newSVavdefelem(av,elem,1));
}
else {
if (UNLIKELY(localizing)) {
@@ -5215,7 +5221,7 @@ PP(pp_entersub)
else sv = AvARRAY(av)[i];
if (sv) SP[i+1] = sv;
else {
- SP[i+1] = newSVavdefelem(av, i, 1);
+ SP[i+1] = av_nonelem(av, i);
}
}
SP += items;
@@ -5363,12 +5369,18 @@ PP(pp_aelem)
if (!defer)
DIE(aTHX_ PL_no_aelem, elem);
len = av_tindex(av);
- mPUSHs(newSVavdefelem(av,
- /* Resolve a negative index now, unless it points before the
- beginning of the array, in which case record it for error
- reporting in magic_setdefelem. */
- elem < 0 && len + elem >= 0 ? len + elem : elem,
- 1));
+ /* Resolve a negative index that falls within the array. Leave
+ it negative it if falls outside the array. */
+ if (elem < 0 && len + elem >= 0)
+ elem = len + elem;
+ if (elem >= 0 && elem <= len)
+ /* Falls within the array. */
+ PUSHs(av_nonelem(av,elem));
+ else
+ /* Falls outside the array. If it is negative,
+ magic_setdefelem will use the index for error reporting.
+ */
+ mPUSHs(newSVavdefelem(av, elem, 1));
RETURN;
}
if (UNLIKELY(localizing)) {
diff --git a/proto.h b/proto.h
index 80b9e240b5..d6c36a08fa 100644
--- a/proto.h
+++ b/proto.h
@@ -220,6 +220,9 @@ PERL_CALLCONV AV* Perl_av_make(pTHX_ SSize_t size, SV
**strp)
#define PERL_ARGS_ASSERT_AV_MAKE \
assert(strp)
+PERL_CALLCONV SV* Perl_av_nonelem(pTHX_ AV *av, SSize_t ix);
+#define PERL_ARGS_ASSERT_AV_NONELEM \
+ assert(av)
PERL_CALLCONV SV* Perl_av_pop(pTHX_ AV *av);
#define PERL_ARGS_ASSERT_AV_POP \
assert(av)
@@ -1943,6 +1946,9 @@ PERL_CALLCONV int Perl_magic_setmglob(pTHX_ SV* sv,
MAGIC* mg);
PERL_CALLCONV int Perl_magic_setnkeys(pTHX_ SV* sv, MAGIC* mg);
#define PERL_ARGS_ASSERT_MAGIC_SETNKEYS \
assert(sv); assert(mg)
+PERL_CALLCONV int Perl_magic_setnonelem(pTHX_ SV* sv, MAGIC* mg);
+#define PERL_ARGS_ASSERT_MAGIC_SETNONELEM \
+ assert(sv); assert(mg)
PERL_CALLCONV int Perl_magic_setpack(pTHX_ SV* sv, MAGIC* mg);
#define PERL_ARGS_ASSERT_MAGIC_SETPACK \
assert(sv); assert(mg)
diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl
index 342f5e04c4..f5213b2c21 100644
--- a/regen/mg_vtable.pl
+++ b/regen/mg_vtable.pl
@@ -92,6 +92,8 @@ my %mg =
desc => 'substr() lvalue' },
defelem => { char => 'y', vtable => 'defelem', value_magic => 1,
desc => "Shadow \"foreach\" iterator variable /\nsmart
parameter vivification" },
+ nonelem => { char => 'Y', vtable => 'nonelem', value_magic => 1,
+ desc => "Array element that does not exist" },
arylen => { char => '#', vtable => 'arylen', value_magic => 1,
desc => 'Array length ($#ary)' },
pos => { char => '.', vtable => 'pos', value_magic => 1,
@@ -137,6 +139,7 @@ my %sig =
'pos' => {get => 'getpos', set => 'setpos'},
'uvar' => {get => 'getuvar', set => 'setuvar'},
'defelem' => {get => 'getdefelem', set => 'setdefelem'},
+ 'nonelem' => {set => 'setnonelem'},
'regexp' => {set => 'setregexp', alias => [qw(bm fm)]},
'regdata' => {len => 'regdata_cnt'},
'regdatum' => {get => 'regdatum_get', set => 'regdatum_set'},
diff --git a/t/op/array.t b/t/op/array.t
index aa595327bc..6370a9f072 100644
--- a/t/op/array.t
+++ b/t/op/array.t
@@ -6,7 +6,7 @@ BEGIN {
set_up_inc('.', '../lib');
}
-plan (188);
+plan (194);
#
# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
@@ -642,4 +642,50 @@ $#a = -1; $#a++;
is @a, 0, 'unwinding localization of elem past end of array shrinks it'
}
+# perl #132729, as it applies to flattening an array in lvalue context
+{
+ my @a;
+ $a[1] = 1;
+ map { unshift @a, 7; $_ = 3; goto aftermap; } @a;
+ aftermap:
+ is "[@a]", "[7 3 1]",
+ 'non-elems read from @a do not lose their position';
+ @a = ();
+ $#a++; # make it magical
+ $a[1] = 1;
+ map { unshift @a, 7; $_ = 3; goto aftermath; } @a;
+ aftermath:
+ is "[@a]", "[7 3 1]",
+ 'non-elems read from magical @a do not lose their position';
+}
+# perl #132729, as it applies to ‘holes’ in an array passed to a sub
+# individually
+{
+ my @a;
+ $a[1] = 1;
+ sub { unshift @a, 7; $_[0] = 3; }->($a[0]);
+ is "[@a]", "[7 3 1]",
+ 'holes passed to sub do not lose their position (multideref)';
+ @a = ();
+ $#a++; # make it magical
+ $a[1] = 1;
+ sub { unshift @a, 7; $_[0] = 3; }->($a[0]);
+ is "[@a]", "[7 3 1]",
+ 'holes passed to sub do not lose their position (multideref, mg)';
+}
+{
+ # Again, with aelem, not multideref
+ my @a;
+ $a[1] = 1;
+ sub { unshift @a, 7; $_[0] = 3; }->($a[${\0}]);
+ is "[@a]", "[7 3 1]",
+ 'holes passed to sub do not lose their position (aelem)';
+ @a = ();
+ $#a++; # make it magical
+ $a[1] = 1;
+ sub { unshift @a, 7; $_[0] = 3; }->($a[${\0}]);
+ is "[@a]", "[7 3 1]",
+ 'holes passed to sub do not lose their position (aelem, mg)';
+}
+
"We're included by lib/Tie/Array/std.t so we need to return something true";
diff --git a/t/op/sub.t b/t/op/sub.t
index c8bf72d680..2b8ebcc463 100644
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
set_up_inc('../lib');
}
-plan(tests => 61);
+plan(tests => 62);
sub empty_sub {}
@@ -403,6 +403,16 @@ is ref($main::{rt_129916}), 'CODE', 'simple sub stored as
CV in stash (main::)';
is ref($RT129916::{foo}), 'CODE', 'simple sub stored as CV in stash
(non-main::)';
}
+# Calling xsub via ampersand syntax when @_ has holes
+SKIP: {
+ skip "no XS::APItest on miniperl" if is_miniperl;
+ require XS::APItest;
+ local *_;
+ $_[1] = 1;
+ &XS::APItest::unshift_and_set_defav;
+ is "@_", "42 43 1"
+}
+
# [perl #129090] Crashes and hangs
watchdog 10;
{ no warnings;
diff --git a/t/op/svleak.t b/t/op/svleak.t
index 5d99fddcbe..05ae01f792 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
use Config;
-plan tests => 146;
+plan tests => 148;
# run some code N times. If the number of SVs at the end of loop N is
# greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -214,6 +214,14 @@ leak_expr(5, 0, q{"YYYYYa" =~ /.+?(a(.+?)|b)/ }, "trie
leak");
}
+# Map plus sparse array
+{
+ my @a;
+ $a[10] = 10;
+ leak(3, 0, sub { my @b = map 1, @a },
+ 'map reading from sparse array');
+}
+
SKIP:
{ # broken by 304474c3, fixed by cefd5c7c, but didn't seem to cause
# any other test failures
@@ -318,6 +326,10 @@ leak(2, 0, sub {
bless \&recredef, "Recursive::Redefinition"; eval "sub recredef{}"
}, 'recursive sub redefinition');
+# Sub calls
+leak(2, 0, sub { local *_; $_[1]=1; &re::regname },
+ 'passing sparse array to xsub via ampersand call');
+
# Syntax errors
eleak(2, 0, '"${<<END}"
', 'unterminated here-doc in quotes in multiline eval');
--
Perl5 Master Repository
