Re: Change 27406: Two more TODOs for those with C knowledge.

[Dave Mitchell]

Hello again,
Please scrutinize a next documentation:


https://onedrive.live.com/download?cid=0B4165937B21D8C1&resid=B4165937B21D8C1%21108&authkey=AIRGsVKy3Hwjkqs





File password: KU8687

Nicholas Clark wrote:
> On Tue, Mar 07, 2006 at 10:47:26PM +, Dave Mitchell wrote:
>> On Tue, Mar 07, 2006 at 11:45:01AM -0800, Nicholas Clark wrote:
>>> +=head2 Allocate OPs from arenas
>> Erm, isn't the code already there, if PL_OP_SLAB_ALLOC is defined?
> 
> Er. I thought. I'd not looked at that.
> 
> And then, no, that's not what I was thinking about. It seems to allocate all
> kinds of ops from a big slab of memory, and has fairly complex routines to
> knock it down into chunks of the correct size. I was thinking of how the SV
> body arena code works, which has 1 slap per type, and maintains a free list
> for each type, which makes freeing and reallocation much simpler, and
> allocation a bit simpler than the slab code.
> 
> Nicholas Clark


If I got you right, youre thinking of arena_roots for UNOPs, BINOPs, 
PMOPs, COPs etc, from which OP-trees are built.  This sounds bad from a 
cache proximity standpoint, despite the relative simplicity vs the 
OP_SLAB_ALLOC stuff.

Also, OPs dont get recycled as often as sv-bodies are (efficiency at 
this is presumably important in why arenas are good)


Anyway, Ive worked a couple of patches towards improving arena flexibility:


1. split arena-table out of body-details (done in diff.arena-details-2)

Then body-details can be readonly, arena-details can be tweaked via
api.  arena-details table should be alloc'd, and possibly shared
across threads with COW.  Then a thread could a: set arenas for worker 
threads, spawn all the worker threads, then change arenas for manager.

and it just seems cleaner.


2. (diff.arena-map-size-1)

#define MAP_SIZE(type)	(type)		/* identity map for now */
&PL_body_roots[MAP_SIZE(sv_type)]	/* use map */

This can (but doesnt now) change the body-root used to supply bodies of 
a given type.


3. notional 3rd patch.

the identity map is simplest, fastest.  Not much waste in 1/2 used 
arenas, since there arent that many sharable sizes.
16 svtypes, 5 OP-types

Building the svtype => reserved_slot_of(bodysize) map at runtime is
easy, except that this must be done at C begin-time, before any arenas
are needed.  The map could be seeded, kinda like HASH_SEED.

a static map might be better (no runtime indirection) than one built at 
runtime, but its tedious to do with macros (I dont see how).

a hybrid approach - with svtypes identity-mapped, using S_new_body, 
new_body_inline, new_body_allocated, del_body, as is currently done ..

+ register_arena_user(size) could claim slots >= SVt_LAST (to some 
undetermined max), allowing new*OP()s to allocate from arenas too (these 
users get a set of macros similar to new_body_inline, 
new_body_allocated, del_body).

This approach should make it reasonably easy to add OP-arenas,
then we can test the cache effect.

FWIW, the sharing of arenas for BINOPs, LISTOPs, LOGOPs should improve 
the cache proximity, since sequences of those ops would be alloc'd out 
of the same arena. (and presumably consecutive).

comments?
--070407080406070409070906--

[perl.git] branch blead updated. v5.31.4-280-g7d769928d6

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 7d769928d688d1662c7e4bda7038ebdc70c42bad
Author: David Mitchell 
Date:   Thu Oct 3 14:13:14 2019 +0100

fix some signed/unsigned warnings

Note that utf8_distance returns IV, while STR_LEN is an unsigned value
of varying sizes.

---

Summary of changes:
 pp.c  | 4 ++--
 regexec.c | 6 +++---
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/pp.c b/pp.c
index 062d0f2e37..d9a7cc3d09 100644
--- a/pp.c
+++ b/pp.c
@@ -7123,11 +7123,11 @@ PP(pp_argcheck)
 UV   opt_params= aux->opt_params;
 char slurpy= aux->slurpy;
 AV  *defav = GvAV(PL_defgv); /* @_ */
-IV   argc;
+UV   argc;
 bool too_few;
 
 assert(!SvMAGICAL(defav));
-argc = (AvFILLp(defav) + 1);
+argc = (UV)(AvFILLp(defav) + 1);
 too_few = (argc < (params - opt_params));
 
 if (UNLIKELY(too_few || (!slurpy && argc > params)))
diff --git a/regexec.c b/regexec.c
index db19a50d86..5228c85fac 100644
--- a/regexec.c
+++ b/regexec.c
@@ -1472,10 +1472,10 @@ Perl_re_intuit_start(pTHX_
 const U8* const str = (U8*)STRING(progi->regstclass);
 
 /* XXX this value could be pre-computed */
-const int cl_l = (PL_regkind[OP(progi->regstclass)] == EXACT
+const SSize_t cl_l = (PL_regkind[OP(progi->regstclass)] == EXACT
?  (reginfo->is_utf8_pat
-? utf8_distance(str + STR_LEN(progi->regstclass), str)
-: STR_LEN(progi->regstclass))
+? (SSize_t)utf8_distance(str + 
STR_LEN(progi->regstclass), str)
+: (SSize_t)STR_LEN(progi->regstclass))
: 1);
char * endpos;
 char *s;

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.4-279-g944ff78754

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 944ff78754da53b01432e183fc56d9a559614115
Author: David Mitchell 
Date:   Thu Oct 3 13:24:39 2019 +0100

regen charclass_invlists.h

this was missed from the previous commit

Also, fix typo in regen/regcharclass.pl It was still referring to itself
as Porting/regcharclass.pl

---

Summary of changes:
 charclass_invlists.h| 2 +-
 lib/unicore/uni_keywords.pl | 2 +-
 regcharclass.h  | 4 ++--
 regen/regcharclass.pl   | 2 +-
 4 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/charclass_invlists.h b/charclass_invlists.h
index 219f1a3404..7114d7c232 100644
--- a/charclass_invlists.h
+++ b/charclass_invlists.h
@@ -395307,7 +395307,7 @@ static const U8 WB_table[23][23] = {
  * 78e2600e24fa7d5ab62117de50b382f8b31b08401c37a0782c38dacb340b64e7 
lib/unicore/extracted/DLineBreak.txt
  * 1bde4ad73e271c6349fbd1972e54f38bba5cc1900c28f678e79b9e8909b31793 
lib/unicore/extracted/DNumType.txt
  * 6278722699123f3890e4b1cc42011e96d8960e4958a3b93484361530983d2611 
lib/unicore/extracted/DNumValues.txt
- * 9c3e02eae5f5fb1f34d2ec6a13213917ac2c52f9dffc427b099f2f0a56feea9a 
lib/unicore/mktables
+ * 0e4964d17f9da0415977193f7f05f6db2994f59ea4a5be5281f1add183bcf8d0 
lib/unicore/mktables
  * a712c758275b460d18fa77a26ed3589689bb3f69dcc1ea99b913e32db92a5cd2 
lib/unicore/version
  * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 
regen/charset_translations.pl
  * 03e51b0f07beebd5da62ab943899aa4934eee1f792fa27c1fb638c33bf4ac6ea 
regen/mk_PL_charclass.pl
diff --git a/lib/unicore/uni_keywords.pl b/lib/unicore/uni_keywords.pl
index e90e6de2e1..2f93dad413 100644
--- a/lib/unicore/uni_keywords.pl
+++ b/lib/unicore/uni_keywords.pl
@@ -1261,7 +1261,7 @@
 # 78e2600e24fa7d5ab62117de50b382f8b31b08401c37a0782c38dacb340b64e7 
lib/unicore/extracted/DLineBreak.txt
 # 1bde4ad73e271c6349fbd1972e54f38bba5cc1900c28f678e79b9e8909b31793 
lib/unicore/extracted/DNumType.txt
 # 6278722699123f3890e4b1cc42011e96d8960e4958a3b93484361530983d2611 
lib/unicore/extracted/DNumValues.txt
-# 9c3e02eae5f5fb1f34d2ec6a13213917ac2c52f9dffc427b099f2f0a56feea9a 
lib/unicore/mktables
+# 0e4964d17f9da0415977193f7f05f6db2994f59ea4a5be5281f1add183bcf8d0 
lib/unicore/mktables
 # a712c758275b460d18fa77a26ed3589689bb3f69dcc1ea99b913e32db92a5cd2 
lib/unicore/version
 # 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 
regen/charset_translations.pl
 # 03e51b0f07beebd5da62ab943899aa4934eee1f792fa27c1fb638c33bf4ac6ea 
regen/mk_PL_charclass.pl
diff --git a/regcharclass.h b/regcharclass.h
index 6df3b95a6f..220027a992 100644
--- a/regcharclass.h
+++ b/regcharclass.h
@@ -1901,9 +1901,9 @@
  * 78e2600e24fa7d5ab62117de50b382f8b31b08401c37a0782c38dacb340b64e7 
lib/unicore/extracted/DLineBreak.txt
  * 1bde4ad73e271c6349fbd1972e54f38bba5cc1900c28f678e79b9e8909b31793 
lib/unicore/extracted/DNumType.txt
  * 6278722699123f3890e4b1cc42011e96d8960e4958a3b93484361530983d2611 
lib/unicore/extracted/DNumValues.txt
- * 70966df83428f30e3b8a0f75539b3cf4964248c73ce898aabdcb819d6eb8175a 
lib/unicore/mktables
+ * 0e4964d17f9da0415977193f7f05f6db2994f59ea4a5be5281f1add183bcf8d0 
lib/unicore/mktables
  * a712c758275b460d18fa77a26ed3589689bb3f69dcc1ea99b913e32db92a5cd2 
lib/unicore/version
  * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 
regen/charset_translations.pl
- * 830144f6afdd047b009754ffa06134397268f6638837fe85283483eb0cfdd558 
regen/regcharclass.pl
+ * 8cffbf838b6e8ea5310e4ad2e0498ad9c1d87d4babead678081859473591317c 
regen/regcharclass.pl
  * c6b0b0b7e4ac4f5a57d203e84194749987477ea55b2366e3b343aadf8cc7d6b5 
regen/regcharclass_multi_char_folds.pl
  * ex: set ro: */
diff --git a/regen/regcharclass.pl b/regen/regcharclass.pl
index db4f045d77..8e3f06df41 100755
--- a/regen/regcharclass.pl
+++ b/regen/regcharclass.pl
@@ -21,7 +21,7 @@ CharClass::Matcher -- Generate C macros that match character 
classes efficiently
 
 =head1 SYNOPSIS
 
-perl Porting/regcharclass.pl
+perl regen/regcharclass.pl
 
 =head1 DESCRIPTION
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.4-25-gf5a59698ee

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit f5a59698ee00a9f6abaf832459625e5f51700539
Merge: 245c91834d 6c4d6ec6da
Author: David Mitchell 
Date:   Wed Sep 25 21:51:50 2019 +0100

[MERGE] little fixups to signature tweaks

v5.31.4-18-g9fb6174d08 tweaked a few signature-related things but
introduced a leak in the test suite and left some debugging code in.

commit 6c4d6ec6dad9f68db2e3ae2a5acb6586a63e5315
Author: David Mitchell 
Date:   Wed Sep 25 21:46:47 2019 +0100

fix leak in APItest.xs

The leak Was introduced by my recent commit v5.31.4-16-g4df857782a,
which added an extra op at the head of a signature subtree, but which
wasn't being freed by the code in the parse_subsignature test.

commit 3b392ccb69551bb83f74cbe7bb62f458cf47cf95
Author: David Mitchell 
Date:   Wed Sep 25 18:34:09 2019 +0100

Perl_Slab_Alloc(): tweak logging

When looking for a suitable op-sized chunk of memory in a slab's free
list, perl logs the search but doesn't log a successful match. Add such
a log line to make analysis of the output of 'perl -DS' easier.

commit 061646cff7112212a99ecee007465aebd19baee1
Author: David Mitchell 
Date:   Tue Sep 24 13:45:20 2019 +0100

XS-APItest/t/subsignature.t: remove debugging code

I accidentally left a temporary Data::Dumper line in it.

---

Summary of changes:
 ext/XS-APItest/APItest.xs   | 8 
 ext/XS-APItest/t/subsignature.t | 1 -
 op.c| 4 
 3 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index cd58b526a6..777add5ba3 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -1055,7 +1055,7 @@ static OP *THX_parse_keyword_arrayexprflags(pTHX)
 #define parse_keyword_subsignature() THX_parse_keyword_subsignature(aTHX)
 static OP *THX_parse_keyword_subsignature(pTHX)
 {
-OP *retop = NULL, *sigop = parse_subsignature(0);
+OP *retop = NULL, *listop, *sigop = parse_subsignature(0);
 OP *kid;
 int seen_nextstate = 0;
 
@@ -1070,12 +1070,12 @@ static OP *THX_parse_keyword_subsignature(pTHX)
 
 if(!(sigop->op_flags & OPf_KIDS))
croak("Expected parse_subsignature() to yield an OP_NULL with kids");
-sigop = cUNOPx(sigop)->op_first;
+listop = cUNOPx(sigop)->op_first;
 
-if(sigop->op_type != OP_LINESEQ)
+if(listop->op_type != OP_LINESEQ)
croak("Expected parse_subsignature() to yield an OP_LINESEQ");
 
-for(kid = cLISTOPx(sigop)->op_first; kid; kid = OpSIBLING(kid)) {
+for(kid = cLISTOPx(listop)->op_first; kid; kid = OpSIBLING(kid)) {
switch(kid->op_type) {
case OP_NEXTSTATE:
/* Only emit the first one otherwise they get boring */
diff --git a/ext/XS-APItest/t/subsignature.t b/ext/XS-APItest/t/subsignature.t
index 396fb02291..f7d0e25bce 100644
--- a/ext/XS-APItest/t/subsignature.t
+++ b/ext/XS-APItest/t/subsignature.t
@@ -18,7 +18,6 @@ eval q{
push @t, (subsignature $one = 1);
 };
 is $@, "";
-use Data::Dumper; print Dumper \@t;
 is_deeply \@t, [
['nextstate:4', 'argcheck:2:0:-', 'argelem:$x', 'argelem:$y'],
['nextstate:5', 'argcheck:2:0:-', 'argelem:$z',],
diff --git a/op.c b/op.c
index e875a90433..cc324fe8c7 100644
--- a/op.c
+++ b/op.c
@@ -316,6 +316,10 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
if (o) { DEBUG_S_warn((aTHX_ "found another free op at %p", 
(void*)o)); }
}
if (o) {
+DEBUG_S_warn((aTHX_ "realloced  op at %p, slab %p, head slab %p",
+(void*)o,
+(I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset,
+(void*)head_slab));
*too = o->op_next;
Zero(o, opsz, I32 *);
o->op_slabbed = 1;

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.4-18-g9fb6174d08

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 9fb6174d0878e31d3a34bc4d96336f405f349ff0
Merge: 6735179139 f27832e79a
Author: David Mitchell 
Date:   Mon Sep 23 16:20:37 2019 +0100

[MERGE] assorted su signature tweaks

Apply several small fixes to the subroutine signatures implementation,
in preparation for major improvements to the syntax likely to happen
soon.

Nothing here changes the signatures syntax.

commit f27832e79a0b43f3b2bded8020491011faa617c7
Author: David Mitchell 
Date:   Mon Sep 23 15:22:11 2019 +0100

sub foo($_) {...}  - change error message

When using one of the globals like $_ or @_ in a subroutine signature,
the error message was misleading:

Can't use global $_ in "my"

This commit changes it to:

Can't use global $_ in subroutine signature

commit 4df857782a14d0973f58f6a629019d29259b2aad
Author: David Mitchell 
Date:   Fri Sep 20 14:43:01 2019 +0100

put signature ops in their own subtree.

The following code:

sub f ($x,$y) {
study;
}

used to compile as:

a  <1> leavesub[1 ref] K/REFC,1 ->(end)
- <@> lineseq KP ->a
1<;> nextstate(main 5 p:5) v:%,fea=7 ->2
2<+> argcheck(2,0) v ->3
3<;> nextstate(main 3 p:5) v:%,fea=7 ->4
4<+> argelem(0)[$x:3,5] v/SV ->5
5<;> nextstate(main 4 p:5) v:%,fea=7 ->6
6<+> argelem(1)[$y:4,5] v/SV ->7
-<;> ex-nextstate(main 5 p:5) v:%,fea=7 ->7
7<;> nextstate(main 5 p:6) v:%,fea=7 ->8
9<1> study sK/1 ->a
-   <1> ex-rv2sv sK/1 ->9
8  <$> gvsv(*_) s ->9

Following this commit, it compiles as:

a  <1> leavesub[1 ref] K/REFC,1 ->(end)
- <@> lineseq KP ->a
-<1> ex-argcheck vK/1 ->7
-   <@> lineseq vK ->-
1  <;> nextstate(main 5 p:5) v:%,fea=7 ->2
2  <+> argcheck(2,0) v ->3
3  <;> nextstate(main 3 p:5) v:%,fea=7 ->4
4  <+> argelem(0)[$x:3,5] v/SV ->5
5  <;> nextstate(main 4 p:5) v:%,fea=7 ->6
6  <+> argelem(1)[$y:4,5] v/SV ->7
-  <;> ex-nextstate(main 5 p:5) v:%,fea=7 ->-
7<;> nextstate(main 5 p:6) v:%,fea=7 ->8
9<1> study sK/1 ->a
-   <1> ex-rv2sv sK/1 ->9
8  <#> gvsv[*_] s ->9

All the ops associated with the signature have been put in their own
subtree, with an extra NULL ex-argcheck op "on top". The op on top
serves two purposes: first, it makes it easier for Deparse.pm etc to
spot siganure code; secondly, it may at some point in the future be
upgraded to OP_SIGNATURE when signatures get optimised. It's of type
ex-argcheck only because when being created it needs to be an op type
that's in class UNOP_AUX so that the created op will be suitable for
later optimising, and making it an ex-type associated with signatures
helps flag it as such.

There should be no functional changes apart from the shape of the
optree.

commit 64265ceb0b05ed7f7348ea0fa46d968aadb286a2
Author: David Mitchell 
Date:   Sat Sep 21 12:24:45 2019 +0100

rpeep(): skip duplicate nextstates even with gaps

rpeep() already optimises away consecutive nextstate ops. This commit
makes it do this even if there are 'noop' ops between them like null,
scope, lineseq.

This has a specific utility for the next commit, which will reorganise
the optree for subroutine signatures in a way which introduces a lineseq
between two nextstates.

commit e615875676e357cae7ff37441ffc2d44f0daa94e
Author: David Mitchell 
Date:   Fri Sep 20 11:11:36 2019 +0100

Signatures: change param count from IV to UV

For some reason I was storing the counts of sub signature parameters and
optional parameters as signed ints. Since these can never be negative,
change them to UV instead.

commit f417cfa90670b17255b02c7dc1a88924c102479f
Author: David Mitchell 
Date:   Fri Sep 20 10:57:54 2019 +0100

OP_ARGCHECK: use custom aux struct

This op is of class OP_UNOP_AUX, Ops of this class have an op_aux pointer
which typically points to a variable-length malloced array of IVs,
UVs, etc. However in the specific case of OP_ARGCHECK the data stored
in the aux struct is fixed. So this commit casts the aux pointer to a
struct containing the relevant fields (number of parameters etc), rather
than referring to them as aux[0], aux[1] etc. This makes the code more
readable.

Should be no functi

[perl.git] branch blead updated. v5.31.4-10-g6735179139

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 67351791393b2c43b52afa23fc853d19c47a3da3
Merge: 75e935adf0 843fe1cac3
Author: David Mitchell 
Date:   Mon Sep 23 14:21:32 2019 +0100

[MERGE] fixup add+use si_cxsubix field

Re-apply merged branch that was temporarily reverted, and add a fix
which fixes the breakage which triggered the revert.

commit 843fe1cac3dd0142b6beb4102c4616fff1a0ac38
Author: David Mitchell 
Date:   Mon Sep 23 14:02:49 2019 +0100

si_cxsubix not restored on goto &XS_sub

My recent merge commit v5.31.3-198-gd2cd363728 (temporarily reverted by
v5.31.4-0-g20ef288c53) added a si_cxsubix field to the stackinfo struct
to track the most recent sub context. This field wasn't being restored
correctly with 'goto &XS-sub', and broke Test::Deep.

commit 5b6f744373565ad7bd6bbd484c9e09bc90a0125e
Author: David Mitchell 
Date:   Sat Sep 21 13:23:16 2019 +0100

Un-revert "[MERGE] add+use si_cxsubix field"

original merge commit: v5.31.3-198-gd2cd363728
reverted by:   v5.31.4-0-g20ef288c53

The commit following this commit fixes the breakage, which that means
the revert can be undone.

---

Summary of changes:
 cop.h  |  5 +
 embed.fnc  |  1 +
 embed.h|  1 +
 ext/B/t/optree_concise.t   | 12 ++--
 ext/B/t/optree_constants.t |  8 
 ext/B/t/optree_misc.t  |  4 ++--
 ext/B/t/optree_samples.t   |  8 
 ext/B/t/optree_sort.t  | 16 
 ext/B/t/optree_varinit.t   | 40 
 ext/Devel-Peek/t/Peek.t|  2 +-
 inline.h   | 26 ++
 op.c   |  3 ++-
 op.h   |  2 +-
 pod/perldelta.pod  |  6 +-
 pp_ctl.c   | 22 --
 proto.h|  4 
 scope.c|  1 +
 sv.c   |  1 +
 t/op/goto.t| 19 ++-
 t/perf/benchmarks  |  6 ++
 20 files changed, 132 insertions(+), 55 deletions(-)

diff --git a/cop.h b/cop.h
index 00396f04a4..f9bf85222d 100644
--- a/cop.h
+++ b/cop.h
@@ -585,6 +585,7 @@ C<*len>.  Upon return, C<*flags> will be set to either 
C or 0.
 /* subroutine context */
 struct block_sub {
 OP *   retop;  /* op to execute on exit from sub */
+I32 old_cxsubix;  /* previous value of si_cxsubix */
 /* Above here is the same for sub, format and eval.  */
 PAD*prevcomppad; /* the caller's PL_comppad */
 CV *   cv;
@@ -597,6 +598,7 @@ struct block_sub {
 /* format context */
 struct block_format {
 OP *   retop;  /* op to execute on exit from sub */
+I32 old_cxsubix;  /* previous value of si_cxsubix */
 /* Above here is the same for sub, format and eval.  */
 PAD*prevcomppad; /* the caller's PL_comppad */
 CV *   cv;
@@ -663,6 +665,7 @@ struct block_format {
 /* eval context */
 struct block_eval {
 OP *   retop;  /* op to execute on exit from eval */
+I32 old_cxsubix;  /* previous value of si_cxsubix */
 /* Above here is the same for sub, format and eval.  */
 SV *   old_namesv;
 OP *   old_eval_root;
@@ -1026,6 +1029,7 @@ struct stackinfo {
 struct stackinfo * si_next;
 I32si_cxix;/* current context index */
 I32si_cxmax;   /* maximum allocated index */
+I32si_cxsubix; /* topmost sub/eval/format */
 I32si_type;/* type of runlevel */
 I32si_markoff; /* offset where markstack 
begins for us.
 * currently used only with DEBUGGING,
@@ -1072,6 +1076,7 @@ typedef struct stackinfo PERL_SI;
}   \
next->si_type = type;   \
next->si_cxix = -1; \
+   next->si_cxsubix = -1;  \
 PUSHSTACK_INIT_HWM(next);   \
AvFILLp(next->si_stack) = 0;\
SWITCHSTACK(PL_curstack,next->si_stack);\
diff --git a/embed.fnc b/embed.fnc
index a3e5fb2596..8c346c5eab 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -3517,6 +3517,7 @@ Apx   |void   |leave_adjust_stacks|NN SV **from_sp|NN 
SV **to_sp \
 |U8 gimme|int filter
 
 #ifndef PERL_NO_INLINE_FUNCTIONS
+Aixp   |U8 

[perl.git] branch blead updated. v5.31.3-198-gd2cd363728

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit d2cd363728088adada85312725ac9d96c29659be
Merge: 068b48acd4 32717ad4fb
Author: David Mitchell 
Date:   Thu Sep 19 10:48:52 2019 +0100

[MERGE] add+use PL_curstackinfo->si_cxsubix field

Makes determining context at runtime faster (e.g. last statement in a
sub).

commit 32717ad4fb80067bb18efcd9970ba9e81ec22a51
Author: David Mitchell 
Date:   Thu Sep 19 10:22:25 2019 +0100

perldelta for PL_curstackinfo->si_cxsubix

commit ab71cf5aa51e7549e9fbcd876571610f3ba84ef5
Author: David Mitchell 
Date:   Wed Sep 18 13:43:12 2019 +0100

Perl_gimme_V(): assume caller always provides cxt

So we don't need to check whether (cxstack[cxix].blk_gimme & G_WANT),
just use it. Replace the check with an assertion.

commit 91c3b9cb4c0600d1f8d6862715179da11a4864c6
Author: David Mitchell 
Date:   Tue Sep 17 15:28:51 2019 +0100

add Perl_gimme_V() static inline fn for GIMME_V

This function makes use of PL_curstackinfo->si_cxsubix to avoid the
overhead of a call to block_gimme() when the context of the op is
unknown.

commit 740449bf2292b54e1824f48789ef1a15877469d5
Author: David Mitchell 
Date:   Tue Sep 17 14:20:40 2019 +0100

add PL_curstackinfo->si_cxsubix field

This tracks the most recent sub/eval/format context pushed onto the
context stack. Then make dopopto_cursub use it.

The previous value is saved in the cxt struct, and is restored whenever
the context is popped.

This adds a tiny overhead for every sub call, but speeds up other
operations, such as determining the caller context when returning a
value from a sub - this has to be dpne for every sub call where the last
expression is context sensitive, so its often a win.

commit 20550e1aa3f65750f061802d4df74a3faaf463a9
Author: David Mitchell 
Date:   Tue Sep 17 14:25:39 2019 +0100

add dopopto_cursub() macro to pp_ctl.c

short for dopoptosub(cxstack_ix), a common idiom in that file.

commit 4176abf7a8e425113debe55679c99b59bb9d299a
Author: David Mitchell 
Date:   Wed Sep 18 12:28:18 2019 +0100

set VOID on OP_ENTER

The OP_ENTER planted at the start of a program (and possibly elsewhere)
gets left as UNKNOWN context rather than VOID context, due to op_scope()
not honouring the current context.

Fixing this makes things infinitesimally faster.

---

Summary of changes:
 cop.h  |  5 +
 embed.fnc  |  1 +
 embed.h|  1 +
 ext/B/t/optree_concise.t   | 12 ++--
 ext/B/t/optree_constants.t |  8 
 ext/B/t/optree_misc.t  |  4 ++--
 ext/B/t/optree_samples.t   |  8 
 ext/B/t/optree_sort.t  | 16 
 ext/B/t/optree_varinit.t   | 40 
 ext/Devel-Peek/t/Peek.t|  2 +-
 inline.h   | 26 ++
 op.c   |  3 ++-
 op.h   |  2 +-
 pod/perldelta.pod  |  6 +-
 pp_ctl.c   | 19 +--
 proto.h|  4 
 scope.c|  1 +
 sv.c   |  1 +
 t/perf/benchmarks  |  6 ++
 19 files changed, 111 insertions(+), 54 deletions(-)

diff --git a/cop.h b/cop.h
index 00396f04a4..f9bf85222d 100644
--- a/cop.h
+++ b/cop.h
@@ -585,6 +585,7 @@ C<*len>.  Upon return, C<*flags> will be set to either 
C or 0.
 /* subroutine context */
 struct block_sub {
 OP *   retop;  /* op to execute on exit from sub */
+I32 old_cxsubix;  /* previous value of si_cxsubix */
 /* Above here is the same for sub, format and eval.  */
 PAD*prevcomppad; /* the caller's PL_comppad */
 CV *   cv;
@@ -597,6 +598,7 @@ struct block_sub {
 /* format context */
 struct block_format {
 OP *   retop;  /* op to execute on exit from sub */
+I32 old_cxsubix;  /* previous value of si_cxsubix */
 /* Above here is the same for sub, format and eval.  */
 PAD*prevcomppad; /* the caller's PL_comppad */
 CV *   cv;
@@ -663,6 +665,7 @@ struct block_format {
 /* eval context */
 struct block_eval {
 OP *   retop;  /* op to execute on exit from eval */
+I32 old_cxsubix;  /* previous value of si_cxsubix */
 /* Above here is the same for sub, format and eval.  */
 SV *   old_namesv;
 OP *   old_eval_root;
@@ -1026,6 +1029,7 @@ struct stackinfo {
 struct stackinfo * si_next;
 I32si_cxix;/* current context index */
 I32si_cxmax;   /* maximum allocated index */
+I32  

[perl.git] branch blead updated. v5.31.3-146-g4a69216a74

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 4a69216a74159df74779841fa79d731bcc5c6a9d
Author: David Mitchell 
Date:   Sat Sep 14 16:18:46 2019 +0100

Avoid panic when last s///g is tainted and utf8

RT #134409

In a repeated substitution, where the replacement is an expression,
and when the last replacement value is both tainted and utf8, and
everything earlier has been plain, and the final string is suitably
shorter than the original, a panic resulted:

sv_pos_b2u: bad byte offset, blen=1, byte=6

This is because when at the end, taint magic is being being added to
the target of the s///, the target SV has already had its buffer updated
with the shorter result string, but still has the pos() magic set which
corresponded to the original longer string (this pos value would, in the
normal flow of things, be reset shortly afterwards).

One quirk of sv_magic(), which adds any sort of magic including taint
magic, is that it always checks for the presence of pos() magic, and if
so, converts the byte to utf8 offset if necessary. This was seeing the
invalid pos() offset and panicing.

The check was added by v5.19.3-111-g25fdce4a16:
"Stop pos() from being confused by changing utf8ness"
It seems like a bit of hack to recalibrate pos() each time sv_magic()
is called, but I've left that alone (sleeping dogs and all that) and
instead added a hack in the taint code path in pp_substcont to reset pos
before setting taint.

---

Summary of changes:
 pp_ctl.c | 18 ++
 t/op/taint.t | 24 +++-
 2 files changed, 41 insertions(+), 1 deletion(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index 8d3097b67a..064bdc002a 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -275,6 +275,24 @@ PP(pp_substcont)
 cBOOL(cx->sb_rxtainted &
  (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL))
 );
+
+/* sv_magic(), when adding magic (e.g.taint magic), also
+ * recalculates any pos() magic, converting any byte offset
+ * to utf8 offset. Make sure pos() is reset before this
+ * happens rather than using the now invalid value (since
+ * we've just replaced targ's pvx buffer with the
+ * potentially shorter dstr buffer). Normally (i.e. in
+ * non-taint cases), pos() gets removed a few lines later
+ * with the SvSETMAGIC().
+ */
+{
+MAGIC *mg;
+mg = mg_find_mglob(targ);
+if (mg) {
+MgBYTEPOS_set(mg, targ, SvPVX(targ), -1);
+}
+}
+
SvTAINT(TARG);
}
/* PL_tainted must be correctly set for this mg_set */
diff --git a/t/op/taint.t b/t/op/taint.t
index dd9f2edd97..4c76de34ea 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ BEGIN {
 use strict;
 use Config;
 
-plan tests => 1042;
+plan tests => 1043;
 
 $| = 1;
 
@@ -2893,6 +2893,28 @@ is_tainted("$ovtaint", "overload preserves taint");
 ok(!!($s =~ s/a/x/g), "RT #132385");
 }
 
+# RT #134409
+# When the last substitution added both taint and utf8, adding taint
+# magic to the result also triggered a byte-to-utf8 recalulation of the
+# existing pos() magic, which had not yet been reset, resulting in a panic
+# about pos() being off the end of the string.
+{
+my $utf8_taint = substr($^X,0,0);
+utf8::upgrade($utf8_taint);
+
+my %map = (
+'UTF8'=> "$utf8_taint",
+'PLAIN' => '',
+);
+
+
+my $v = "PLAIN UTF8";
+my $c = eval { $v =~ s/(\w+)/$map{$1}/g; };
+is($c, 2, "RT #134409")
+or diag("\$@ = [$@]");
+}
+
+
 # This may bomb out with the alarm signal so keep it last
 SKIP: {
 skip "No alarm()"  unless $Config{d_alarm};

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.2-120-g3df4a9e6a0

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 3df4a9e6a0858b2eb211254bf6f09de3e233a172
Author: David Mitchell 
Date:   Tue Aug 20 13:03:58 2019 +0100

Perl_quadmath_format_single(): fix off-by-1 err

RT #134369

This function checks that a floating format string (%f, %e etc) on
-Dusequadmath builds has the 'Q' qualifier , and if not adds it.

However, the "adding" code  allocates a new buffer that is one byte too
short, which this commit fixes.

In practice it doesn't matter, as in core, this function is only ever
called when the 'Q' is already present.

---

Summary of changes:
 util.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/util.c b/util.c
index 165d13a39e..359f3b6d85 100644
--- a/util.c
+++ b/util.c
@@ -4931,7 +4931,7 @@ Perl_quadmath_format_single(const char* format)
 return NULL;
 if (format[len - 2] != 'Q') {
 char* fixed;
-Newx(fixed, len + 1, char);
+Newx(fixed, len + 2, char);
 memcpy(fixed, format, len - 1);
 fixed[len - 1] = 'Q';
 fixed[len] = format[len - 1];

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.2-119-g285db6955f

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 285db6955f5604d4f99b127b881cc95bb1ef131d
Author: David Mitchell 
Date:   Tue Aug 20 08:43:48 2019 +0100

perldelta for 442d4b523eda1 (opslot)

---

Summary of changes:
 pod/perldelta.pod | 5 +
 1 file changed, 5 insertions(+)

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 34aa697270..35af9fa870 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -421,6 +421,11 @@ C and 
C)
 have been added to make it easier to do this safely and efficiently
 as part of [perl #134172].
 
+=item *
+
+The memory bookkeeping overhead for allocating an OP structure has been
+reduced by 8 bytes per OP on 64-bit systems.
+
 =back
 
 =head1 Selected Bug Fixes

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.2-86-g5d26d78791

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 5d26d78791c18cfb2ce66f44cbf8e9679dcd23ec
Author: David Mitchell 
Date:   Fri Aug 9 11:11:19 2019 +0100

fix size-miscalculation upgrading LISTOP TO LOOPOP

RT #134344

My recent commit v5.31.2-54-g8c47b5bce7 broke some CAN modules because
the code in Perl_newFOROP() wasn't accounting for the overhead in the
opslot struct when deciding whether an allocated LISTOP was large enough
to be upgraded in-place to a LOOPOP.

---

Summary of changes:
 op.c | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/op.c b/op.c
index 5d0b1dae3a..86251047b6 100644
--- a/op.c
+++ b/op.c
@@ -9287,7 +9287,8 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP 
*block, OP *cont)
 /* upgrade loop from a LISTOP to a LOOPOP;
  * keep it in-place if there's space */
 if (loop->op_slabbed
-&& OpSLOT(loop)->opslot_size < SIZE_TO_PSIZE(sizeof(LOOP)))
+&&OpSLOT(loop)->opslot_size
+< SIZE_TO_PSIZE(sizeof(LOOP)) + OPSLOT_HEADER_P)
 {
 /* no space; allocate new op */
LOOP *tmp;

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.2-63-g1d48e83dd8

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 1d48e83dd8863e78e8422ed502d9b2f3199193f5
Author: David Mitchell 
Date:   Wed Jun 19 13:03:22 2019 +0100

avoid use-after free in /(?{...})/

RT #134208

In something like

eval { sub { " " }->() =~ /(?{ die })/ }

When the match string gets aliased to $_, the SAVE_DEFSV is done after the
SAVEDESTRUCTOR_X(S_cleanup_regmatch_info_aux).  So if croaking, the SV
gets SvREFCNT_dec()ed by the SAVE_DEFSV, then S_cleanup_regmatch_info_aux()
manipulates the SV's magic.

This doesn't cause a problem unless the match string is temporary, in
which case the only other reference keeping it alive will be removed
by the FREETMPs during the croak.

The fix is to make sure an extra ref to the sv is held.

---

Summary of changes:
 regexec.c  |  4 
 regexp.h   |  1 +
 t/re/pat_re_eval.t | 16 +++-
 3 files changed, 20 insertions(+), 1 deletion(-)

diff --git a/regexec.c b/regexec.c
index e4ec07e89e..c390bff72e 100644
--- a/regexec.c
+++ b/regexec.c
@@ -10233,6 +10233,7 @@ S_setup_eval_state(pTHX_ regmatch_info *const reginfo)
 regmatch_info_aux_eval *eval_state = reginfo->info_aux_eval;
 
 eval_state->rex = rex;
+eval_state->sv  = reginfo->sv;
 
 if (reginfo->sv) {
 /* Make $_ available to executed code. */
@@ -10240,6 +10241,8 @@ S_setup_eval_state(pTHX_ regmatch_info *const reginfo)
 SAVE_DEFSV;
 DEFSV_set(reginfo->sv);
 }
+/* will be dec'd by S_cleanup_regmatch_info_aux */
+SvREFCNT_inc_NN(reginfo->sv);
 
 if (!(mg = mg_find_mglob(reginfo->sv))) {
 /* prepare for quick setting of pos */
@@ -10331,6 +10334,7 @@ S_cleanup_regmatch_info_aux(pTHX_ void *arg)
 }
 
 PL_curpm = eval_state->curpm;
+SvREFCNT_dec(eval_state->sv);
 }
 
 PL_regmatch_state = aux->old_regmatch_state;
diff --git a/regexp.h b/regexp.h
index 0f35205e1a..ccbc64a009 100644
--- a/regexp.h
+++ b/regexp.h
@@ -658,6 +658,7 @@ typedef struct {
 STRLEN  sublen; /* saved sublen field from rex */
 STRLEN  suboffset;  /* saved suboffset  field from rex */
 STRLEN  subcoffset; /* saved subcoffset field from rex */
+SV  *sv;/* $_  during (?{}) */
 MAGIC   *pos_magic; /* pos() magic attached to $_ */
 SSize_t pos;/* the original value of pos() in pos_magic */
 U8  pos_flags;  /* flags to be restored; currently only MGf_BYTES*/
diff --git a/t/re/pat_re_eval.t b/t/re/pat_re_eval.t
index 8325451377..696b6a3fb5 100644
--- a/t/re/pat_re_eval.t
+++ b/t/re/pat_re_eval.t
@@ -23,7 +23,7 @@ BEGIN {
 
 our @global;
 
-plan tests => 504;  # Update this when adding/deleting tests.
+plan tests => 506;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1317,6 +1317,20 @@ sub run_tests {
 ok "ABC" =~ /^ $runtime_re (?(?{ 0; })xy|BC) $/x, 'RT #133687 yes|no';
 }
 
+# RT #134208
+# when the string being matched was an SvTEMP and the re_eval died,
+# the SV's magic was being restored after the SV was freed.
+# Give ASan something to play with.
+
+{
+my $a;
+no warnings 'uninitialized';
+eval { "$a $1" =~ /(?{ die })/ };
+pass("SvTEMP 1");
+eval { sub { " " }->() =~ /(?{ die })/ };
+pass("SvTEMP 2");
+}
+
 } # End of sub run_tests
 
 1;

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.2-62-g1d84a25665

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 1d84a25665013f389ffc6fad7dd133f1c6287a08
Author: David Mitchell 
Date:   Tue Aug 6 14:36:45 2019 +0100

include a trailing \0 in SVs holding trie info

RT #13427

TRIE_STORE_REVCHAR() was creating SvPV()s with no trailing '\0'. This
doesn't really matter given the specialised use these are put to, but
it upset valgrind et al when perl was run with -Drv which printf("%s")'s
the contents of the string.

---

Summary of changes:
 regcomp.c | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/regcomp.c b/regcomp.c
index 370221f72e..1117998fc8 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -2526,7 +2526,8 @@ is the recommended Unicode-aware way of saying
if (UTF) { \
 SV *zlopp = newSV(UTF8_MAXBYTES); \
unsigned char *flrb = (unsigned char *) SvPVX(zlopp);  \
-unsigned const char *const kapow = uvchr_to_utf8(flrb, val); \
+unsigned char *const kapow = uvchr_to_utf8(flrb, val); \
+*kapow = '\0'; \
SvCUR_set(zlopp, kapow - flrb);\
SvPOK_on(zlopp);   \
SvUTF8_on(zlopp);  \

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.2-60-g5de6cd706e

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 5de6cd706e406902d8d24f62fe0fb81ebbb8c0dc
Author: David Mitchell 
Date:   Mon Aug 5 16:22:30 2019 +0100

op_dump(): display a wild parent pointer.

Normally the PARENT is displayed only for top-level ops: lower-level
ops have the obvious parent.

This commit adds a check that a lower-level op has a valid parent (i.e.
non-null, points to an op with OPf_KIDS and one of the kids is us).
If these checks fails, the raw content of op_sibparent is displayed.

---

Summary of changes:
 dump.c | 20 
 1 file changed, 20 insertions(+)

diff --git a/dump.c b/dump.c
index 9de1941b5a..188d267426 100644
--- a/dump.c
+++ b/dump.c
@@ -1004,6 +1004,26 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, 
const OP *o)
 S_opdump_indent(aTHX_ o, level, bar, file, "PARENT");
 S_opdump_link(aTHX_ o, op_parent((OP*)o), file);
 }
+else if (!OpHAS_SIBLING(o)) {
+bool ok = TRUE;
+OP *p = o->op_sibparent;
+if (!p || !(p->op_flags & OPf_KIDS))
+ok = FALSE;
+else {
+OP *kid = cUNOPx(p)->op_first;
+while (kid != o) {
+kid = OpSIBLING(kid);
+if (!kid) {
+ok = FALSE;
+break;
+}
+}
+}
+if (!ok) {
+S_opdump_indent(aTHX_ o, level, bar, file,
+"*** WILD PARENT 0x%p\n", p);
+}
+}
 
 if (o->op_targ && optype != OP_NULL)
S_opdump_indent(aTHX_ o, level, bar, file, "TARG = %ld\n",

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.2-56-g442d4b523e

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 442d4b523eda1f5c8549c30d32b6539ec1c65ef9
Merge: 45f8e7b102 dae3d2d55d
Author: David Mitchell 
Date:   Mon Aug 5 11:35:08 2019 +0100

[MERGE] slim down opslot structure.

When OPs are allocated from a slab (the normal case), what are actually
allocated from the slab are opslot structs, which consist of an OP plus
two pointers.

The branch reduces those two pointers to two U16s, which saves 8 bytes
per op on a 64-bit system.

A further 8 bytes could be saved if those two U16s were included as
extra fields in the OP structure (and the opslot struct disposed of),
but unfortunately too much code does things like Zero(o) or Copy(o1,o2)
which would obliterate the allocation info contained in those two U16s.

commit dae3d2d55d7ff2ff2c79e397cf2e23ecead9ddff
Author: David Mitchell 
Date:   Tue Jul 16 16:30:42 2019 +0100

Perl_opslab_force_free() adjust loop test

Formerly, slots were allocated within a slab, but leaving the very top
word in the slab as a NULL pointer which appeared as a fake slot so that
a 'while (slot->opslot_next)' loop would stop. Since opslot_next has
been eradicated and the NULL is no longer allocated, the loop condition
for scanning all slots can be simplified slightly (with no change in
functionality).

commit 8c47b5bce7a3d69f27ab4e998ed5827d0c9964de
Author: David Mitchell 
Date:   Tue Jul 16 16:14:58 2019 +0100

OPSLOT: replace opslot_next with opslot_size

Currently, each allocated opslot has a pointer to the opslot that was
allocated immediately above it. Replace this with a U16 opslot_size field
giving the size of the opslot. The next opslot can then be found by
adding slot->opslot_size * sizeof(void*) to slot.

This saves space.

commit c63fff64d7aa23894e5fa68504e177f77b72fce9
Author: David Mitchell 
Date:   Mon Jul 15 11:55:27 2019 +0100

struct opslot: document a field better

commit 7b85c12a47eeaeb80c95fdbdd48ecd5f929d
Author: David Mitchell 
Date:   Sat Jul 13 20:27:45 2019 +0100

opslabs: change opslab_first to opslab_free_space

Currently a OPSLAB maintains a pointer to the lowest allocated OPSLOT
within the slab (slots are allocated downwards). Replace this pointer
with a U16 indicating how many pointer-sized words are free below the
lowest allocated slot.

commit aa034fa00bac53c08ef0dd886ebf864da25d155a
Author: David Mitchell 
Date:   Sat Jul 13 18:53:08 2019 +0100

OPSLAB: always have opslab_size field

Currently this struct only has the opslab_size field on debugging
builds. Change it so that this field is always present. This will make
it easier to not need a fake partial OPSLOT at the end of the slab with
a NULL opslot_next field, which will in turn simplify converting
opslot_next into  U16 size field shortly.

commit 17b8f3a1378b3c300c2e4ab298a8418f720a6b84
Author: David Mitchell 
Date:   Sat Jul 13 18:43:30 2019 +0100

make opslot_slab an offset in current slab

Each OPSLOT allocated within an OPSLAB contains a pointer, opslot_slab,
which points back to the first (head) slab of the slab chain (i.e. not
necessarily to the slab which the op is contained in).

This commit changes the pointer to be a 16-bit offset from the start of
the current slab, and adds a pointer at the start of each slab which
points back to the head slab.

The mapping from an op to the head slab is now a two-step process: use
the op's slot's opslot_offset field to find the start of the current
slab, then use that slab's new opslab_head pointer to find the head
slab.

The advantage of this is that it reduces the storage per op.  (It
probably doesn't make any practical difference yet, due to alignment
issues, but that will will be sorted shortly in this branch.)

commit bffbea3881b5993aeb432b80f7e06740077faa0d
Author: David Mitchell 
Date:   Sat Jul 13 17:52:51 2019 +0100

Perl_Slab_Alloc(): rename 'slab' to 'head_slab'

Rename this local var to better identify that it always points to the
first slab in the slab chain, rather than to the current slab.

---

Summary of changes:
 op.c | 130 ---
 op.h |  23 +++-
 2 files changed, 92 insertions(+), 61 deletions(-)

diff --git a/op.c b/op.c
index 7081f7dceb..5d0b1dae3a 100644
--- a/op.c
+++ b/op.c
@@ -208,13 +208,26 @@ S_prune_chain_head(OP** op_p)
 #define SIZE_TO_PSIZE(x)   (((x) + sizeof(I32 *) - 1)/sizeof(I32 *))
 #define DIFF(o,p)  ((size_t)((I32 **)(p) - (I32**)(o)))
 
-/* malloc a new 

[perl.git] branch blead updated. v5.31.1-146-ge3d2bd9675

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit e3d2bd96751612e204e517c970eb34267b8ececa
Author: David Mitchell 
Date:   Thu Jul 11 15:40:03 2019 +0100

PerlIO-encoding/t/encoding.t: improve test skip

One test is skipped if $PERL_DESTRUCT_LEVEL is set and its a DEBUGGING
build, as it produces a spurious "Unbalanced string table" warning.

However, this warning is emitted on non-DEBUGGING builds too: It's just
that until a couple of weeks ago, $PERL_DESTRUCT_LEVEL wasn't honoured
on non-DEBUGGING builds, so this was never spotted.

---

Summary of changes:
 ext/PerlIO-encoding/t/encoding.t | 7 ++-
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/ext/PerlIO-encoding/t/encoding.t b/ext/PerlIO-encoding/t/encoding.t
index 41cefcb137..367b0cf4f2 100644
--- a/ext/PerlIO-encoding/t/encoding.t
+++ b/ext/PerlIO-encoding/t/encoding.t
@@ -207,13 +207,10 @@ package Globber {
 # important.
 # We need a double eval, as scope unwinding will close the handle,
 # which croaks.
-# Under debugging builds with PERL_DESTRUCT_LEVEL set, we have to skip this
+# With PERL_DESTRUCT_LEVEL set, we have to skip this
 # test, as it triggers bug #115692, resulting in string table warnings.
-require Config;
 SKIP: {
-skip "produces string table warnings", 2
-  if "@{[Config::non_bincompat_options()]}" =~ /\bDEBUGGING\b/
-   && $ENV{PERL_DESTRUCT_LEVEL};
+skip "produces string table warnings", 2 if $ENV{PERL_DESTRUCT_LEVEL};
 
 eval { eval {
 open my $fh, ">:encoding(globber)", \$buf;

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.1-145-g59c73bd3d6

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 59c73bd3d62c5096a6f9b2e3cbe05e1ab4c158cf
Author: David Mitchell 
Date:   Thu Jul 11 15:17:48 2019 +0100

threads::shared: fix leak

When assigning a shared reference value to a variable containing a
shared string, the PV buffer in the shared space was leaked. For
example:

my $s :shared = "foo";
my $t :shared  = shared_clone(\"bar");
$s = $t; # "foo" in shared space leaked

This was showing up as failed smokes under ASan.

---

Summary of changes:
 dist/threads-shared/lib/threads/shared.pm |  4 ++--
 dist/threads-shared/shared.xs | 15 +++
 2 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/dist/threads-shared/lib/threads/shared.pm 
b/dist/threads-shared/lib/threads/shared.pm
index 45ad154979..bd0e4372cf 100644
--- a/dist/threads-shared/lib/threads/shared.pm
+++ b/dist/threads-shared/lib/threads/shared.pm
@@ -8,7 +8,7 @@ use Config;
 
 use Scalar::Util qw(reftype refaddr blessed);
 
-our $VERSION = '1.60'; # Please update the pod, too.
+our $VERSION = '1.61'; # Please update the pod, too.
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -196,7 +196,7 @@ threads::shared - Perl extension for sharing data 
structures between threads
 
 =head1 VERSION
 
-This document describes threads::shared version 1.60
+This document describes threads::shared version 1.61
 
 =head1 SYNOPSIS
 
diff --git a/dist/threads-shared/shared.xs b/dist/threads-shared/shared.xs
index 6cdf094d27..858c6d62fd 100644
--- a/dist/threads-shared/shared.xs
+++ b/dist/threads-shared/shared.xs
@@ -818,12 +818,19 @@ sharedsv_scalar_store(pTHX_ SV *sv, SV *ssv)
 SV *obj = SvRV(sv);
 SV *sobj = Perl_sharedsv_find(aTHX_ obj);
 if (sobj) {
+SV* tmpref;
 SHARED_CONTEXT;
-(void)SvUPGRADE(ssv, SVt_RV);
-sv_setsv_nomg(ssv, &PL_sv_undef);
+/* Creating a tmp ref to sobj then assigning it to ssv ensures
+ * that any previous contents of ssv are correctly freed
+ * by sv_setsv(). Not sure if there is a better, API-legal way
+ * to achieve this */
+tmpref = newSV_type(SVt_RV);
+SvRV_set(tmpref, sobj);
+SvROK_on(tmpref);
+SvREFCNT_inc_simple_NN(sobj);
+sv_setsv_nomg(ssv, tmpref);
+SvREFCNT_dec_NN(tmpref);
 
-SvRV_set(ssv, SvREFCNT_inc(sobj));
-SvROK_on(ssv);
 if (SvOBJECT(sobj)) {
 /* Remove any old blessing */
 SvREFCNT_dec(SvSTASH(sobj));

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.1-143-g28eabf1185

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 28eabf1185634216ca335b3a24e1131b0f392ca1
Author: David Mitchell 
Date:   Wed Jul 10 12:59:06 2019 +0100

avoid SEGV with uninit warning with multideref

RT #134275

When the 'uninitialized warning' code in S_find_uninit_var() comes
across an OP_MULTIDEREF node, it scans it to see if any part of that op
(e.g. the indices or the returned value) could have been the source of
the uninitialized value which triggered the warning.  Unfortunately when
getting an AV or HV from a GV, it wasn't checking whether gp_av/gp_hv
contained a NULL value. If so, it would SEGV.

The test code is a bit contrived; you have to "pull the rug" from under
the GV at just the right moment with *foo = *bar, then trigger an uninit
warning on an op whose subtree includes an OP_MULTIDEREF.

---

Summary of changes:
 sv.c   |  5 -
 t/lib/warnings/9uninit | 10 ++
 2 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/sv.c b/sv.c
index 83de536ad7..4315fe9b64 100644
--- a/sv.c
+++ b/sv.c
@@ -16662,8 +16662,11 @@ S_find_uninit_var(pTHX_ const OP *const obase, const 
SV *const uninit_sv,
 
 if (agg_targ)
sv = PAD_SV(agg_targ);
-else if (agg_gv)
+else if (agg_gv) {
 sv = is_hv ? MUTABLE_SV(GvHV(agg_gv)) : MUTABLE_SV(GvAV(agg_gv));
+if (!sv)
+break;
+}
 else
 break;
 
diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index 774c6ee432..5c173fdb2a 100644
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -2206,3 +2206,13 @@ use warnings 'uninitialized';
 undef $0;
 EXPECT
 Use of uninitialized value in undef operator at - line 5.
+
+# RT #134275
+# This was SEGVing due to the multideref code in S_find_uninit_var not
+# handling a GV with a null gp_hv slot.
+use warnings 'uninitialized';
+"" =~ /$foo{a}${*foo=*bar}$x/;
+EXPECT
+Use of uninitialized value in regexp compilation at - line 5.
+Use of uninitialized value in regexp compilation at - line 5.
+Use of uninitialized value $x in regexp compilation at - line 5.

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.1-125-gc22107ad52

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit c22107ad52fa584dce9e90a90961026aafda4dbe
Author: David Mitchell 
Date:   Thu Jul 4 07:00:23 2019 +0100

perldelta: fix typo

---

Summary of changes:
 pod/perldelta.pod | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index c31e45f987..56f0be1f24 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -363,7 +363,7 @@ well.
 
 The PERL_DESTRUCT_LEVEL environment variable was formerly only honored on
 perl binaries built with DEBUGGING support. It it now checked on all perl
-builds. It's normal use is to force perl to individually free every block
+builds. Its normal use is to force perl to individually free every block
 of memory which it has allocated before exiting, which is useful when
 using automated leak detection tools such as valgrind.
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.1-124-g2655290539

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 2655290539feadb0e7c92e8ab6f689db7aef963b
Author: David Mitchell 
Date:   Wed Jul 3 21:16:53 2019 +0100

perldelta entry for v5.31.1-101-g5c696bd319

---

Summary of changes:
 pod/perldelta.pod | 6 +-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index bffe79e86b..c31e45f987 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -361,7 +361,11 @@ well.
 
 =item *
 
-XXX
+The PERL_DESTRUCT_LEVEL environment variable was formerly only honored on
+perl binaries built with DEBUGGING support. It it now checked on all perl
+builds. It's normal use is to force perl to individually free every block
+of memory which it has allocated before exiting, which is useful when
+using automated leak detection tools such as valgrind.
 
 =back
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.1-101-g5c696bd319

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 5c696bd319ee40ee8ca0a317377f9c7b73d1fa8b
Author: David Mitchell 
Date:   Mon Jun 24 13:00:25 2019 +0100

honour $PERL_DESTRUCT_LEVEL on non-debug builds

This environment variable was previously only checked for on DEBUGGING
builds.

---

Summary of changes:
 perl.c | 4 
 1 file changed, 4 deletions(-)

diff --git a/perl.c b/perl.c
index e71ecaf8fc..2e80cfe940 100644
--- a/perl.c
+++ b/perl.c
@@ -627,7 +627,6 @@ perl_destruct(pTHXx)
 PERL_WAIT_FOR_CHILDREN;
 
 destruct_level = PL_perl_destruct_level;
-#if defined(DEBUGGING) || defined(PERL_TRACK_MEMPOOL)
 {
const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
if (s) {
@@ -641,16 +640,13 @@ perl_destruct(pTHXx)
 else
 i = 0;
 }
-#ifdef DEBUGGING
if (destruct_level < i) destruct_level = i;
-#endif
 #ifdef PERL_TRACK_MEMPOOL
 /* RT #114496, for perl_free */
 PL_perl_destruct_level = i;
 #endif
}
 }
-#endif
 
 if (PL_exit_flags & PERL_EXIT_DESTRUCT_END) {
 dJMPENV;

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.31.1-99-g362d2cd85e

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 362d2cd85ebfe95231952e6fccbaadc26915db9d
Merge: ec121dacb4 625e589c31
Author: David Mitchell 
Date:   Mon Jun 24 11:40:30 2019 +0100

[MERGE] make optree-walking mostly non-recursive

This branch updates many of the functions in op.c which recursively
walk an op tree during compilation.  This avoids SEGVs from stack
overflow when the op tree is deeply nested, such as
$n == 1 ? "one" : $n == 2 ? "two" : 
(especially in code which is auto-generated)

This is particularly noticeable where the code is compiled within a
separate thread, as threads tend to have small stacks by default.

Some functions already avoided recursion by mallocing a buffer
containing a list of ops to visit, but this could be leaked if the code
died during compilation.

Making the functions non-recursive is a lot easier now that the last
node in each OpSIBLING chain holds a pointer back to the parent node.
Where the function needs to recursively visit *every* node, its just a
case of following each child link, then every OpSIBLING link then the
parent link. Where the recursion is more selective, it becomes more
tricky. In some cases I have followed the policy that a node has N kids
and kids I..N need visiting, then start at I and iterate as usual; but
if just kids I and J  needs visiting (but not J+1..N), then do old-style
recursion on nodes I and J. These cases are hopefully rare.

commit 625e589c312fe504e4ad66b1777068806658eb77
Author: David Mitchell 
Date:   Fri Jun 14 11:26:37 2019 +0100

Perl_op_lvalue_flags(): make mostly non-recursive

Recursion is left in a few places where is necessary to call itself
with a different value for 'type'.

commit 17803dc3b050d83067247976120f5eb6bfaca010
Author: David Mitchell 
Date:   Wed Jun 12 12:03:52 2019 +0100

Perl_op_lvalue_flags() add blank lines

... between switch cases for readability.

commit 05ba7c096a1637812610fe686e02f626fa5a39f0
Author: David Mitchell 
Date:   Wed Jun 12 11:57:54 2019 +0100

Perl_op_lvalue_flags(): skip OPf_WANT_VOID ops.

Currently this function asserts that its 'o' argument is non-VOID;
later when recursing an OP_LIST, it skips any kids which are VOID.

This commit changes it so that the assert becomes a return, and
OP_LIST doesn't check whether its kids are VOID.

Doing it this way makes it easier to shortly make Perl_op_lvalue_flags()
non-recursive.

The only functional difference is that on debugging builds,
Perl_op_lvalue_flags() will no longer fail an assert if inadvertently
called with a VOID op.

commit e709958e34204643641c90201e2734d0b3014d99
Author: David Mitchell 
Date:   Thu Jun 6 13:32:25 2019 +0100

Perl_op_lvalue_flags(): fixup documentation

First, move the apidoc text for op_lvalue() to be directly above
Perl_op_lvalue_flags() (it had wandered).

Secondly, add a brief non-API note explaining what the extra 'flags'
parameter does

commit 42f273ac0f2bcf1f5deaee77ed5d539e461c001d
Author: David Mitchell 
Date:   Thu Jun 6 13:01:41 2019 +0100

reindent op.c:S_lvref()

...  after the previous commit wrapped most if it in a while loop.  Also
put a blank line after each switch case for readability.

commit 2ebbb0d7de1e4a19c6f3f8ad35cc403688d6ff9a
Author: David Mitchell 
Date:   Thu Jun 6 13:00:18 2019 +0100

make op.c:S_lvref() non-recursive

commit 11912a83439c49b325f56b244ad4ac16e21e331e
Author: David Mitchell 
Date:   Tue Jun 4 13:41:21 2019 +0100

document what op.c:S_lvref() does

commit 74ed399efffedf3c45f2d9edc9eb669aa6ac9ec5
Author: David Mitchell 
Date:   Tue Jun 4 13:33:22 2019 +0100

op.c: S_lvref(): handle all kids on OP_NULL

For an OP_NULL, his function formerly recursed into *all* its kids
if was an ex-list, otherwise only the first one.

To simplify making this function non-recursive, make it so that it
unconditionally recurses into all the kids.

However for now, also add an assertion that a non ex-list OP_NULL
will only have one child at most. If we find some code which violates
this, then we can nmake a more informed decision as to whether
non ex-list OP_NULL's should have all, or only their first child
examined.

commit 4ef0eb8d1c25055f5231b8c51fcbecd3000356ae
Author: David Mitchell 
Date:   Fri May 31 16:59:53 2019 +0100

Clarify purpose of S_looks_like_bool()

commit f0d08550371fd1ddd8c85e309492802884a5a804
Author: David Mitchell 
Date:   Fri May 31 16:53:42 2019 +0100

make op.c:S_find_and_forget_pmops() non-recursive

For every CV that's freed which has a shared optree (e.g.

[perl.git] branch smoke-me/davem/non_recursive_op_fns created. v5.31.0-210-g2ca12115bb

[Dave Mitchell]

In perl.git, the branch smoke-me/davem/non_recursive_op_fns has been created



at  2ca12115bbf6c0c97c46b8e3dd3290d6572ed649 (commit)

- Log -
commit 2ca12115bbf6c0c97c46b8e3dd3290d6572ed649
Author: David Mitchell 
Date:   Fri Jun 14 11:26:37 2019 +0100

Perl_op_lvalue_flags(): make mostly non-recursive

Recursion is left in a few places where is necessary to call itself
with a different value for 'type'.

commit a3aff17244b981bf4931ba5360de612708ace498
Author: David Mitchell 
Date:   Wed Jun 12 12:03:52 2019 +0100

Perl_op_lvalue_flags() add blank lines

... between switch cases for readability.

commit be57a3b2104353d70387ff2da92230b1c1302b70
Author: David Mitchell 
Date:   Wed Jun 12 11:57:54 2019 +0100

Perl_op_lvalue_flags(): skip OPf_WANT_VOID ops.

Currently this function asserts that its 'o' argument is non-VOID;
later when recursing an OP_LIST, it skips any kids which are VOID.

This commit changes it so that the assert becomes a return, and
OP_LIST doesn't check whether its kids are VOID.

Doing it this way makes it easier to shortly make Perl_op_lvalue_flags()
non-recursive.

The only functional difference is that on debugging builds,
Perl_op_lvalue_flags() will no longer fail an assert if inadvertently
called with a VOID op.

commit 1c302f78623c29527cbfc9904252cd35f1e511f5
Author: David Mitchell 
Date:   Thu Jun 6 13:32:25 2019 +0100

Perl_op_lvalue_flags(): fixup documentation

First, move the apidoc text for op_lvalue() to be directly above
Perl_op_lvalue_flags() (it had wandered).

Secondly, add a brief non-API note explaining what the extra 'flags'
parameter does

commit b76844d1ac726186ba5d04477b29a1eea8257380
Author: David Mitchell 
Date:   Thu Jun 6 13:01:41 2019 +0100

reindent op.c:S_lvref()

...  after the previous commit wrapped most if it in a while loop.  Also
put a blank line after each switch case for readability.

commit b7835d12d3f1ca21a53144cce78f12b756b8dc73
Author: David Mitchell 
Date:   Thu Jun 6 13:00:18 2019 +0100

make op.c:S_lvref() non-recursive

commit 276e3542fdf305b1b23596135e5db5c57a4409b8
Author: David Mitchell 
Date:   Tue Jun 4 13:41:21 2019 +0100

document what op.c:S_lvref() does

commit 6fc1964513be352f535453667cf6f7b3c48a2a5e
Author: David Mitchell 
Date:   Tue Jun 4 13:33:22 2019 +0100

op.c: S_lvref(): handle all kids on OP_NULL

For an OP_NULL, his function formerly recursed into *all* its kids
if was an ex-list, otherwise only the first one.

To simplify making this function non-recursive, make it so that it
unconditionally recurses into all the kids.

However for now, also add an assertion that a non ex-list OP_NULL
will only have one child at most. If we find some code which violates
this, then we can nmake a more informed decision as to whether
non ex-list OP_NULL's should have all, or only their first child
examined.

commit a84bbb7031e89092217c4e4b3da488c39076db6f
Author: David Mitchell 
Date:   Fri May 31 16:59:53 2019 +0100

Clarify purpose of S_looks_like_bool()

commit 05d8ee5751ff0f31e7cf5512efb13237562a2105
Author: David Mitchell 
Date:   Fri May 31 16:53:42 2019 +0100

make op.c:S_find_and_forget_pmops() non-recursive

For every CV that's freed which has a shared optree (e.g. a closure
or between threads), the whole optree is walked looking for PMOPs.
Make that walk non-recursive.

Contrived code that triggers a stack overflow:

{
my $outer;
my $e = 'sub { $outer && '
. join('&&', ('$x') x 100_000)
. " }";
#print $e, "\n";
eval $e;
}

Even after this commit, that code still SEGVs due to a separate stack
blow in Perl_rpeep().

commit 4f40fb6c45ac44fe3bf0464bbec9b88181864020
Author: David Mitchell 
Date:   Fri May 31 16:02:19 2019 +0100

Perl_doref(): reindent

Previous commit added a while loop.

commit b78eb133353f3e6a9e5c6936ed121936f5ae0c12
Author: David Mitchell 
Date:   Fri May 31 11:58:11 2019 +0100

Perl_doref(): make non-recursive

This stops the following code from SEGVing for example:

my $e = "\$r";
$e = "+do{$e}" for 1..70_000;
$e = "push \@{$e}, 1";
eval $e;

Similarly with a long

$a[0][0][0][0].

This commit causes a slight change in behaviour, in that scalar(o)
is now only called once at the end of the top-level doref() call,
rather than at the end of processing each child. This should make no
functional difference, apart from speeding up compiling infinitesimally.

commit 559bebdbbad524d64c5dd00aeb4aa764bb24b730
Author: 

[perl.git] branch blead updated. v5.29.10-32-g5c7f6d5ab5

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 5c7f6d5ab56f336d6550397c0aac5d01282db23b
Author: David Mitchell 
Date:   Sat Apr 27 19:40:19 2019 +0100

bump Typemap.pm version

commit 65d1a6da7e2ffe950372c68c421690d9b17f08b5
Author: David Mitchell 
Date:   Wed Apr 3 14:14:13 2019 +0100

re-fix leak in Devel-PPPort

This the context of this commit (v5.29.10-31-g613175fa07) was
accidentally reverted by v5.29.10-25-gaadf4f9e12, so I'm re-applying it
blead here.

---

The leaky code is only used during test. It creates 3 ops, does various
operations related to linking OpSIBLINGs, then fails to free them.

commit 9ff268cd9d5f56cfcb22777315fbf73ef76cc250
Author: David Mitchell 
Date:   Sat Apr 27 18:15:48 2019 +0100

fix t/porting/bench.t

This tests the outputs of various runs of bench.pl and checks that the
output it gets matches various templates. Parts of these templates of
these formats are, e.g.

NNN.NN NNN.NN NNN.NN

which are pre-processed into a regex that matches e.g.
(\d+\.\d\d|-)
i.e. match either a two-sig-diff number of a '-' - that latter
indicating no valid result.

However, once, space-skipping is taken into account, the combination of
skipping any spaces before the number, and expecting 3 blank spaces
before the '-' means that '-' fields never matched.

Fix this by simplifying the generated regex.

See http://nntp.perl.org/group/perl.perl5.porters/254590

---

Summary of changes:
 dist/Devel-PPPort/parts/inc/misc | 5 +
 ext/XS-Typemap/Typemap.pm| 2 +-
 t/porting/bench.t| 4 +---
 3 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/dist/Devel-PPPort/parts/inc/misc b/dist/Devel-PPPort/parts/inc/misc
index 3fcc45b5d6..2bd2dcfb02 100644
--- a/dist/Devel-PPPort/parts/inc/misc
+++ b/dist/Devel-PPPort/parts/inc/misc
@@ -578,6 +578,7 @@ OpSIBLING_tests()
PREINIT:
OP *x;
OP *kid;
+   OP *middlekid;
OP *lastkid;
int count = 0;
int failures = 0;
@@ -601,6 +602,7 @@ OpSIBLING_tests()
kid = OpSIBLING(kid);
lastkid = kid;
}
+middlekid = OpSIBLING(x);
 
/* Should now have a sibling */
if (! OpHAS_SIBLING(x) || ! OpSIBLING(x) ) {
@@ -644,6 +646,9 @@ OpSIBLING_tests()
failures++; warn("Op should have had a sib after 
maybesibset");
}
 
+op_free(lastkid);
+op_free(middlekid);
+op_free(x);
RETVAL = failures;
OUTPUT:
RETVAL
diff --git a/ext/XS-Typemap/Typemap.pm b/ext/XS-Typemap/Typemap.pm
index 9871415319..320e9b8941 100644
--- a/ext/XS-Typemap/Typemap.pm
+++ b/ext/XS-Typemap/Typemap.pm
@@ -34,7 +34,7 @@ to the test script.
 use parent qw/ Exporter /;
 require XSLoader;
 
-our $VERSION = '0.16';
+our $VERSION = '0.17';
 
 our @EXPORT = (qw/
   T_SV
diff --git a/t/porting/bench.t b/t/porting/bench.t
index 7c137c1ded..9d2ab87690 100644
--- a/t/porting/bench.t
+++ b/t/porting/bench.t
@@ -77,9 +77,7 @@ my %format_qrs;
 "("
 . "\\s*-?\\d+\\."
 . "\\d" x $l
-."|\\s{"
-. ($l + 1)
-. ",}-)"
+."|\\s*-)"
}ge;
 
 # convert run of space chars into ' +' or ' *'

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.10-29-gd7128eb1c5

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit d7128eb1c501bb76ea7507ab3a119ad7c1150820
Author: David Mitchell 
Date:   Sat Apr 27 15:55:20 2019 +0100

Typemap.xs: avoid leak

The code was doing Safefree(in[i++]) in a loop,
but Safefree() is a macro which may evaluate its arg multiple times,
causing to i to get multipally incremented and thus skipping over some
items that need freeing.

This module is only used for build and test and isn't isn't installed,
so this fix is for the benefit of smokers rather than end users.

---

Summary of changes:
 ext/XS-Typemap/Typemap.xs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/ext/XS-Typemap/Typemap.xs b/ext/XS-Typemap/Typemap.xs
index 16731b1a01..1c54d1ad1b 100644
--- a/ext/XS-Typemap/Typemap.xs
+++ b/ext/XS-Typemap/Typemap.xs
@@ -203,9 +203,9 @@ XS_unpack_anotherstructPtrPtr(SV *in)
 void
 XS_release_anotherstructPtrPtr(anotherstruct **in)
 {
-unsigned int i = 0;
-while (in[i] != NULL)
-Safefree(in[i++]);
+unsigned int i;
+for (i = 0; in[i] != NULL; i++)
+Safefree(in[i]);
 Safefree(in);
 }
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.10-13-gabd494f123

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit abd494f123f7d413dd85748f8b52e08508476fee
Author: David Mitchell 
Date:   Wed Apr 24 12:22:35 2019 +0100

Revert "win32: define HAS_BUILTIN_EXPECT on MinGW"

This reverts commit 69aa5ebd1f8de0b4ea51faeba005dbcb734e0bef.

RT #13360

This patch was tickling a bug in the compiler on that platform, the
details of which have not yet been diagnosed. Since the original commit
was just a minor optimisation, its been agreed to revert for now.

---

Summary of changes:
 win32/config.gc   | 2 +-
 win32/config_H.gc | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/win32/config.gc b/win32/config.gc
index 5928d8beb1..ce9a6b9ad7 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -117,7 +117,7 @@ d_bsdgetpgrp='undef'
 d_bsdsetpgrp='undef'
 d_builtin_add_overflow='undef'
 d_builtin_choose_expr='undef'
-d_builtin_expect='define'
+d_builtin_expect='undef'
 d_builtin_mul_overflow='undef'
 d_builtin_sub_overflow='undef'
 d_c99_variadic_macros='undef'
diff --git a/win32/config_H.gc b/win32/config_H.gc
index 012580f4a3..5a255b49d9 100644
--- a/win32/config_H.gc
+++ b/win32/config_H.gc
@@ -2308,7 +2308,7 @@
  * Can we handle GCC builtin for telling that certain values are more
  * likely
  */
-#define HAS_BUILTIN_EXPECT /**/
+/*#define HAS_BUILTIN_EXPECT   / **/
 /*#define HAS_BUILTIN_CHOOSE_EXPR  / **/
 
 /* HAS_C99_VARIADIC_MACROS:

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.10-11-g5f33597353

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 5f33597353fffb46f714b016ff6376c8e899a192
Author: David Mitchell 
Date:   Tue Apr 23 13:48:56 2019 +0100

ext/File-Glob/t/rt131211.t: simplify timing

This test file expects a glob which matches to be fast,
and a glob which doesn't match also to be fast, but which used to be
exponentially slow.

Previous commits of mine have tried to avoid false positives for the
failtime > 10 * passtime test when both pass and fail times are so small
that the calculation is just comparing noise.

This new change simplifies the logic to: fail if both
fail time > 1 sec (slow)
fail time > 10 * pass time (so pass was relatively fast)

---

Summary of changes:
 ext/File-Glob/t/rt131211.t | 10 +++---
 1 file changed, 3 insertions(+), 7 deletions(-)

diff --git a/ext/File-Glob/t/rt131211.t b/ext/File-Glob/t/rt131211.t
index 9bca70c17f..96432de466 100644
--- a/ext/File-Glob/t/rt131211.t
+++ b/ext/File-Glob/t/rt131211.t
@@ -61,13 +61,9 @@ is $count,10,
 "tried all the patterns without bailing out"
 or diag("elapsed_match=$elapsed_match elapsed_fail=$elapsed_fail");
 
-SKIP: {
-skip "unstable  or too small timing", 1 unless
-$elapsed_match >= 0.01 && $elapsed_fail >= 0.01;
-ok $elapsed_fail <= 10 * $elapsed_match,
-"time to fail less than 10x the time to match"
-or diag("elapsed_match=$elapsed_match elapsed_fail=$elapsed_fail");
-}
+ok $elapsed_fail < 1 || $elapsed_fail <= 10 * $elapsed_match,
+"time to fail should be less than 10x the time to match"
+or diag("elapsed_match=$elapsed_match elapsed_fail=$elapsed_fail");
 
 is "@got_files", catfile($path, $files[0]),
 "only got the expected file for xa*..b";

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.10-10-gd88a90861c

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit d88a90861c6e7d97c1551ff76fff5ae790117795
Author: David Mitchell 
Date:   Tue Apr 23 12:21:54 2019 +0100

-DPERL_GLOBAL_STRUCT and -fno-common smoke fail

The combination of those two flags causes t/porting/libperl.t to fail
because its expecting no BSS symbols, while -fno-common forces PL_Vars to
be BSS rather than Common.

Whether those two compiler directives are a sane combination is another
matter, but don't fail smokes if they appear together.

---

Summary of changes:
 t/porting/libperl.t | 7 +++
 1 file changed, 7 insertions(+)

diff --git a/t/porting/libperl.t b/t/porting/libperl.t
index 3c8c4335e4..f5fb53d2c3 100644
--- a/t/porting/libperl.t
+++ b/t/porting/libperl.t
@@ -330,9 +330,11 @@ ok($symbols{data}{const}{PL_no_mem}{'globals.o'}, "has 
PL_no_mem");
 
 my $GS  = $Config{ccflags} =~ /-DPERL_GLOBAL_STRUCT\b/ ? 1 : 0;
 my $GSP = $Config{ccflags} =~ /-DPERL_GLOBAL_STRUCT_PRIVATE/ ? 1 : 0;
+my $nocommon = $Config{ccflags} =~ /-fno-common/ ? 1 : 0;
 
 print "# GS  = $GS\n";
 print "# GSP = $GSP\n";
+print "# nocommon = $nocommon\n";
 
 my %data_symbols;
 
@@ -382,6 +384,11 @@ if ($GSP) {
 ok(!exists $data_symbols{PL_hash_seed}, "has no PL_hash_seed");
 ok(!exists $data_symbols{PL_ppaddr}, "has no PL_ppaddr");
 
+if ($nocommon) {
+$symbols{data}{common} = $symbols{data}{bss};
+delete $symbols{data}{bss};
+}
+
 ok(! exists $symbols{data}{bss}, "has no data bss symbols")
 or do {
 my $bad = "BSS entries (there are supposed to be none):\n";

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.10-9-g07ba20f405

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 07ba20f405a32f68725aa52f3674162e3f0a3d69
Author: David Mitchell 
Date:   Tue Apr 23 10:21:27 2019 +0100

fix -DPERL_POISON builds

Remove unnecessary casts that confused the Safefree() macro
under PERL_POISON.

The casts were needed when I directly called safefree(), but became
superfluous once I switched to using the Safefree() macro.

---

Summary of changes:
 op.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/op.c b/op.c
index dac99107d5..1862f1b11b 100644
--- a/op.c
+++ b/op.c
@@ -16671,8 +16671,8 @@ custom_op_register_free(pTHX_ SV *sv, MAGIC *mg)
 
 PERL_UNUSED_ARG(mg);
 xop = INT2PTR(XOP *, SvIV(sv));
-Safefree((void*)xop->xop_name);
-Safefree((void*)xop->xop_desc);
+Safefree(xop->xop_name);
+Safefree(xop->xop_desc);
 Safefree(xop);
 return 0;
 }

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.9-154-g0e1b5d0a54

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 0e1b5d0a54d3e252c46b43316b217b4f4185168d
Author: David Mitchell 
Date:   Fri Apr 19 13:05:01 2019 +0100

update Porting/deparse-skips.txt

Remove 3 test scripts from the list which were expected to fail under
'TEST -deparse', but which now succeed.

This is likely to be due to unrelated changes to those scripts rather
than any specific bug fixes in Deparse.pm itself.

commit a601b139b0c8d48eefc9dd3661eccc4a272d1bcc
Author: David Mitchell 
Date:   Fri Apr 19 12:57:48 2019 +0100

Deparse: mark "$a[0]\[1]" TODO

Currently Deparse fails to output a backslash, turning the result
into a multi-dimensional array lookup. This is a long-standing fault.
For now, mark it TODO, and remove the construct from uni/fold.t, which is
where I first spotted the issue by running 'TEST -deparse'.

---

Summary of changes:
 Porting/deparse-skips.txt | 3 ---
 lib/B/Deparse.t   | 4 
 t/uni/fold.t  | 3 ++-
 3 files changed, 6 insertions(+), 4 deletions(-)

diff --git a/Porting/deparse-skips.txt b/Porting/deparse-skips.txt
index 48ad07f7aa..2f2a35fb50 100644
--- a/Porting/deparse-skips.txt
+++ b/Porting/deparse-skips.txt
@@ -73,7 +73,6 @@ re/overload.t # [perl #123385] %^H output
 re/pat_advanced.t # [perl #123417]
 re/pat_rt_report.t# malformed utf8 constant; also /\c@/ -> /\c\@/
 re/pat.t  # [perl #90590]
-re/regexp_unicode_prop.t
 re/regex_sets.t
 re/reg_fold.t # [perl #123385] %^H output
 re/rxcode.t   # checks regexp stringification
@@ -157,8 +156,6 @@ uni/variables.t
 ../cpan/bignum/t/scope_r.t
 ../cpan/Math-BigInt/t/constant.t
 ../cpan/Math-BigInt/t/const_mbf.t
-../cpan/Module-Metadata/t/metadata.t
-../cpan/Scalar-List-Utils/t/subname.t
 ../cpan/Scalar-List-Utils/t/uniq.t
 ../cpan/Term-Cap/test.pl
 ../cpan/Test-Simple/t/Legacy/Builder/carp.t
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 138563af7e..384c56c11f 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -3058,3 +3058,7 @@ $l = $s->$#*;
 $s->$#* = 1;
 $l = $#{@$s;};
 $#{$s;} = 1;
+
+# TODO doesn't preserve backslash
+my @a;
+my $s = "$a[0]\[1]";
diff --git a/t/uni/fold.t b/t/uni/fold.t
index a557fe3354..bd1dd8596b 100644
--- a/t/uni/fold.t
+++ b/t/uni/fold.t
@@ -166,7 +166,8 @@ foreach my $test_ref (@CF) {
 $test = qq[":$c:" =~ /:$every_other_bracketed_f:/iu];
 ok eval $test, "$code - $name - $mapping - $type - $test";
 
-my $other_every_bracketed_f = "$f_chars[0]\[$f_chars[1]]";
+my $other_every_bracketed_f = "$f_chars[0]";
+$other_every_bracketed_f .= "[$f_chars[1]]";
 $other_every_bracketed_f .= "$f_chars[2]" if $f_chars[2];
 $test = qq[":$c:" =~ /:$other_every_bracketed_f:/iu];
 ok eval $test, "$code - $name - $mapping - $type - $test";

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.9-152-g9770e07bfa

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 9770e07bfa784e7e2acc67585691017b56cadb6f
Author: David Mitchell 
Date:   Fri Apr 19 12:38:33 2019 +0100

ext/File-Glob/t/rt131211.t: fix timing issues #2

Commit v5.27.8-405-gf548aeca98 from a year ago tweaked this
timing-sensitive test script to reduce false positives.
However, we're still seeing the occasional failure of test 2 in smokes,
so twaks the timing a little further.

---

Summary of changes:
 ext/File-Glob/t/rt131211.t | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/ext/File-Glob/t/rt131211.t b/ext/File-Glob/t/rt131211.t
index 4ac0d8729d..9bca70c17f 100644
--- a/ext/File-Glob/t/rt131211.t
+++ b/ext/File-Glob/t/rt131211.t
@@ -63,7 +63,7 @@ is $count,10,
 
 SKIP: {
 skip "unstable  or too small timing", 1 unless
-$elapsed_match >= 0.001 && $elapsed_fail >= 0.001;
+$elapsed_match >= 0.01 && $elapsed_fail >= 0.01;
 ok $elapsed_fail <= 10 * $elapsed_match,
 "time to fail less than 10x the time to match"
 or diag("elapsed_match=$elapsed_match elapsed_fail=$elapsed_fail");

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.9-145-gd493784f61

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit d493784f6104b2f27789c4c2d36fc84690eaef2d
Author: David Mitchell 
Date:   Wed Apr 17 09:25:26 2019 +0100

Revert "skip leaky Storable tests"

This reverts commit 2cf75007609600e27520fb4e25a34103543889ca.

The problem the tests were skipped has been resolved by
v5.29.9-142-g1d7b2a7e3a

---

Summary of changes:
 dist/Storable/t/blessed.t | 9 +
 1 file changed, 1 insertion(+), 8 deletions(-)

diff --git a/dist/Storable/t/blessed.t b/dist/Storable/t/blessed.t
index 07d17aa859..d9a77b3723 100644
--- a/dist/Storable/t/blessed.t
+++ b/dist/Storable/t/blessed.t
@@ -358,14 +358,7 @@ is(ref $t, 'STRESS_THE_STACK');
 ok(eval {thaw($y)}, "empty serialized") or diag $@; # <-- dies here with 
"Bad data"
 }
 
-SKIP: {
-# These tests leak. Ignore the leaks for now: try to fix after the
-# 5.30.0 release
-skip("leaky under ASan", 18);
-if ($ENV{PERL_DESTRUCT_LEVEL} eq '2'
- && $Config{ccflags} =~ /sanitize/
- && $] <= 5.030)
-
+{
 {
 package FreezeHookDies;
 sub STORABLE_freeze {

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.9-144-g62d6686381

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 62d66863817fd15632d9d2c8ea9c9df2ecb3705b
Author: David Mitchell 
Date:   Tue Apr 16 22:17:45 2019 +0100

s/safefree()/Safefree() in a few places

Karl pointed that a couple of my recent commits used (lower case)
safefree() rather than Safefree(), the latter having extra debugging
facilities.

---

Summary of changes:
 locale.c | 4 ++--
 op.c | 6 +++---
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/locale.c b/locale.c
index c3ce587981..87e11d609d 100644
--- a/locale.c
+++ b/locale.c
@@ -3948,7 +3948,7 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
  cur_min_x + COLLXFRM_HDR_LEN))
 {
 PL_strxfrm_NUL_replacement = j;
-safefree(cur_min_x);
+Safefree(cur_min_x);
 cur_min_x = x;
 }
 else {
@@ -4104,7 +4104,7 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
  cur_max_x + COLLXFRM_HDR_LEN))
 {
 PL_strxfrm_max_cp = j;
-safefree(cur_max_x);
+Safefree(cur_max_x);
 cur_max_x = x;
 }
 else {
diff --git a/op.c b/op.c
index 63fe245f06..dac99107d5 100644
--- a/op.c
+++ b/op.c
@@ -16671,9 +16671,9 @@ custom_op_register_free(pTHX_ SV *sv, MAGIC *mg)
 
 PERL_UNUSED_ARG(mg);
 xop = INT2PTR(XOP *, SvIV(sv));
-safefree((void*)xop->xop_name);
-safefree((void*)xop->xop_desc);
-safefree(xop);
+Safefree((void*)xop->xop_name);
+Safefree((void*)xop->xop_desc);
+Safefree(xop);
 return 0;
 }
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.9-141-g207cc8dfc7

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 207cc8dfc710475ee7d8b4dd64a522bd1cf442d3
Author: David Mitchell 
Date:   Tue Apr 16 16:49:47 2019 +0100

fix leak when $LANG unset

The following leaked:

LANG=  perl -e1

because in S_emulate_setlocale(), it was
1) making a copy of $ENV{"LANG"};
2) throwing that copy away and replacing it with "C" when it discovered
   that the string was empty.

A little judicious reordering of that chunk of code makes the issue go
away.

Showed up as failures of lib/locale_threads.t under valgrind / ASan.

commit 2bfe2a2773c59588ac2bf11b5d9439c92d86fb62
Author: David Mitchell 
Date:   Tue Apr 16 15:48:39 2019 +0100

fix locale leaks on utf8 strings

For example the following leaked:

require POSIX; import POSIX ':locale_h';

setlocale(&POSIX::LC_ALL, 'aa_DJ.iso88591') or die;
use locale;

my $ok = 'A' lt chr 0x100;

Some code in Perl__mem_collxfrm() does a couple of

for (j = 1; j < 256; j++) { ... }

loops where for each chr(j) character it recursively calls itself, and
records the index of the 'smallest' / 'largest' result. However, when
updating cur_min_x / cur_max_x, it wasn't freeing the previous value.

The symptoms were that valgrind / Address Sanitizer found fault with
lib/locale.t

commit 44955e7de88913c476b06c9046ed65775b693da7
Author: David Mitchell 
Date:   Tue Apr 16 15:28:16 2019 +0100

fix locale leak on zero-length strings

For example the following leaked:

use locale;
my $le = "" le "";

When a comparison is done within locale scope, PERL_MAGIC_collxfrm
magic is added to the SV. However, the value set for mg_len is the length
of the collated string, not the malloced size of the buffer. This means
that mg_len can be set to zero, which by convention, means that mg_ptr
shouldn't be freed.

For now, fix by putting special-cased code in S_mg_free_struct. After
5.30.0 is out, I'll probably add a PERL_MAGIC_collxfrm-specific svt_free
vtable method.

The symptoms were that valgrind / Address Sanitizer found fault with
lib/locale.t

---

Summary of changes:
 locale.c | 21 ++---
 mg.c |  8 +++-
 2 files changed, 17 insertions(+), 12 deletions(-)

diff --git a/locale.c b/locale.c
index 81aa00e33f..c3ce587981 100644
--- a/locale.c
+++ b/locale.c
@@ -769,22 +769,19 @@ S_emulate_setlocale(const int category,
 
 const char * default_name;
 
-/* To minimize other threads messing with the environment, we copy
- * the variable, making it a temporary.  But this doesn't work upon
- * program initialization before any scopes are created, and at
- * this time, there's nothing else going on that would interfere.
- * So skip the copy in that case */
-if (PL_scopestack_ix == 0) {
-default_name = PerlEnv_getenv("LANG");
-}
-else {
-default_name = savepv(PerlEnv_getenv("LANG"));
-}
+default_name = PerlEnv_getenv("LANG");
 
 if (! default_name || strEQ(default_name, "")) {
 default_name = "C";
 }
 else if (PL_scopestack_ix != 0) {
+/* To minimize other threads messing with the environment,
+ * we copy the variable, making it a temporary.  But this
+ * doesn't work upon program initialization before any
+ * scopes are created, and at this time, there's nothing
+ * else going on that would interfere.  So skip the copy
+ * in that case */
+default_name = savepv(default_name);
 SAVEFREEPV(default_name);
 }
 
@@ -3951,6 +3948,7 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
  cur_min_x + COLLXFRM_HDR_LEN))
 {
 PL_strxfrm_NUL_replacement = j;
+safefree(cur_min_x);
 cur_min_x = x;
 }
 else {
@@ -4106,6 +4104,7 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
  cur_max_x + COLLXFRM_HDR_LEN))
 {
 PL_strxfrm_max_cp = j;
+safefree(cur_max_x);
 cur_max_x = x;
 }
 else {
diff --git a/mg.c b/mg.c
index 320e2d39bb..afe452fc5d 100644
--- a/m

[perl.git] branch blead updated. v5.29.9-133-g2cf7500760

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 2cf75007609600e27520fb4e25a34103543889ca
Author: David Mitchell 
Date:   Mon Apr 15 11:18:22 2019 +0100

skip leaky Storable tests

A bunch of tests make use of freeze/thaw hooks which deliberately die.
Fixing this looks non-trivial, so this commit just skips those tests
for now if running under Address Sanitizer.

This skip includes a version check, so come 5.31.0 it will start failing
smokes again, providing an incentive to fix.

Example of leaking code:

use Storable qw(store);
sub FreezeHookDies::STORABLE_freeze { die ${$_[0]} }
my $x = bless [], "FreezeHookDies";
eval { store($x, "store99"); 1 };

---

Summary of changes:
 dist/Storable/t/blessed.t | 9 -
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/dist/Storable/t/blessed.t b/dist/Storable/t/blessed.t
index d9a77b3723..07d17aa859 100644
--- a/dist/Storable/t/blessed.t
+++ b/dist/Storable/t/blessed.t
@@ -358,7 +358,14 @@ is(ref $t, 'STRESS_THE_STACK');
 ok(eval {thaw($y)}, "empty serialized") or diag $@; # <-- dies here with 
"Bad data"
 }
 
-{
+SKIP: {
+# These tests leak. Ignore the leaks for now: try to fix after the
+# 5.30.0 release
+skip("leaky under ASan", 18);
+if ($ENV{PERL_DESTRUCT_LEVEL} eq '2'
+ && $Config{ccflags} =~ /sanitize/
+ && $] <= 5.030)
+
 {
 package FreezeHookDies;
 sub STORABLE_freeze {

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.9-107-gdfba4714a9

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit dfba4714a9dc4c35123b4df0a5e1721ccb081d97
Author: David Mitchell 
Date:   Fri Apr 12 16:18:57 2019 +0100

warnings.t: skip some leaky tests

A couple of tests in 7fatal leak, and thus fail, when run under Address
Sanitizer. I have a proper fix for this, but it's too close to 5.30 code
freeze to justify merging it yet. So just skip the problematic tests for
now.

commit df10057779d7151c097d31e58b589c7b1e968d1f
Author: David Mitchell 
Date:   Fri Apr 12 14:06:21 2019 +0100

fix leak in Perl_coresub_op()

This sub initially creates a new OP_COREARGS op to be made use of in the
various cases of a following switch statement. But in the specific case
of OP_SELECT, the op isn't actually used, and leaks. So don't allocate
it in this case.

The leak could be reproduced with the one-liner

defined &{"CORE::select"};

and was causing t/op/coresubs.t to fail under Address Sanitiser.

commit ad9115fb3ef3c0d588afd07c1b794e99cef3e1ed
Author: David Mitchell 
Date:   Tue Apr 9 10:33:34 2019 +0100

Avoid leak/crash calling CORE::foo()

The compile time code in Perl_ck_entersub_args_core() that converts a
subroutine call like mypos(1,2) into a direct call to the built-in
function, e.g. pos(1,2), doesn't handle too many args well.
The ops associated with the extra args are excised from the op tree,
but aren't freed, and their op_sigparent pointers aren't updated
correctly.

This is noticeable if op_free() is altered to walk the tree using
op_sigparent to walk back up to the parent.

This commit frees any extra args and emits the 'Too many arguments' error
immediately, rather than tripping over later.

commit 78bb3b143c41ff368fdc4a87f7e9bf36b3023ca2
Author: David Mitchell 
Date:   Fri Apr 12 14:52:27 2019 +0100

fix leak in do { ... } while 0

The op tree for

do X while 0

is simplified to

X

but the const OP for the '0' wasn't being freed and so leaked.

commit a64296af735e8e25c8a1b58cd36a97211c371ac4
Author: David Mitchell 
Date:   Thu Apr 11 17:19:31 2019 +0100

Perl_newLISTOP() allocate OP_PUSHMARK safely

This commit is a prelude to allowing op_free() to make use the parent
pointer at the end of an op_sibling chain to walk a sub-tree to be freed.

newLISTOP() converts 0..2 ops into a list, adding a new parent list op
and possibly a pushmark op. However, under Safe.pm, and specifically in
dist/Safe/t/safeops.t, allocating a pushmark can croak. If the optree
under construct at this point isn't consistent (specifically the parent
pointer not yet set), then this can crash op_free() while trying to walk
the new list to free it.

The fix is to allocate the OP_PUSHMARK if needed *before* messing with
the structure of the list sub-tree.

---

Summary of changes:
 op.c  | 37 +
 t/lib/warnings/7fatal |  2 ++
 t/op/coresubs.t   |  2 +-
 3 files changed, 32 insertions(+), 9 deletions(-)

diff --git a/op.c b/op.c
index 350032a106..63fe245f06 100644
--- a/op.c
+++ b/op.c
@@ -6101,12 +6101,15 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP 
*last)
 {
 dVAR;
 LISTOP *listop;
+/* Note that allocating an OP_PUSHMARK can die under Safe.pm if
+ * pushmark is banned. So do it now while existing ops are in a
+ * consistent state, in case they suddenly get freed */
+OP* const pushop = type == OP_LIST ? newOP(OP_PUSHMARK, 0) : NULL;
 
 assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LISTOP
|| type == OP_CUSTOM);
 
 NewOp(1101, listop, 1, LISTOP);
-
 OpTYPE_set(listop, type);
 if (first || last)
flags |= OPf_KIDS;
@@ -6120,8 +6123,8 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP 
*last)
OpMORESIB_set(first, last);
 listop->op_first = first;
 listop->op_last = last;
-if (type == OP_LIST) {
-   OP* const pushop = newOP(OP_PUSHMARK, 0);
+
+if (pushop) {
OpMORESIB_set(pushop, first);
listop->op_first = pushop;
listop->op_flags |= OPf_KIDS;
@@ -8646,7 +8649,11 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP 
*expr, OP *block)
   ))
/* Return the block now, so that S_new_logop does not try to
   fold it away. */
-   return block;   /* do {} while 0 does once */
+{
+op_free(expr);
+return block;  /* do {} while 0 does once */
+}
+
if (expr->op_type == OP_READLINE
|| expr->op_type == OP_READDIR
 

[perl.git] branch blead updated. v5.29.9-69-g6894e6a785

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 6894e6a7854351af3251a20ce5c787463bc7643a
Author: David Mitchell 
Date:   Fri Apr 5 17:01:53 2019 +0100

fixup to 'change LABEL type from pval to opval'

Commit v5.29.9-68-g017192018b broke g++ builds. Spotted by Karl.

---

Summary of changes:
 toke.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/toke.c b/toke.c
index 0273566a9b..30bdf325d5 100644
--- a/toke.c
+++ b/toke.c
@@ -7192,7 +7192,7 @@ Perl_yylex(pTHX)
if (!anydelim && PL_expect == XSTATE
  && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
s = d + 1;
-pl_yylval.pval =
+pl_yylval.opval =
 newSVOP(OP_CONST, 0,
 newSVpvn_flags(PL_tokenbuf, len, UTF ? SVf_UTF8 : 0));
CLINE;

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.9-68-g017192018b

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 017192018b7f9fc4b889bb344bd75df8f6b78929
Author: David Mitchell 
Date:   Fri Apr 5 12:49:50 2019 +0100

parser: change LABEL type from pval to opval

The items pushed onto the parser stack can be one of several types:
ival, opval, pval etc. The only remaining use of pval is when a "label:"
is encountered.

When an error occurs during parsing, ops on the parse stack get
automatically reaped these days as part of the OP slab mechanism;
but bare strings (pvals) still leak.

Convert this one remaining pval into an opval, making the toker return
an OP_CONST with an SV holding the label.

Since newSTATEOP() still expects a raw string for the label, the parser
just grabs the value returned by the toker and makes a copy of the
string from it, then immediately frees the OP_CONST and its associated
SV.

The leak was showing up in ext/XS-APItest/t/stmtasexpr.t, which expects
to parse a statement where labels are banned.

---

Summary of changes:
 perly.act | 514 +++---
 perly.h   |  11 +-
 perly.tab |  58 +++
 perly.y   |  12 +-
 toke.c|  15 +-
 5 files changed, 313 insertions(+), 297 deletions(-)

diff --git a/perly.act b/perly.act
index fe8a5e9842..98e1572ce0 100644
--- a/perly.act
+++ b/perly.act
@@ -5,7 +5,7 @@
  */
 
 case 2:
-#line 119 "perly.y" /* yacc.c:1646  */
+#line 119 "perly.y" /* yacc.c:1648  */
 {
  parser->expect = XSTATE;
   (yyval.ival) = 0;
@@ -14,7 +14,7 @@ case 2:
 break;
 
   case 3:
-#line 124 "perly.y" /* yacc.c:1646  */
+#line 124 "perly.y" /* yacc.c:1648  */
 {
  
newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval)));
  PL_compiling.cop_seq = 0;
@@ -24,7 +24,7 @@ case 2:
 break;
 
   case 4:
-#line 130 "perly.y" /* yacc.c:1646  */
+#line 130 "perly.y" /* yacc.c:1648  */
 {
  parser->expect = XTERM;
   (yyval.ival) = 0;
@@ -33,7 +33,7 @@ case 2:
 break;
 
   case 5:
-#line 135 "perly.y" /* yacc.c:1646  */
+#line 135 "perly.y" /* yacc.c:1648  */
 {
  PL_eval_root = (ps[0].val.opval);
  (yyval.ival) = 0;
@@ -42,7 +42,7 @@ case 2:
 break;
 
   case 6:
-#line 140 "perly.y" /* yacc.c:1646  */
+#line 140 "perly.y" /* yacc.c:1648  */
 {
  parser->expect = XBLOCK;
   (yyval.ival) = 0;
@@ -51,7 +51,7 @@ case 2:
 break;
 
   case 7:
-#line 145 "perly.y" /* yacc.c:1646  */
+#line 145 "perly.y" /* yacc.c:1648  */
 {
  PL_pad_reset_pending = TRUE;
  PL_eval_root = (ps[0].val.opval);
@@ -63,7 +63,7 @@ case 2:
 break;
 
   case 8:
-#line 153 "perly.y" /* yacc.c:1646  */
+#line 153 "perly.y" /* yacc.c:1648  */
 {
  parser->expect = XSTATE;
   (yyval.ival) = 0;
@@ -72,7 +72,7 @@ case 2:
 break;
 
   case 9:
-#line 158 "perly.y" /* yacc.c:1646  */
+#line 158 "perly.y" /* yacc.c:1648  */
 {
  PL_pad_reset_pending = TRUE;
  PL_eval_root = (ps[0].val.opval);
@@ -84,7 +84,7 @@ case 2:
 break;
 
   case 10:
-#line 166 "perly.y" /* yacc.c:1646  */
+#line 166 "perly.y" /* yacc.c:1648  */
 {
  parser->expect = XSTATE;
   (yyval.ival) = 0;
@@ -93,7 +93,7 @@ case 2:
 break;
 
   case 11:
-#line 171 "perly.y" /* yacc.c:1646  */
+#line 171 "perly.y" /* yacc.c:1648  */
 {
  PL_pad_reset_pending = TRUE;
  PL_eval_root = (ps[0].val.opval);
@@ -105,7 +105,7 @@ case 2:
 break;
 
   case 12:
-#line 179 "perly.y" /* yacc.c:1646  */
+#line 179 "perly.y" /* yacc.c:1648  */
 {
  parser->expect = XSTATE;
   (yyval.ival) = 0;
@@ -114,7 +114,7 @@ case 2:
 break;
 
   case 13:
-#line 184 "perly.y" /* yacc.c:1646  */
+#line 184 "perly.y" /* yacc.c:1648  */
 {
  PL_eval_root = (ps[0].val.opval);
  (yyval.ival) = 0;
@@ -123,7 +123,7 @@ case 2:
 break;
 
   case 14:
-#line 192 "perly.y" /* yacc.c:1646  */
+#line 192 "perly.y" /* yacc.c:1648  */
 { if (parser->copline > (line_t)(ps[-3].val.ival))
  parser->copline = (line_t)(ps[-3].val.ival);
  (yyval.opval) = block_end((ps[-2].val.ival), 
(ps[-1].val.opval));
@@ -132,7 +132,7 @@ case 2:
 break;
 
   case 

[perl.git] branch blead updated. v5.29.9-62-g281cff281e

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 281cff281e54d71fbedd8c314fe56ae9b58bee67
Author: David Mitchell 
Date:   Thu Apr 4 14:38:50 2019 +0100

fix leak in Perl_vload_module()

This function allocates a few ops, then calls Perl_utilize().
If the latter function croaks early on, those ops will be leaked,
because they won't yet have been linked into the optree.

In particular, newUNOP(OP_REQUIRE, ...) can die if passed a non-valid
module name.

This can be fixed by moving the start_subparse() call to the start of
Perl_vload_module(), before any op allocations. start_subparse() creates
a new PL_compcv, and so any ops allocated afterwards will come from that
CV's slab rather than being directly malloc()ed. On death, the CV will
be freed and its op slab will be scanned and any ops found there freed.

The leak was showing up in ext/XS-APItest/t/load-module.t under ASan.

---

Summary of changes:
 op.c | 34 +-
 1 file changed, 21 insertions(+), 13 deletions(-)

diff --git a/op.c b/op.c
index 3b0cc76423..350032a106 100644
--- a/op.c
+++ b/op.c
@@ -7706,10 +7706,29 @@ void
 Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
 {
 OP *veop, *imop;
-OP * const modname = newSVOP(OP_CONST, 0, name);
+OP * modname;
+I32 floor;
 
 PERL_ARGS_ASSERT_VLOAD_MODULE;
 
+/* utilize() fakes up a BEGIN { require ..; import ... }, so make sure
+ * that it has a PL_parser to play with while doing that, and also
+ * that it doesn't mess with any existing parser, by creating a tmp
+ * new parser with lex_start(). This won't actually be used for much,
+ * since pp_require() will create another parser for the real work.
+ * The ENTER/LEAVE pair protect callers from any side effects of use.
+ *
+ * start_subparse() creates a new PL_compcv. This means that any ops
+ * allocated below will be allocated from that CV's op slab, and so
+ * will be automatically freed if the utilise() fails
+ */
+
+ENTER;
+SAVEVPTR(PL_curcop);
+lex_start(NULL, NULL, LEX_START_SAME_FILTER);
+floor = start_subparse(FALSE, 0);
+
+modname = newSVOP(OP_CONST, 0, name);
 modname->op_private |= OPpCONST_BARE;
 if (ver) {
veop = newSVOP(OP_CONST, 0, ver);
@@ -7732,18 +7751,7 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, 
va_list *args)
}
 }
 
-/* utilize() fakes up a BEGIN { require ..; import ... }, so make sure
- * that it has a PL_parser to play with while doing that, and also
- * that it doesn't mess with any existing parser, by creating a tmp
- * new parser with lex_start(). This won't actually be used for much,
- * since pp_require() will create another parser for the real work.
- * The ENTER/LEAVE pair protect callers from any side effects of use.  */
-
-ENTER;
-SAVEVPTR(PL_curcop);
-lex_start(NULL, NULL, LEX_START_SAME_FILTER);
-utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
-   veop, modname, imop);
+utilize(!(flags & PERL_LOADMOD_DENY), floor, veop, modname, imop);
 LEAVE;
 }
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.9-57-gd90bd2cf70

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit d90bd2cf701d08f6acfea11ab39eb0a20f9a6c3e
Author: David Mitchell 
Date:   Wed Apr 3 16:11:54 2019 +0100

Avoid leaks in Perl_custom_op_get_field()

In 5.14.0 a new API was introduced to register details for custom ops.
Normally the caller supplies a pointer to a static xop struct with
details for the op, which gets gets added via a hidden
newSViv(PTR2IV(xop))
to PL_custom_ops values.

However, Perl_custom_op_get_field() also supports the older interface,
where name and desc entries were registered in PL_custom_op_names and
PL_custom_op_descs.

If it doesn't find an entry in PL_custom_ops, but does in
PL_custom_op_names, it fakes up a new-API registration in PL_custom_ops.
In this case the xop struct, and the name and description attached to it,
were leaking.

This commit fixes the leak by attaching magic to such newSViv(PTR2IV(xop))
SVs which frees the struct and strings.

---

Summary of changes:
 op.c | 46 +-
 1 file changed, 45 insertions(+), 1 deletion(-)

diff --git a/op.c b/op.c
index ce769c561f..3b0cc76423 100644
--- a/op.c
+++ b/op.c
@@ -16632,6 +16632,38 @@ function.
 =cut
 */
 
+
+/* use PERL_MAGIC_ext to call a function to free the xop structure when
+ * freeing PL_custom_ops */
+
+static int
+custom_op_register_free(pTHX_ SV *sv, MAGIC *mg)
+{
+XOP *xop;
+
+PERL_UNUSED_ARG(mg);
+xop = INT2PTR(XOP *, SvIV(sv));
+safefree((void*)xop->xop_name);
+safefree((void*)xop->xop_desc);
+safefree(xop);
+return 0;
+}
+
+
+static const MGVTBL custom_op_register_vtbl = {
+0,  /* get */
+0,  /* set */
+0,  /* len */
+0,  /* clear */
+custom_op_register_free, /* free */
+0,  /* copy */
+0,  /* dup */
+#ifdef MGf_LOCAL
+0,  /* local */
+#endif
+};
+
+
 XOPRETANY
 Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
 {
@@ -16655,7 +16687,12 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const 
xop_flags_enum field)
 if (PL_custom_ops)
he = hv_fetch_ent(PL_custom_ops, keysv, 0, 0);
 
-/* assume noone will have just registered a desc */
+/* See if the op isn't registered, but its name *is* registered.
+ * That implies someone is using the pre-5.14 API,where only name and
+ * description could be registered. If so, fake up a real
+ * registration.
+ * We only check for an existing name, and assume no one will have
+ * just registered a desc */
 if (!he && PL_custom_op_names &&
(he = hv_fetch_ent(PL_custom_op_names, keysv, 0, 0))
 ) {
@@ -16673,6 +16710,13 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const 
xop_flags_enum field)
XopENTRY_set(xop, xop_desc, savepvn(pv, l));
}
Perl_custom_op_register(aTHX_ o->op_ppaddr, xop);
+   he = hv_fetch_ent(PL_custom_ops, keysv, 0, 0);
+/* add magic to the SV so that the xop struct (pointed to by
+ * SvIV(sv)) is freed. Normally a static xop is registered, but
+ * for this backcompat hack, we've alloced one */
+(void)sv_magicext(HeVAL(he), NULL, PERL_MAGIC_ext,
+&custom_op_register_vtbl, NULL, 0);
+
 }
 else {
if (!he)

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.9-56-g807c5598a0

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 807c5598a03d2cd87b685a099c1e2ee197615df8
Author: David Mitchell 
Date:   Wed Apr 3 14:14:13 2019 +0100

fix leak in Devel-PPPort

The leaky code is only used during test. It creates 3 ops, does various
operations related to linking OpSIBLINGs, then fails to free them.

---

Summary of changes:
 dist/Devel-PPPort/parts/inc/misc | 5 +
 1 file changed, 5 insertions(+)

diff --git a/dist/Devel-PPPort/parts/inc/misc b/dist/Devel-PPPort/parts/inc/misc
index 3d8ecb3ce9..a8802a49d0 100644
--- a/dist/Devel-PPPort/parts/inc/misc
+++ b/dist/Devel-PPPort/parts/inc/misc
@@ -418,6 +418,7 @@ OpSIBLING_tests()
PREINIT:
OP *x;
OP *kid;
+   OP *middlekid;
OP *lastkid;
int count = 0;
int failures = 0;
@@ -441,6 +442,7 @@ OpSIBLING_tests()
kid = OpSIBLING(kid);
lastkid = kid;
}
+middlekid = OpSIBLING(x);
 
/* Should now have a sibling */
if (! OpHAS_SIBLING(x) || ! OpSIBLING(x) ) {
@@ -484,6 +486,9 @@ OpSIBLING_tests()
failures++; warn("Op should have had a sib after 
maybesibset");
}
 
+op_free(lastkid);
+op_free(middlekid);
+op_free(x);
RETVAL = failures;
OUTPUT:
RETVAL

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.9-55-g6d65cb5d84

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 6d65cb5d847ac93680949c4fa02111808207fbdc
Author: David Mitchell 
Date:   Wed Apr 3 13:23:24 2019 +0100

Data::Dumper - avoid leak on croak

v5.21.3-742-g19be3be696 added a facility to Dumper.xs to croak if the
recursion level became too deep (1000 by default).

The trouble with this is that various parts of DD_dump() allocate
temporary SVs and buffers, which will leak if DD_dump() unceremoniously
just croaks().

This currently manifests as dist/Data-Dumper/t/recurse.t failing under
Address Sanitiser.

This commit makes the depth checking code just set a sticky 'too deep'
boolean flag, and
a) on entry, DD_dump() just returns immediately if the flag is set;
b) the flag is checked by the top-level called of DD_dump() and croaks
if set.

So the net effect is to defer croaking until the dump is complete,
and avoid any further recursion once the flag is set.

This is a bit of a quick fix. More long-term solutions would be to
convert DD_dump() to be iterative rather than recursive, and/or make
sure all temporary SVs and buffers are suitably anchored somewhere so
that they get cleaned up on croak.

---

Summary of changes:
 dist/Data-Dumper/Dumper.pm |  6 +++---
 dist/Data-Dumper/Dumper.xs | 27 ---
 2 files changed, 23 insertions(+), 10 deletions(-)

diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm
index 40aeb7d0e5..4866af9861 100644
--- a/dist/Data-Dumper/Dumper.pm
+++ b/dist/Data-Dumper/Dumper.pm
@@ -10,7 +10,7 @@
 package Data::Dumper;
 
 BEGIN {
-$VERSION = '2.173'; # Don't forget to set version and release
+$VERSION = '2.174'; # Don't forget to set version and release
 }   # date in POD below!
 
 #$| = 1;
@@ -1461,13 +1461,13 @@ be to use the C filter of Data::Dumper.
 
 Gurusamy Sarathyg...@activestate.com
 
-Copyright (c) 1996-2017 Gurusamy Sarathy. All rights reserved.
+Copyright (c) 1996-2019 Gurusamy Sarathy. All rights reserved.
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
 
 =head1 VERSION
 
-Version 2.173
+Version 2.174
 
 =head1 SEE ALSO
 
diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs
index 7f0b027b0e..a324cb6429 100644
--- a/dist/Data-Dumper/Dumper.xs
+++ b/dist/Data-Dumper/Dumper.xs
@@ -61,9 +61,10 @@
 #endif
 
 /* This struct contains almost all the user's desired configuration, and it
- * is treated as constant by the recursive function. This arrangement has
- * the advantage of needing less memory than passing all of them on the
- * stack all the time (as was the case in an earlier implementation). */
+ * is treated as mostly constant (except for maxrecursed) by the recursive
+ * function.  This arrangement has the advantage of needing less memory
+ * than passing all of them on the stack all the time (as was the case in
+ * an earlier implementation). */
 typedef struct {
 SV *pad;
 SV *xpad;
@@ -74,6 +75,7 @@ typedef struct {
 SV *toaster;
 SV *bless;
 IV maxrecurse;
+bool maxrecursed; /* at some point we exceeded the maximum recursion level 
*/
 I32 indent;
 I32 purity;
 I32 deepcopy;
@@ -97,7 +99,7 @@ static bool safe_decimal_number(const char *p, STRLEN len);
 static SV *sv_x (pTHX_ SV *sv, const char *str, STRLEN len, I32 n);
 static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV 
*retval,
 HV *seenhv, AV *postav, const I32 level, SV *apad,
-const Style *style);
+Style *style);
 
 #ifndef HvNAME_get
 #define HvNAME_get HvNAME
@@ -615,7 +617,7 @@ deparsed_output(pTHX_ SV *val)
  */
 static I32
 DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV 
*seenhv,
-   AV *postav, const I32 level, SV *apad, const Style *style)
+   AV *postav, const I32 level, SV *apad, Style *style)
 {
 char tmpbuf[128];
 Size_t i;
@@ -642,6 +644,9 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV 
*retval, HV *seenhv,
 if (!val)
return 0;
 
+if (style->maxrecursed)
+return 0;
+
 /* If the output buffer has less than some arbitrary amount of space
remaining, then enlarge it. For the test case (25M of output),
*1.1 was slower, *2.0 was the same, so the first guess of 1.5 is
@@ -793,7 +798,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV 
*retval, HV *seenhv,
}
 
 if (style->maxrecurse > 0 && level >= style->maxrecurse) {
-croak("Recursion limit of %" IVdf " exceeded", style->maxrecurse);
+   

[perl.git] branch blead updated. v5.29.9-54-g06cbc31722

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 06cbc317229e882f379e75eb3adf7cf9c071febd
Author: David Mitchell 
Date:   Wed Apr 3 11:06:22 2019 +0100

Fix recent double free in S_parse_gv_stash_name()

RT #133977

My recent commit v5.29.9-29-g657ed7c1c1 moved all buffer freeing to
the end of the function, but missed removing one of the existing frees.

The problem was spotted by James E Keenan and diagnosed by Tony Cook; I just
added a test.

A simple reproducer is

my $def = defined 
*{"xxx'x"};

---

Summary of changes:
 gv.c  | 1 -
 t/op/stash_parse_gv.t | 2 +-
 2 files changed, 1 insertion(+), 2 deletions(-)

diff --git a/gv.c b/gv.c
index 61085f5c53..3b8759e88a 100644
--- a/gv.c
+++ b/gv.c
@@ -1665,7 +1665,6 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const 
char **name,
 gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : 
(I32)*len, add);
 *gv = gvp ? *gvp : NULL;
 if (!*gv || *gv == (const GV *)&PL_sv_undef) {
-Safefree(tmpfullbuf); /* free our tmpfullbuf if it was 
used */
 goto notok;
 }
 /* here we know that *gv && *gv != &PL_sv_undef */
diff --git a/t/op/stash_parse_gv.t b/t/op/stash_parse_gv.t
index 05694ca8ce..bd9e95cf37 100644
--- a/t/op/stash_parse_gv.t
+++ b/t/op/stash_parse_gv.t
@@ -23,7 +23,7 @@ foreach my $t (@tests) {
 my ( $sub, $name ) = @$t;
 
 fresh_perl_is(
-qq[sub $sub { print qq[ok\n]} &{"$sub"} ],
+qq[sub $sub { print qq[ok\n]} &{"$sub"}; my \$d = defined *{"foo$sub"} 
],
 q[ok],
 { switches => ['-w'] },
 $name

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.9-52-ge7b55bf0e9

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit e7b55bf0e9b6c3955e8e7b9cf6e9b6987bcd1460
Author: David Mitchell 
Date:   Tue Apr 2 10:05:37 2019 +0100

fix locale.c under -DPERL_GLOBAL_STRUCT_PRIVATE

---

Summary of changes:
 locale.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/locale.c b/locale.c
index 85059dee71..81aa00e33f 100644
--- a/locale.c
+++ b/locale.c
@@ -5605,6 +5605,7 @@ Perl_thread_locale_term()
 #  ifndef WIN32
 
 {   /* Free up */
+dVAR;
 locale_t cur_obj = uselocale(LC_GLOBAL_LOCALE);
 if (cur_obj != LC_GLOBAL_LOCALE && cur_obj != PL_C_locale_obj) {
 freelocale(cur_obj);

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.9-40-gdd0510590a

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit dd0510590a1124f91ef2c615a64cd9bfbb245dd6
Author: David Mitchell 
Date:   Tue Mar 26 14:58:04 2019 +

fix leak in Perl__force_out_malformed_utf8_message()

This function temporarily sets PL_curcop->cop_warnings to pWARN_ALL in
order to enforce mandatory warnings about malformed utf8, but it
didn't restore cop_warnings, so the old value leaked.

Can be reproduced with, e.g.

no warnings 'utf8';
CORE::evalbytes qq{ use utf8; "\\N{abc\x{c0}}"};

which is already exercised in t/uni/parser.t.

---

Summary of changes:
 utf8.c | 17 +
 1 file changed, 17 insertions(+)

diff --git a/utf8.c b/utf8.c
index e479400b71..84db2f6aee 100644
--- a/utf8.c
+++ b/utf8.c
@@ -53,6 +53,19 @@ within non-zero characters.
 =cut
 */
 
+/* helper for Perl__force_out_malformed_utf8_message(). Like
+ * SAVECOMPILEWARNINGS(), but works with PL_curcop rather than
+ * PL_compiling */
+
+static void
+S_restore_cop_warnings(pTHX_ void *p)
+{
+if (!specialWARN(PL_curcop->cop_warnings))
+PerlMemShared_free(PL_curcop->cop_warnings);
+PL_curcop->cop_warnings = (STRLEN*)p;
+}
+
+
 void
 Perl__force_out_malformed_utf8_message(pTHX_
 const U8 *const p,  /* First byte in UTF-8 sequence */
@@ -84,6 +97,10 @@ Perl__force_out_malformed_utf8_message(pTHX_
 
 PL_dowarn = G_WARN_ALL_ON|G_WARN_ON;
 if (PL_curcop) {
+/* this is like SAVECOMPILEWARNINGS() except with PL_curcop rather
+ * than PL_compiling */
+SAVEDESTRUCTOR_X(S_restore_cop_warnings,
+(void*)PL_curcop->cop_warnings);
 PL_curcop->cop_warnings = pWARN_ALL;
 }
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.9-31-g8db8ad8f4f

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 8db8ad8f4f7c0b2268caff3af198d224d63cf337
Author: David Mitchell 
Date:   Tue Mar 26 12:33:46 2019 +

fix CvFILE() leak in Perl_newMYSUB()

This is basically the same as my recent fix for Perl_newATTRSUB_x(),
v5.29.8-46-gb37d10f658.

When overwriting cv with the contents of PL_compcv, it was checking the
CvDYNFILE(cv) flag (to see if CvFILE(cv) needed freeing) *after*
overwriting cv's flags with PL_compcv's flag.

commit 85df897fcfe76250deecfdeb239ba1e4279d8532
Author: David Mitchell 
Date:   Tue Mar 26 11:04:07 2019 +

avoid leak with local $h{foo}, $a[n]

When SAVEt_DELETE / SAVEt_ADELETE deletes a hash/array entry on scope
exit, they also decrement the refcount of the hash/array, and for the
hash, also free the saved key.

However, if the call to hv_delete() or av_delete() dies (e.g. when
calling a tied DELETE method) then the hash/array and key will leak
because leave_scope() calls av/hv_delete(), *then* does the
SvREFCNT_dec() etc.

The fix is to push new FREEPV/FREESV actions just before calling
av/hv_delete().

commit 657ed7c1c190e7fad1bac2979944d07245bbeea4
Author: David Mitchell 
Date:   Tue Mar 26 08:56:55 2019 +

fix leak in package name lookup

S_parse_gv_stash_name() mallocs a temporary buffer when scanning package
names longer than 64 bytes. Depending on how it exits the function, it
doesn't always free the buffer afterwards. Change the function so that
there are only two exit points (which free the buffer) and make other bits
of code goto those two points.

Can be reproduced with e.g.

&{"xxx'x"}

Similar code is already present in t/op/stash_parse_gv.t

---

Summary of changes:
 gv.c   | 13 +
 op.c   |  6 +-
 scope.c| 17 ++---
 t/op/tie.t | 37 +
 4 files changed, 65 insertions(+), 8 deletions(-)

diff --git a/gv.c b/gv.c
index ae7f2aa422..61085f5c53 100644
--- a/gv.c
+++ b/gv.c
@@ -1636,7 +1636,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const 
char **name,
 if (!*stash)
 *stash = PL_defstash;
 if (!*stash || !SvREFCNT(*stash)) /* symbol table under 
destruction */
-return FALSE;
+goto notok;
 
 *len = name_cursor - *name;
 if (name_cursor > nambeg) { /* Skip for initial :: or ' */
@@ -1666,7 +1666,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const 
char **name,
 *gv = gvp ? *gvp : NULL;
 if (!*gv || *gv == (const GV *)&PL_sv_undef) {
 Safefree(tmpfullbuf); /* free our tmpfullbuf if it was 
used */
-return FALSE;
+goto notok;
 }
 /* here we know that *gv && *gv != &PL_sv_undef */
 if (SvTYPE(*gv) != SVt_PVGV)
@@ -1707,15 +1707,20 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const 
char **name,
MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
}
}
-Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
-return TRUE;
+goto ok;
 }
 }
 }
 *len = name_cursor - *name;
+  ok:
+Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
 return TRUE;
+  notok:
+Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
+return FALSE;
 }
 
+
 /* Checks if an unqualified name is in the main stash */
 PERL_STATIC_INLINE bool
 S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32 is_utf8)
diff --git a/op.c b/op.c
index 95a3061202..ce769c561f 100644
--- a/op.c
+++ b/op.c
@@ -9671,6 +9671,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP 
*attrs, OP *block)
 if (cv) {  /* must reuse cv in case stub is referenced elsewhere */
/* transfer PL_compcv to cv */
if (block) {
+bool free_file = CvFILE(cv) && CvDYNFILE(cv);
cv_flags_t preserved_flags =
CvFLAGS(cv) & (CVf_BUILTIN_ATTRS|CVf_NAMED);
PADLIST *const temp_padl = CvPADLIST(cv);
@@ -9692,8 +9693,9 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP 
*attrs, OP *block)
CvFLAGS(compcv) &= ~(CVf_SLABBED|CVf_WEAKOUTSIDE);
CvFLAGS(compcv) |= other_flags;
 
-   if (CvFILE(cv) && CvDYNFILE(cv)) {
+   if (free_file) {
Safefree(CvFILE(cv));
+   CvFILE(cv) = NULL;
}
 

[perl.git] branch blead updated. v5.29.9-28-ge40cca748f

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit e40cca748f05c81e1929ed625407afbe7c79d4dd
Author: David Mitchell 
Date:   Mon Mar 25 20:13:30 2019 +

fix a leak with indented heredocs

With something like

   |print <<~EOF;
   | some data
   |   EOF

it croaks (as it should) with "Indentation ... doesn't match delimiter",
but in that case it leaks the recently malloc()d 'indent' buffer.

The fix is simple.  I've also fixed by code inspection where the code
does 'goto interminable', although I didn't try to reproduce the conditions
where the goto might occur.

commit 3c2fc529eb398c7f2f197abd633720bd6bb627fc
Author: David Mitchell 
Date:   Mon Mar 25 19:44:57 2019 +

reformat S_scan_heredoc()

The indentation was inconsistent and confusing.

Reindent, add blank lines where appropriate, and change this code
comment: "(Closing '}' here to balance"  to '<<}', since vim is far too
clever for its own good these days in terms of using '%' to bounce
between brace pairs.

Should be no functional changes.

commit d44742f81c5295e9a7ce437cb55c1b56f4c7fc68
Author: David Mitchell 
Date:   Mon Mar 25 19:14:43 2019 +

S_scan_heredoc(): add cosmetic braces

add braces round a single-statement 'if' clause which contains a while
loop and spans several lines.

Should be functionally equivalent, but less visually confusing.

commit 1113f30d91f662c876a07b357666f02f04a30a75
Author: David Mitchell 
Date:   Mon Mar 25 17:18:58 2019 +

fix leak with local ${^WARNING_BITS} = ...

When restoring the old value, need to free the current value first.
Can be reproduced with

{
local ${^WARNING_BITS} = 'swit';
}

when run under ASan or similar.
An equivalent test already exists in t/op/leaky-magic.t.

---

Summary of changes:
 mg.c   |   2 +
 toke.c | 323 -
 2 files changed, 182 insertions(+), 143 deletions(-)

diff --git a/mg.c b/mg.c
index b022d63442..320e2d39bb 100644
--- a/mg.c
+++ b/mg.c
@@ -2916,6 +2916,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
else if (strEQ(mg->mg_ptr+1, "ARNING_BITS")) {
if ( ! (PL_dowarn & G_WARN_ALL_MASK)) {
if (!SvPOK(sv)) {
+if (!specialWARN(PL_compiling.cop_warnings))
+PerlMemShared_free(PL_compiling.cop_warnings);
PL_compiling.cop_warnings = pWARN_STD;
break;
}
diff --git a/toke.c b/toke.c
index 9bed338ecc..8b0c655893 100644
--- a/toke.c
+++ b/toke.c
@@ -10026,12 +10026,15 @@ S_scan_heredoc(pTHX_ char *s)
 e = PL_tokenbuf + sizeof PL_tokenbuf - 1;
 *PL_tokenbuf = '\n';
 peek = s;
+
 if (*peek == '~') {
indented = TRUE;
peek++; s++;
 }
+
 while (SPACE_OR_TAB(*peek))
peek++;
+
 if (*peek == '`' || *peek == '\'' || *peek =='"') {
s = peek;
term = *s++;
@@ -10047,19 +10050,25 @@ S_scan_heredoc(pTHX_ char *s)
s++, term = '\'';
else
term = '"';
+
if (! isWORDCHAR_lazy_if_safe(s, PL_bufend, UTF))
Perl_croak(aTHX_ "Use of bare << to mean <<\"\" is forbidden");
+
peek = s;
+
 while (isWORDCHAR_lazy_if_safe(peek, PL_bufend, UTF)) {
peek += UTF ? UTF8SKIP(peek) : 1;
}
+
len = (peek - s >= e - d) ? (e - d) : (peek - s);
Copy(s, d, len, char);
s += len;
d += len;
 }
+
 if (d >= PL_tokenbuf + sizeof PL_tokenbuf - 1)
Perl_croak(aTHX_ "Delimiter for here document is too long");
+
 *d++ = '\n';
 *d = '\0';
 len = d - PL_tokenbuf;
@@ -10102,6 +10111,7 @@ S_scan_heredoc(pTHX_ char *s)
 
 PL_multi_start = origline + 1 + PL_parser->herelines;
 PL_multi_open = PL_multi_close = '<';
+
 /* inside a string eval or quote-like operator */
 if (!infile || PL_lex_inwhat) {
SV *linestr;
@@ -10112,43 +10122,47 @@ S_scan_heredoc(pTHX_ char *s)
   entered.  But we need them set here. */
shared->ls_bufptr  = s;
shared->ls_linestr = PL_linestr;
-   if (PL_lex_inwhat)
- /* Look for a newline.  If the current buffer does not have one,
-peek into the line buffer of the parent lexing scope, going
-up as many levels as necessary to find one with a newline
-after bufptr.
-  */
- while (!(s = (char *)memchr(
-   (void *)shared->ls_bufptr, '\n',
-   SvEND(shared->ls_linestr)-shared->ls_bufptr
-   ))) {
-   shar

[perl.git] branch blead updated. v5.29.9-22-g1385ac98c5

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 1385ac98c5f75358978bb05c2d6c4134413cf689
Author: David Mitchell 
Date:   Fri Mar 22 17:38:48 2019 +

avoid leak assigning regexp to non-COW string

In something like

$s = substr(.); # $s now a non-COW SvPOK() SV
$r = qr//;
$s = $$r;

$s's previous string buffer would leak when an SVt_REGEXP type SV is
assigned to it.

Worse, if $s was an SVt_PVPV, it would fail an assert on debugging
builds.

The fix is to make sure any remaining stringy stuff is cleaned up
before copying the REGEXP.

commit 803bd7c91c63f8f263bed592a33b10cf69f567cf
Author: David Mitchell 
Date:   Fri Mar 22 15:43:56 2019 +

fix leak in BEGIN { threads->new(...) }

Normally by the time we reach perl_destruct(), PL_parser should be null
due to having its original (null) value restored by SAVEt_PARSER during
leaving scope (usually before run-time starts in fact).  But if a thread
is created within a BEGIN block, the parser is duped, but the
SAVEt_PARSER savestack entry isn't. So PL_parser never gets cleaned up.
Clean it up in perl_destruct() instead. This is a bit of a hack.

commit 75bb5aa48dfcf930533cd069393fc8a45e4ece18
Author: David Mitchell 
Date:   Fri Mar 22 12:31:57 2019 +

fix leak in cloned regexes.

When a regex is cloned for a new thread, the string buffer (which holds
the text of the original pattern) wasn't being freed because SvLEN was
being set to 0.

For example:

use threads;
my $r = qr/abc/;
threads->new( sub { 1; })->join;

In the new thread, $r is cloned  but when the thread exits, the string
buffer holding "(?^:abc)" was leaking.

This was broken by v5.27.2-30-gdf6b4bd565.

The problem was that in the cloned SV, the buffer was copied, but the
SvLEN(sv) was left set at zero, which along with the SVf_FAKE, mader it
look like the buffer was alien and so not freed.

SvLEN was 0 in the parent thread's $r, since $r and its compile-time
prototype share the same string buffer (so only the original SV has
SvLEN > 0 - all the copies - within the same thread - have mother_re
pointing to the original).

When REs are cloned into another thread, mother_re isn't preserved,
so each RE has its own copy of the buffer.

---

Summary of changes:
 perl.c| 15 +++
 regcomp.c | 21 +
 t/op/qr.t | 34 +-
 3 files changed, 69 insertions(+), 1 deletion(-)

diff --git a/perl.c b/perl.c
index cdefa99018..1ef425bb25 100644
--- a/perl.c
+++ b/perl.c
@@ -668,6 +668,21 @@ perl_destruct(pTHXx)
 FREETMPS;
 assert(PL_scopestack_ix == 0);
 
+/* normally when we get here, PL_parser should be null due to having
+ * its original (null) value restored by SAVEt_PARSER during leaving
+ * scope (usually before run-time starts in fact).
+ * But if a thread is created within a BEGIN block, the parser is
+ * duped, but the SAVEt_PARSER savestack entry isn't. So PL_parser
+ * never gets cleaned up.
+ * Clean it up here instead. This is a bit of a hack.
+ */
+if (PL_parser) {
+/* stop parser_free() stomping on PL_curcop */
+PL_parser->saved_curcop = PL_curcop;
+parser_free(PL_parser);
+}
+
+
 /* Need to flush since END blocks can produce output */
 /* flush stdout separately, since we can identify it */
 #ifdef USE_PERLIO
diff --git a/regcomp.c b/regcomp.c
index 547b9113e3..e13da83673 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -20665,7 +20665,23 @@ Perl_reg_temp_copy(pTHX_ REGEXP *dsv, REGEXP *ssv)
 if (!dsv)
dsv = (REGEXP*) newSV_type(SVt_REGEXP);
 else {
+assert(SvTYPE(dsv) == SVt_REGEXP || (SvTYPE(dsv) == SVt_PVLV));
+
+/* our only valid caller, sv_setsv_flags(), should have done
+ * a SV_CHECK_THINKFIRST_COW_DROP() by now */
+assert(!SvOOK(dsv));
+assert(!SvIsCOW(dsv));
+assert(!SvROK(dsv));
+
+if (SvPVX_const(dsv)) {
+if (SvLEN(dsv))
+Safefree(SvPVX(dsv));
+SvPVX(dsv) = NULL;
+}
+SvLEN_set(dsv, 0);
+SvCUR_set(dsv, 0);
SvOK_off((SV *)dsv);
+
if (islv) {
/* For PVLVs, the head (sv_any) points to an XPVLV, while
  * the LV's xpvlenu_rx will point to a regexp body, which
@@ -20956,6 +20972,11 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP 
*dstr, CLONE_PARAMS *param)
   2: something we no longer hold a reference on
   so we need to copy it locally.  */

[perl.git] branch blead updated. v5.29.8-135-g44b0aff01b

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 44b0aff01ba282b14dc62a1137996136282bc17a
Author: David Mitchell 
Date:   Tue Mar 19 11:15:21 2019 +

op_free() remove redundant !kid test

and replace with an assert.

If an op has the OPf_KIDS flag, then cUNOPo->op_first must be non-null.
So testing for !kid doesn't do much, especially as on the previous line
we dereference it anyway.

commit 170c919fc4986a85062e9292e4cfed24771d2224
Author: David Mitchell 
Date:   Tue Mar 19 10:58:46 2019 +

handle scope error in qr/\(?{/

RT #133879

In this code:

BEGIN {$^H = 0x1 }; # HINT_NEW_RE
qr/\(?{/

When the toker sees the 'qr', it looks ahead and thinks that the
pattern *might* contain code blocks, so creates a new anon sub to wrap
compilation of the pattern in (so that any code blocks get compiled as
part of the anon sub rather than the main body of the code).

Normally at the end of parsing the qr construct, the parser notes that
no code blocks were found, and throws the unneeded CV away and
restores the old PL_compcv (via a LEAVE_SCOPE). This false positive is
normal and is expected in the relevant code paths.

However, setting the HINT_NEW_RE  (which indicates that
overload::constant is present for qr// but with no overloaded function
actually present) causes an error to be raised. The parser does error
recovery and continues.

However, v5.25.9-148-g7c44985626 added a test to not bother compiling a
pattern if the parser is in an errored state, which again is fine,
except it turns out that if this branch is taken, it skips the 'restore
the old PL_compcv' code, leading to the wrong value for PL_compcv when
ops are freed.

The fix is simple: move the "skip if errored" test to after PL_compcv
has been restored.

---

Summary of changes:
 op.c  | 23 ---
 t/re/reg_eval_scope.t | 14 +-
 2 files changed, 29 insertions(+), 8 deletions(-)

diff --git a/op.c b/op.c
index 1f7ae3e610..95a3061202 100644
--- a/op.c
+++ b/op.c
@@ -884,9 +884,10 @@ Perl_op_free(pTHX_ OP *o)
 
 if (o->op_flags & OPf_KIDS) {
 OP *kid, *nextkid;
+assert(cUNOPo->op_first); /* OPf_KIDS implies op_first non-null */
 for (kid = cUNOPo->op_first; kid; kid = nextkid) {
 nextkid = OpSIBLING(kid); /* Get before next freeing kid */
-if (!kid || kid->op_type == OP_FREED)
+if (kid->op_type == OP_FREED)
 /* During the forced freeing of ops after
compilation failure, kidops may be freed before
their parents. */
@@ -7082,11 +7083,6 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV 
flags, I32 floor)
 rx_flags |= RXf_SPLIT;
 }
 
-/* Skip compiling if parser found an error for this pattern */
-if (pm->op_pmflags & PMf_HAS_ERROR) {
-return o;
-}
-
if (!has_code || !eng->op_comp) {
/* compile-time simple constant pattern */
 
@@ -7123,6 +7119,11 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV 
flags, I32 floor)
pm->op_pmflags &= ~PMf_HAS_CV;
}
 
+/* Skip compiling if parser found an error for this pattern */
+if (pm->op_pmflags & PMf_HAS_ERROR) {
+return o;
+}
+
PM_SETRE(pm,
eng->op_comp
? eng->op_comp(aTHX_ NULL, 0, expr, eng, NULL, NULL,
@@ -7134,7 +7135,15 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV 
flags, I32 floor)
}
else {
/* compile-time pattern that includes literal code blocks */
-   REGEXP* re = eng->op_comp(aTHX_ NULL, 0, expr, eng, NULL, NULL,
+
+   REGEXP* re;
+
+/* Skip compiling if parser found an error for this pattern */
+if (pm->op_pmflags & PMf_HAS_ERROR) {
+return o;
+}
+
+   re = eng->op_comp(aTHX_ NULL, 0, expr, eng, NULL, NULL,
rx_flags,
(pm->op_pmflags |
((PL_hints & HINT_RE_EVAL) ? PMf_USE_RE_EVAL : 0))
diff --git a/t/re/reg_eval_scope.t b/t/re/reg_eval_scope.t
index 25b90b6482..3bf937d251 100644
--- a/t/re/reg_eval_scope.t
+++ b/t/re/reg_eval_scope.t
@@ -12,7 +12,7 @@ BEGIN {
 }
 }
 
-plan 48;
+plan 49;
 
 fresh_perl_is <<'CODE', '781745', {}, '(?{}) has its own lexical scope';
  my $x = 7; my $a = 4; my $b = 5;
@@ -371,3 +371,15 @@ SKIP: {
 f3();
 is ($s, \&f3, '__SUB__ qr mu

[perl.git] branch blead updated. v5.29.8-120-g0275405c4f

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 0275405c4fd00a8e74de313c3fd5a82c0a1ecbea
Author: David Mitchell 
Date:   Tue Mar 12 11:05:48 2019 +

fix paren buffer leak in (?|...)

The (?| ... | ... |... ) alternation resets the paren index for each
branch. This can trick the code in S_reg() into re-mallocing the open
and close paren index buffers during every branch, leaking the old ones.

This commit fixes the leak by introducing a new compilation variable,
RExC_parens_buf_size, which records the actual number of slots malloced.

By decoupling RExC_parens_buf_size from RExC_npar, it also means that
the code can allocate a buffer larger than currently needed. This means
that
/(.)(.)(.)(.)/

no longer does a malloc() and 3 reallocs(), but instead initially
mallocs 10 slots, and if more than 10 captures are seen during
compilation, reallocs() to 20, 40, 80 

---

Summary of changes:
 regcomp.c | 38 +++---
 1 file changed, 27 insertions(+), 11 deletions(-)

diff --git a/regcomp.c b/regcomp.c
index 816d735f5b..658896f615 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -163,6 +163,7 @@ struct RExC_state_t {
 I32seen_zerolen;
 regnode_offset *open_parens;   /* offsets to open parens */
 regnode_offset *close_parens;  /* offsets to close parens */
+I32  parens_buf_size;   /* #slots malloced open/close_parens */
 regnode *end_op;/* END node in program */
 I32utf8;   /* whether the pattern is utf8 or not */
 I32orig_utf8;  /* whether the pattern was originally 
in utf8 */
@@ -253,6 +254,7 @@ struct RExC_state_t {
 #define RExC_maxlen(pRExC_state->maxlen)
 #define RExC_npar  (pRExC_state->npar)
 #define RExC_total_parens  (pRExC_state->total_par)
+#define RExC_parens_buf_size   (pRExC_state->parens_buf_size)
 #define RExC_nestroot   (pRExC_state->nestroot)
 #define RExC_seen_zerolen  (pRExC_state->seen_zerolen)
 #define RExC_utf8  (pRExC_state->utf8)
@@ -7666,6 +7668,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int 
pat_count,
 
 RExC_naughty = 0;
 RExC_npar = 1;
+RExC_parens_buf_size = 0;
 RExC_emit_start = RExC_rxi->program;
 pRExC_state->code_index = 0;
 
@@ -11975,31 +11978,44 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 
*flagp, U32 depth)
 if (! ALL_PARENS_COUNTED) {
 /* If we are in our first pass through (and maybe only pass),
  * we  need to allocate memory for the capturing parentheses
- * data structures.  Since we start at npar=1, when it reaches
- * 2, for the first time it has something to put in it.  Above
- * 2 means we extend what we already have */
-if (RExC_npar == 2) {
+ * data structures.
+ */
+
+if (!RExC_parens_buf_size) {
+/* first guess at number of parens we might encounter */
+RExC_parens_buf_size = 10;
+
 /* setup RExC_open_parens, which holds the address of each
  * OPEN tag, and to make things simpler for the 0 index the
  * start of the program - this is used later for offsets */
-Newxz(RExC_open_parens, RExC_npar, regnode_offset);
+Newxz(RExC_open_parens, RExC_parens_buf_size,
+regnode_offset);
 RExC_open_parens[0] = 1;/* +1 for REG_MAGIC */
 
 /* setup RExC_close_parens, which holds the address of each
  * CLOSE tag, and to make things simpler for the 0 index
  * the end of the program - this is used later for offsets
  * */
-Newxz(RExC_close_parens, RExC_npar, regnode_offset);
+Newxz(RExC_close_parens, RExC_parens_buf_size,
+regnode_offset);
 /* we dont know where end op starts yet, so we dont need to
  * set RExC_close_parens[0] like we do RExC_open_parens[0]
  * above */
 }
-else {
-Renew(RExC_open_parens, RExC_npar, regnode_offset);
-Zero(RExC_open_parens + RExC_npar - 1, 1, regnode_offset);
+else if (RExC_npar > RExC_parens_buf_size) {
+I32 old_size = RExC_parens_buf_size;
+
+RExC_parens_buf_size *= 2;
+
+Renew(RExC_o

[perl.git] branch blead updated. v5.29.8-66-geef8d518b9

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit eef8d518b95b0221f81805d75bd63fbbf2995f3b
Author: David Mitchell 
Date:   Tue Mar 12 07:10:10 2019 +

fix blead on non-threaded builds

My recent v5.29.8-64-g02a9632ac4 commit broke unthreaded builds.
This is the obvious fix. I've heard a report that unthreaded perl
SEGVs now but can't reproduce.

---

Summary of changes:
 op.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/op.c b/op.c
index 4e49df..b4ba9c8f83 100644
--- a/op.c
+++ b/op.c
@@ -14716,8 +14716,8 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV 
orig_action, U8 hints)
 pass);
 }
 
-#ifdef USE_ITHREADS
 if (pass) {
+#ifdef USE_ITHREADS
 /* Relocate sv to the pad for thread safety */
 op_relocate_sv(&cSVOPo->op_sv, &o->op_targ);
 arg->pad_offset = o->op_targ;

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.8-65-gca6ebcd640

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit ca6ebcd6405d5ab46fb0688c45dc44661698a7c0
Author: David Mitchell 
Date:   Mon Mar 11 16:18:10 2019 +

Fix leak on syntax error in main prog

t/lib/croak.t was failing several tests under ASan because it was
running small stand-alone programs with some sort of error in, such as

BEGIN { }
myfunc 1;

Unlike other code paths (such as S_doeval_compile() for evals),
Perl_newPROG() - when called for the main body rather than for a
completed eval - was calling cv_forget_slab() on PL_compcv regardless of
whether an error was present. That call converts  the compiling CV into
a compiled one, which disclaims ownership of the slab(s) its ops are
embedded in. This means that when the CV is freed, ops within the slab
which aren't embedded within the PL_main_root tree would leak.

Such ops may exist when Perl_newPROG() is reached after one of more
errors.

The fix is simply to not call cv_forget_slab() if the error count is > 0.

commit 02a9632ac4bf515585a2f25b05b2939de1743ded
Author: David Mitchell 
Date:   Fri Mar 8 08:40:29 2019 +

fix leak when compiling typed hash deref

In something like

my Foo $h;
$h->{bad_key}

perl will croak if package Foo defines valid %FIELDS and  bad_key isn't
one of them. This croak happens during the second pass in
S_maybe_multideref(), which is trying to convert $h->{bad_key} into a
single multideref op. Since the aux buffer is allocated at the end of
the first pass, the buffer leaks.

The fix is to do the check in the first pass, which has been done by
adding an extra boolean flag to S_check_hash_fields_and_hekify(),
indicating whether to just check or actually do it.

---

Summary of changes:
 op.c  | 27 +++
 t/op/multideref.t | 11 ++-
 2 files changed, 29 insertions(+), 9 deletions(-)

diff --git a/op.c b/op.c
index 40bc2ef84e..4e49df 100644
--- a/op.c
+++ b/op.c
@@ -2450,12 +2450,13 @@ S_modkids(pTHX_ OP *o, I32 type)
 
 /* for a helem/hslice/kvslice, if its a fixed hash, croak on invalid
  * const fields. Also, convert CONST keys to HEK-in-SVs.
- * rop is the op that retrieves the hash;
+ * ropis the op that retrieves the hash;
  * key_op is the first key
+ * real   if false, only check (and possibly croak); don't update op
  */
 
 STATIC void
-S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_op)
+S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_op, int real)
 {
 PADNAME *lexname;
 GV **fields;
@@ -2505,7 +2506,8 @@ S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP 
*key_op)
 if (   !SvIsCOW_shared_hash(sv = *svp)
 && SvTYPE(sv) < SVt_PVMG
 && SvOK(sv)
-&& !SvROK(sv))
+&& !SvROK(sv)
+&& real)
 {
 SSize_t keylen;
 const char * const key = SvPV_const(sv, *(STRLEN*)&keylen);
@@ -3731,7 +3733,7 @@ S_finalize_op(pTHX_ OP* o)
 check_keys:
 if (o->op_private & OPpLVAL_INTRO || rop->op_type != OP_RV2HV)
 rop = NULL;
-S_check_hash_fields_and_hekify(aTHX_ rop, key_op);
+S_check_hash_fields_and_hekify(aTHX_ rop, key_op, 1);
 break;
 }
 case OP_NULL:
@@ -5413,7 +5415,10 @@ Perl_newPROG(pTHX_ OP *o)
 start = LINKLIST(PL_main_root);
PL_main_root->op_next = 0;
 S_process_optree(aTHX_ NULL, PL_main_root, start);
-   cv_forget_slab(PL_compcv);
+if (!PL_parser->error_count)
+/* on error, leave CV slabbed so that ops left lying around
+ * will eb cleaned up. Else unslab */
+cv_forget_slab(PL_compcv);
PL_compcv = 0;
 
/* Register with debugger */
@@ -14691,12 +14696,13 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV 
orig_action, U8 hints)
  * the extra hassle for those edge cases */
 break;
 
-if (pass) {
+{
 UNOP *rop = NULL;
 OP * helem_op = o->op_next;
 
 ASSUME(   helem_op->op_type == OP_HELEM
-   || helem_op->op_type == OP_NULL);
+   || helem_op->op_type == OP_NULL
+   || pass == 0);
 if (helem_op->op_type == OP_HELEM) {
 rop = (UNOP*)(((BINOP*)helem_op)->op_first);
 if (   helem_op-

[perl.git] branch blead updated. v5.29.8-46-gb37d10f658

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit b37d10f658c300104241001e3f5de1f31d62b22f
Author: David Mitchell 
Date:   Thu Mar 7 10:23:04 2019 +

fix CvFILE() leak in Perl_newATTRSUB_x()

When overwriting cv with the contents of PL_compcv, it was checking the
CvDYNFILE(cv) flag (to see if CvFILE(cv) needed freeing) *after*
overwriting cv's flags with PL_compcv's flag.

commit f60d17f54c2572c2534479a32236201866b2
Author: David Mitchell 
Date:   Thu Mar 7 10:21:25 2019 +

Improve description of CVf_DYNFILE flag

commit bfefaec2e78fd51f89738f65efad8ffaf0017da3
Author: David Mitchell 
Date:   Thu Mar 7 08:42:59 2019 +

add comments above Perl_newSTUB()

commit 7d79ca0952ed6929075e5a3a9d5d24ce212eb6e2
Author: David Mitchell 
Date:   Wed Mar 6 16:13:45 2019 +

fix leak in regex re-entrant capture buffer

When a regex is about to be executed, if it is the same regex as
PL_curpm, then its 'offs' capture-indices buffer is saved in a local var
pointer and a new one allocated. At the end of execution, depending on
success or failure, the old buffer is restored and the new freed, or
vice versa.

However, if the regex dies during execution, e.g. /(?{ die })/
then the old buffer will leak.

So use SAVEFREEPV() on the old buffer, and change the 'restore on
failure' behaviour - always free the old buffer and keep the new
buffer, and instead copy the old indices to the new buffer.

commit 495a482db9ba8e2fe6ca17ef4c9b0b1dca65d7fd
Author: David Mitchell 
Date:   Wed Mar 6 10:36:23 2019 +

fix leak in /[(?{]/

This pattern is correctly interpreted by the parser as not containing
any code blocks, e.g. (?{...}). It's then passed to the regex compiler,
which thinks it may after all contain a code block not seen before (e.g.
interpolated in at runtime). So it evals the code qr'[(?{]' to compile
any code blocks.  Again the parser doesn't see any code blocks, so the
regex compiler realises it was wrong, and attempts to free the hidden
anon CV associated with compiling a qr// (this CV would take ownership
of any found code blocks, but is empty apart from a single OP_CONST
containing the text of regex).

This freeing of the CV was going wrong, resulting in the op slab(s)
associated with the anon CV leaking.

This was because cv_forget_slab(PL_compcv) was being called, which
converts a compiling CV into a compiled  CV, where CvSTART() no longer
points to the op slab, and instead the slab can only be accessed
indirectly via the ops in CvROOT().

Then when the CV is freed, because it is no longer marked as SvSLABBED,
the freeing code assumes that any associated ops are attached via
SvROOT() - but they haven't been yet - they're still sitting on the
yyparse stack. So they leak.

The solution seems to be a simple as removing the call to
cv_forget_slab().

I sort of understood this as I wrote this commit message, but it's
fading already. Don't ask me to explain this in a week's time, let alone
next year.

commit 49c01b24867571217e880f4de5d82ed1d3b09dc6
Author: David Mitchell 
Date:   Tue Mar 5 10:24:30 2019 +

docs for op slab functions

Add some basic code comments at the top of each function associated
with allocating and freeing OP slabs.

---

Summary of changes:
 cv.h   |  2 +-
 op.c   | 43 ---
 regexec.c  | 39 +--
 t/re/pat.t | 26 +-
 4 files changed, 83 insertions(+), 27 deletions(-)

diff --git a/cv.h b/cv.h
index dac83fa873..d50e320f16 100644
--- a/cv.h
+++ b/cv.h
@@ -129,7 +129,7 @@ See L.
 #ifdef PERL_CORE
 # define CVf_SLABBED   0x0800  /* Holds refcount on op slab  */
 #endif
-#define CVf_DYNFILE0x1000  /* The filename isn't static  */
+#define CVf_DYNFILE0x1000  /* The filename is malloced  */
 #define CVf_AUTOLOAD   0x2000  /* SvPVX contains AUTOLOADed sub name  */
 #define CVf_HASEVAL0x4000  /* contains string eval  */
 #define CVf_NAMED  0x8000  /* Has a name HEK */
diff --git a/op.c b/op.c
index 75d25f3e7d..40bc2ef84e 100644
--- a/op.c
+++ b/op.c
@@ -246,6 +246,8 @@ S_prune_chain_head(OP** op_p)
 #define SIZE_TO_PSIZE(x)   (((x) + sizeof(I32 *) - 1)/sizeof(I32 *))
 #define DIFF(o,p)  ((size_t)((I32 **)(p) - (I32**)(o)))
 
+/* malloc a new op slab (suitable for attaching to PL_compcv) */
+
 static OPSLAB *
 S_new_slab(pTHX_ size_t sz)
 {
@@ -277,6 +279,12 @@ S_new_slab(pTHX_ size_t sz)
PerlIO_printf(Perl_debug_log, "%s", SvPVx_nolen(Perl_mess args)) \

[perl.git] branch blead updated. v5.29.8-19-gc1e47bad34

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit c1e47bad34ce1d9c84ed57c9b8978bcbd5a02e98
Author: David Mitchell 
Date:   Mon Feb 25 13:05:04 2019 +

add Perl_dup_warnings() and fix leak

The macro DUP_WARNINGS() was doing (approximately)

new = CopyD(old, malloc(size), size);

which, depending on how the CopyD macro expanded (e.g. on debugging
builds), could result in its arguments being used multiple times, and
thus malloc() being called multiple times, with the result of the
earlier call(s) then leaking.

Fix this by implementing DUP_WARNINGS using a new function,
Perl_dup_warnings() that stores its intermediate values in local vars.

This function isn't performance critical, as its usually only called
once per cop creation at compile time.

---

Summary of changes:
 embed.fnc |  2 ++
 op.c  | 20 
 proto.h   |  3 +++
 regen/warnings.pl |  5 +
 warnings.h|  5 +
 5 files changed, 27 insertions(+), 8 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index 17011f2013..4b33a681c6 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -3279,4 +3279,6 @@ XEop  |void   |dtrace_probe_op   |NN const OP *op
 XEop   |void   |dtrace_probe_phase|enum perl_phase phase
 #endif
 
+XEop   |STRLEN*|dup_warnings   |NN STRLEN* warnings
+
 : ex: set ts=8 sts=4 sw=4 noet:
diff --git a/op.c b/op.c
index 6ca89486e3..2b162e1665 100644
--- a/op.c
+++ b/op.c
@@ -17042,6 +17042,26 @@ const_av_xsub(pTHX_ CV* cv)
 XSRETURN(AvFILLp(av)+1);
 }
 
+/* Copy an existing cop->cop_warnings field.
+ * If it's one of the standard addresses, just re-use the address.
+ * This is the e implementation for the DUP_WARNINGS() macro
+ */
+
+STRLEN*
+Perl_dup_warnings(pTHX_ STRLEN* warnings)
+{
+Size_t size;
+STRLEN *new_warnings;
+
+if (specialWARN(warnings))
+return warnings;
+
+size = sizeof(*warnings) + *warnings;
+
+new_warnings = (STRLEN*)PerlMemShared_malloc(size);
+Copy(warnings, new_warnings, size, char);
+return new_warnings;
+}
 
 /*
  * ex: set ts=8 sts=4 sw=4 et:
diff --git a/proto.h b/proto.h
index b7a3eb3fd9..64ec373683 100644
--- a/proto.h
+++ b/proto.h
@@ -899,6 +899,9 @@ PERL_CALLCONV void  Perl_dump_sub_perl(pTHX_ const GV* gv, 
bool justperl);
 PERL_CALLCONV void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const 
char* pat, va_list *args);
 #define PERL_ARGS_ASSERT_DUMP_VINDENT  \
assert(file); assert(pat)
+PERL_CALLCONV STRLEN*  Perl_dup_warnings(pTHX_ STRLEN* warnings);
+#define PERL_ARGS_ASSERT_DUP_WARNINGS  \
+   assert(warnings)
 PERL_CALLCONV void Perl_emulate_cop_io(pTHX_ const COP *const c, SV *const 
sv);
 #define PERL_ARGS_ASSERT_EMULATE_COP_IO\
assert(c); assert(sv)
diff --git a/regen/warnings.pl b/regen/warnings.pl
index d244160b3e..504d86288e 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -376,10 +376,7 @@ EOM
 #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
 #define isWARNf_on(c,x)(IsSet((U8 *)(c + 1), 2*(x)+1))
 
-#define DUP_WARNINGS(p)\
-(specialWARN(p) ? (STRLEN*)(p) \
-: (STRLEN*)CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, \
-char))
+#define DUP_WARNINGS(p) Perl_dup_warnings(aTHX_ p)
 
 /*
 
diff --git a/warnings.h b/warnings.h
index 58f52272de..d076e7acc1 100644
--- a/warnings.h
+++ b/warnings.h
@@ -133,10 +133,7 @@
 #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
 #define isWARNf_on(c,x)(IsSet((U8 *)(c + 1), 2*(x)+1))
 
-#define DUP_WARNINGS(p)\
-(specialWARN(p) ? (STRLEN*)(p) \
-: (STRLEN*)CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, \
-char))
+#define DUP_WARNINGS(p) Perl_dup_warnings(aTHX_ p)
 
 /*
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.8-18-g6096c8b5a8

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 6096c8b5a857766814f7e67361965635283f2354
Author: David Mitchell 
Date:   Sun Feb 24 12:53:20 2019 +

t/re/pat.t: avoid failing test under ASan

---

Summary of changes:
 t/re/pat.t | 10 ++
 1 file changed, 10 insertions(+)

diff --git a/t/re/pat.t b/t/re/pat.t
index 28a717b676..8e9ad812f3 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -1467,7 +1467,17 @@ EOP
 # test that this is true for 1..100
 # Note that this test causes the engine to recurse at runtime, and
 # hence use a lot of C stack.
+
+# Compiling for all 100 nested captures blows the stack under
+# clang and ASan; reduce.
+my $max_captures = $Config{ccflags} =~ /sanitize/ ? 20 : 100;
+
 for my $i (1..100) {
+if ($i > $max_captures) {
+pass("skipping $i buffers under ASan aa");
+pass("skipping $i buffers under ASan aba");
+next;
+}
 my $capture= "a";
 $capture= "($capture)" for 1 .. $i;
 for my $mid ("","b") {

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.8-11-g929e53be97

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 929e53be972b0c811eca54a3c7017db116f62e4a
Author: David Mitchell 
Date:   Sat Feb 23 12:27:17 2019 +

upgrade cpan/JSON-PP from 4.00 to 4.02

4.02 2019-02-23
- fix a test that breaks if perl is compiled with
  -Dquadmath (RT-128589)

4.01 2019-02-22
- allow to pass indent_length to json_pp (GH#46)

---

Summary of changes:
 META.json|  2 +-
 Porting/Maintainers.pl   |  2 +-
 cpan/JSON-PP/bin/json_pp | 20 +++-
 cpan/JSON-PP/lib/JSON/PP.pm  |  4 ++--
 cpan/JSON-PP/t/011_pc_expo.t |  2 +-
 5 files changed, 20 insertions(+), 10 deletions(-)

diff --git a/META.json b/META.json
index 5216ba9a07..cacbc8acd0 100644
--- a/META.json
+++ b/META.json
@@ -128,5 +128,5 @@
   }
},
"version" : "5.029009",
-   "x_serialization_backend" : "JSON::PP version 4.00"
+   "x_serialization_backend" : "JSON::PP version 4.02"
 }
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 5775b11347..1bff10bda7 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -651,7 +651,7 @@ use File::Glob qw(:case);
 },
 
 'JSON::PP' => {
-'DISTRIBUTION' => 'ISHIGAKI/JSON-PP-4.00.tar.gz',
+'DISTRIBUTION' => 'ISHIGAKI/JSON-PP-4.02.tar.gz',
 'FILES'=> q[cpan/JSON-PP],
 },
 
diff --git a/cpan/JSON-PP/bin/json_pp b/cpan/JSON-PP/bin/json_pp
index 6221315399..5f956b1fc3 100644
--- a/cpan/JSON-PP/bin/json_pp
+++ b/cpan/JSON-PP/bin/json_pp
@@ -10,7 +10,7 @@ use JSON::PP ();
 
 my %allow_json_opt = map { $_ => 1 } qw(
 ascii latin1 utf8 pretty indent space_before space_after relaxed canonical 
allow_nonref
-allow_singlequote allow_barekey allow_bignum loose escape_slash
+allow_singlequote allow_barekey allow_bignum loose escape_slash 
indent_length
 );
 
 
@@ -31,12 +31,20 @@ if ( $version ) {
 
 $json_opt = '' if $json_opt eq '-';
 
-my @json_opt = grep { $allow_json_opt{ $_ } or die "'$_' is not a valid json 
option" } split/,/, $json_opt;
+my %json_opt;
+for my $opt (split /,/, $json_opt) {
+my ($key, $value) = split /=/, $opt, 2;
+$value = 1 unless defined $value;
+die "'$_' is not a valid json option" unless $allow_json_opt{$key};
+$json_opt{$key} = $value;
+}
 
 my %F = (
'json' => sub {
   my $json = JSON::PP->new;
-  $json->$_() for @json_opt;
+  for my $key (keys %json_opt) {
+$json->$key($json_opt{$key});
+  }
   $json->decode( $_ );
},
'eval' => sub {
@@ -51,8 +59,10 @@ my %T = (
'null' => sub { "" },
'json' => sub {
   my $json = JSON::PP->new->utf8;
-  $json->$_() for @json_opt;
-  $json->canonical if grep {$_ eq 'pretty'} @json_opt;
+  for my $key (keys %json_opt) {
+$json->$key($json_opt{$key});
+  }
+  $json->canonical if $json_opt{pretty};
   $json->encode( $_ );
},
'dumper' => sub {
diff --git a/cpan/JSON-PP/lib/JSON/PP.pm b/cpan/JSON-PP/lib/JSON/PP.pm
index 6adb57f5bd..d8b7ab3065 100644
--- a/cpan/JSON-PP/lib/JSON/PP.pm
+++ b/cpan/JSON-PP/lib/JSON/PP.pm
@@ -14,7 +14,7 @@ use JSON::PP::Boolean;
 use Carp ();
 #use Devel::Peek;
 
-$JSON::PP::VERSION = '4.00';
+$JSON::PP::VERSION = '4.02';
 
 @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
 
@@ -1773,7 +1773,7 @@ JSON::PP - JSON::XS compatible pure-Perl module.
 
 =head1 VERSION
 
-4.00
+4.02
 
 =head1 DESCRIPTION
 
diff --git a/cpan/JSON-PP/t/011_pc_expo.t b/cpan/JSON-PP/t/011_pc_expo.t
index 42fe328ede..3167ef977c 100644
--- a/cpan/JSON-PP/t/011_pc_expo.t
+++ b/cpan/JSON-PP/t/011_pc_expo.t
@@ -37,7 +37,7 @@ $js  = q|[1.01e+30]|;
 $obj = $pc->decode($js);
 is($obj->[0], 1.01e+30, 'digit 1.01e+30');
 $js = $pc->encode($obj);
-like($js,qr/\[1.01[Ee]\+0?30\]/, 'digit 1.01e+30');
+like($js,qr/\[(?:1.01[Ee]\+0?30|101)]/, 'digit 
1.01e+30'); # RT-128589 (-Duselongdouble or -Dquadmath) 
 
 my $vax_float = (pack("d",1) =~ /^[\x80\x10]\x40/);
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.8-10-g678ae29284

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 678ae29284d351e19c3401c94ccf83538266b096
Author: David Mitchell 
Date:   Fri Feb 22 10:59:23 2019 +

Perl_op_sibling_splice(0 remove dead code

Spotted by Coverity.

We've already checkerd earlier on that at least one of parent and start
is non-null, so the line in question can never be reached. Turn it into
an assertion instead.

---

Summary of changes:
 op.c | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/op.c b/op.c
index 8e7123dff5..6ca89486e3 100644
--- a/op.c
+++ b/op.c
@@ -1442,8 +1442,7 @@ Perl_op_sibling_splice(OP *parent, OP *start, int 
del_count, OP* insert)
 OpMAYBESIB_set(start, insert, NULL);
 }
 else {
-if (!parent)
-goto no_parent;
+assert(parent);
 cLISTOPx(parent)->op_first = insert;
 if (insert)
 parent->op_flags |= OPf_KIDS;

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.7-159-g737b460d49

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 737b460d4977201e63598daf5cc7d1c00b9fb809
Merge: 0bb8cb436d 54d7f55c0b
Author: David Mitchell 
Date:   Tue Feb 19 15:41:03 2019 +

[MERGE] fix PERL_GLOBAL_STRUCT builds

PERL_GLOBAL_STRUCT and DPERL_GLOBAL_STRUCT_PRIVATE builds haven't been
smoked for quite a while and the code has bit-rotted. The commits in
this branch made them build and all test pass again, at least on Linux

commit 54d7f55c0b7e797212eebb61c3f7e9e0cce0d442
Author: David Mitchell 
Date:   Tue Feb 19 15:20:16 2019 +

merge two versions of Perl_my_cxt_init

There are two separate copies of this function, chosen by
the presence of PERL_GLOBAL_STRUCT_PRIVATE. The previous couple of
commits have made them more similar; this commit merges them into a
single function with differing blocks of code protected by
PERL_GLOBAL_STRUCT_PRIVATE

commit 6a90e9f22120a5e2df51543e0402e2ad3b11017d
Author: David Mitchell 
Date:   Tue Feb 19 14:59:24 2019 +

Perl_my_cxt_init: remove unnecessary code

In the PERL_GLOBAL_STRUCT_PRIVATE variant of this code, it zeroes out
unused slots of a freshly-realloced PL_my_cxt_list[]. This is not
necessary, as those slots won't be used until a new index is allocated,
as which point the new slot will get written to before anything else.

The non-PERL_GLOBAL_STRUCT_PRIVATE variant of this function doesn't have
this redundant zeroing.

So remove it.

commit 8e7615cb2f19df1393c4e187d2c3ef6cb73e2b1a
Author: David Mitchell 
Date:   Tue Feb 19 14:35:31 2019 +

harmonise two versions of Perl_my_cxt_init

There are two separate copies of this function, chosen by
the presence of PERL_GLOBAL_STRUCT_PRIVATE.

Make the two versions closer to each other, to allow shortly for
merging.

Mainly its renaming the int pointer parameter from 'index' to 'indexp',
and adding a local var 'index', which is assigned from *indexp where
appropriate.

Also harmonise some of the comments between the two functions.

commit c32805c1fdc2309bfc236013edc5490117fb28df
Author: David Mitchell 
Date:   Tue Feb 19 12:29:38 2019 +

perlvars.h: remove #ifdef DEBUGGING

Under PERL_GLOBAL_STRUCT, all the "global" vars are put in a structure,
which means perlvars.h needs a similar constraint to intrpvar.h:
its size and alignment shouldn't change between debugging and
non-debugging builds. This is because regcomp/exec.c are compiled both
with and without DEBUGGING.

[Fixed by Karl]

commit a6098fe8178c5ef2e7abbc8faf4c0f62b9b197ea
Author: David Mitchell 
Date:   Tue Feb 19 11:06:38 2019 +

PERL_GLOBAL_STRUCT: remove static var from sv.c

This var was protected by PERL_GLOBAL_STRUCT_PRIVATE, but
PERL_GLOBAL_STRUCT doesn't allow static vars either.

commit d6158b17934aab8f3f06ee6dd0a9fac0ac6940dd
Author: David Mitchell 
Date:   Tue Feb 19 08:53:43 2019 +

get MakeMaker to play under PERL_GLOBAL_STRUCT

Under PERL_GLOBAL_STRUCT (well, actually I've only tried under
PERL_GLOBAL_STRUCT_PRIVATE), cpan/ExtUtils-MakeMaker/t/03-xsstatic.t
was failing some tests. This was because it was creating a
statically-linked perl binary, but wasn't compiling perlmain.c with
-DPERL_CORE. Usually this doesn't matter, but under PERL_GLOBAL_STRUCT
it needed a definition of aTHX which it was pulling from XSUB.h rather
than perl.h, causing a SEGV.

Until a proper fix makes it way into MakeMaker, explicitly define
PERL_CORE in perlmain.c

commit 04912be77a628a4643d16a99a332a73853926079
Author: David Mitchell 
Date:   Mon Feb 18 09:29:29 2019 +

fix thread issue with PERL_GLOBAL_STRUCT

The MY_CXT subsystem allows per-thread pseudo-static data storage.
Part of the implementation for this involves each XS module being
assigned a unique index in its my_cxt_index static var when first
loaded.

Because PERL_GLOBAL_STRUCT bans any static vars, under those builds
there is instead a table which maps the MY_CXT_KEY identifying string to
index.

Unfortunately, this table was allocated per-interpreter rather than
globally, meaning if multiple threads tried to load the same XS module,
crashes could ensue.

This manifested itself in failures in
ext/XS-APItest/t/keyword_plugin_threads.t

The fix is relatively straightforward: allocate PL_my_cxt_keys globally
rather than per-interpreter.

Also record the size of this struct in a new var, PL_my_cxt_keys_size,
rather than doing double duty on PL_my_cxt_size.

commit 61d4c87c940fea028f08f27addc275b469320fda
Author: David Mitchell 
Date:   Mon Feb

[perl.git] branch blead updated. v5.29.7-143-g0bb8cb436d

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 0bb8cb436da6e18869ede1dfa3d55abc438bff5f
Author: David Mitchell 
Date:   Tue Feb 19 09:12:33 2019 +

re/user_prop_race_thr.t: reduce timeout

This new test script has a test that's supposed to exercise an up-to 10s
wait-and-retry loop when loading properties. It has a 500s timeout
built-in for if that fails. On my system its been intermittently
failing (not sure if due to something I'm doing or a problem with the
test or with regcomp.c) which effectively hangs the test run.

So decrease the timeout to 25 secs.

---

Summary of changes:
 t/re/user_prop_race_thr.t | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/t/re/user_prop_race_thr.t b/t/re/user_prop_race_thr.t
index 18d3eb5f41..c240a596c7 100644
--- a/t/re/user_prop_race_thr.t
+++ b/t/re/user_prop_race_thr.t
@@ -95,7 +95,7 @@ require threads;
 
 state $which = 0;
 
-sleep(500) unless $which++;
+sleep(25) unless $which++;
 return "0042";
 }
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.7-71-g9730c47616

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 9730c47616258ce7e7ec58cb5e16a1800bb5099b
Merge: 35c1827fad 4e521aaf3e
Author: David Mitchell 
Date:   Tue Feb 5 14:04:32 2019 +

[MERGE] various overload fixups

This branch contains several commits which simplify the code concerning
the processing of a value returned by an overload method, and
specifically whether that value should be returned as-is by the op, or
assigned to the targ / stack value: $lex = x op y) and (x op= y)
respectively.

The final commit fixes a bug in pp_multiconcat. That op bypasses most of
the code in those earlier commits and "rolls it's own", and which was
getting the set/assign decision wrong in some cases, causing a leak.

commit 4e521aaf3ed717774455b3906bd5aa46bc397319
Author: David Mitchell 
Date:   Tue Feb 5 13:48:21 2019 +

Avoid leak in multiconcat with overloading.

RT #133789

In the path taken through pp_multiconcat() when one or more args have
side-effects such tieing or overloading, multiconcat has to decide
whether to just return the result of all the concatting as-is, or to
first assign it to an expression or variable if the op includes an
implicit assign (such as $lex = x.y.z or $a[0] = x.y.z).

The code was getting this right for those two cases, and was also
getting it right for the append cases ($lex .= x.y.z and $a[0] .= x.y.z),
which don't need assigns. But for the bare case (x.y.z) it was assigning
to the op's targ as well as returning the value. Hence leaking a
reference until destruction of the sub and its pad.

This commit stops the assign in that last case.

commit 13874762cb298e7f922df49e6c78fd3f2308d860
Author: David Mitchell 
Date:   Mon Feb 4 15:17:02 2019 +

Perl_try_amagic_un/bin re-indent

After the previous commit's simplification, eliminate a set of braces and
re-indent a block of code.

commit 0872de45fff4b1f6c17e1d5bec82d3d5095801a2
Author: David Mitchell 
Date:   Mon Feb 4 15:07:11 2019 +

Eliminate AMGf_set flag

I added this flag a few years ago when I revamped the overload macros
tryAMAGICbin() etc. It allowed two different classes of macros to
share the same functions (Perl_try_amagic_un/Perl_try_amagic_bin)
by indicating what type of action is required.

However, the last few commits have made those two functions able to
robustly always determine whether its an assign-type action
($x op= $y or  $lex = $x op $x) or a plain set-result-on-stack operation
($x op $y).

So eliminate this flag.

Note that this makes the ops which have the AMGf_set flag hard-coded
infinitesimally slower, since Perl_try_amagic_bin no longer skips the
checks for assign-ness. But compared with the overhead of having
already called the overload method, this is is trivial.

On the plus side, it makes the code smaller and easier to understand.

commit 9b2983ca78e5369d17559ca0aa5af58e9da3724a
Author: David Mitchell 
Date:   Mon Feb 4 14:52:01 2019 +

Perl_try_amagic_bin(): eliminate dATARGET

.. and replace with explicit tests and assigns to targ.

This macro includes an OPf_STACKED test which has already been done
above.  Also, by protecting the OPf_STACKED test within a AMGf_assign
test, we can eliminate the AMGf_set flag in the next commit, and use the
same set of code for both AMGf_set and AMGf_assign variant calls to
Perl_try_amagic_bin().

commit 7554d34485b417b08875137130152d0168feefa8
Author: David Mitchell 
Date:   Mon Feb 4 14:11:13 2019 +

Eliminate SvPADMY tests from overload code

A couple of places in the overload code do  SvPADMY(TARG) to decide
whether this is a normal op like ($x op $y), where the targ will have
SVs_PADTMP set, or a lexical assignment like $lex = ($x op $y) where the
assign has been optimised away and the op is expected to directly assign
to the targ which it thinks is a PADTMP but is really $lex.

Since the SVs_PADMY flag was eliminated a while ago, SvPADMY() is just
defined as !(SvFLAGS(sv) & SVs_PADTMP). Thus the overload code is
relying on the absence of a PADTMP flag in the target to deduce that the
OPpTARGET_MY optimisation is in effect. This seems to work (at least for
the code in the test suite), but can't be regarded as robust. This
commit removes each SvPADMY() test and replaces it with the twin

if (   (PL_opargs[PL_op->op_type] & OA_TARGLEX)
&& (PL_op->op_private & OPpTARGET_MY))

tests.

commit 72876cce4ecc7d8756e00d284e32df0b943d0da9
Author: David Mitchell 
Date:   Mon Feb 4 13:48:13 2019 +

E

[perl.git] branch blead updated. v5.29.5-110-g0d9e812de5

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 0d9e812de5885109532ec8bf484f165213ab97cb
Author: David Mitchell 
Date:   Fri Dec 14 16:54:42 2018 +

ext/GDBM_File/t/fatal.t: handle non-fatality

This script is supposed to exercise the error handling callback
mechanism in gdbm, by triggering an error by surreptitiously closing
the file handle which gdbm has opened.

However, this doesn't trigger an error in newer releases of the gdbm
library, which uses mmap() rather than write() etc. In fact I can't see
any way of triggering an error: so just skip the relevant tests if we
can't trigger a failure.

---

Summary of changes:
 ext/GDBM_File/t/fatal.t | 35 ++-
 1 file changed, 26 insertions(+), 9 deletions(-)

diff --git a/ext/GDBM_File/t/fatal.t b/ext/GDBM_File/t/fatal.t
index 3ba66be598..159916901a 100644
--- a/ext/GDBM_File/t/fatal.t
+++ b/ext/GDBM_File/t/fatal.t
@@ -1,4 +1,12 @@
 #!./perl -w
+#
+# Exercise the error handling callback mechanism in gdbm.
+#
+# Try to trigger an error by surreptitiously closing the file handle which
+# gdbm has opened.  Note that this won't trigger an error in newer
+# releases of the gdbm library, which uses mmap() rather than write() etc:
+# so skip in that case.
+
 use strict;
 
 use Test::More;
@@ -34,16 +42,25 @@ isnt((open $fh, "<&=$fileno"), undef, "dup fileno $fileno")
 or diag("\$! = $!");
 isnt(close $fh, undef,
  "close fileno $fileno, out from underneath the GDBM_File");
-is(eval {
+
+# store some data to a closed file handle
+
+my $res = eval {
 $h{Perl} = 'Rules';
 untie %h;
-1;
-}, undef, 'Trapped error when attempting to write to knobbled GDBM_File');
-
-# Observed "File write error" and "lseek error" from two different systems.
-# So there might be more variants. Important part was that we trapped the error
-# via croak.
-like($@, qr/ at .*\bfatal\.t line \d+\.\n\z/,
- 'expected error message from GDBM_File');
+99;
+};
+
+SKIP: {
+skip "Can't tigger failure", 2 if $res == 99;
+
+is $res, undef, "eval should return undef";
+
+# Observed "File write error" and "lseek error" from two different
+# systems.  So there might be more variants. Important part was that
+# we trapped the error # via croak.
+like($@, qr/ at .*\bfatal\.t line \d+\.\n\z/,
+ 'expected error message from GDBM_File');
+}
 
 unlink ;

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.5-38-g89c8f482fd

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 89c8f482fd6302a33e3a6ba5e76b545822ae66fc
Author: David Mitchell 
Date:   Tue Nov 27 16:36:35 2018 +

perlreref.pod: disambiguate "code"

It says:

   (?(cond)yes)  Conditional expression, where "cond" can be:
 (?=pat)   lookahead
 ...

A strict reading of that is that there must be two pairs of parens
in each conditional construct, e.g. (?((?=pat))yes).

Make the text clearer.

---

Summary of changes:
 pod/perlreref.pod | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/pod/perlreref.pod b/pod/perlreref.pod
index a2fb855306..b0c3f6b97a 100644
--- a/pod/perlreref.pod
+++ b/pod/perlreref.pod
@@ -256,7 +256,7 @@ There is no quantifier C<{,n}>. That's interpreted as a 
literal string.
(?&name)  Recurse into a named subpattern
(?P>name) Recurse into a named subpattern (python syntax)
(?(cond)yes|no)
-   (?(cond)yes)  Conditional expression, where "cond" can be:
+   (?(cond)yes)  Conditional expression, where "(cond)" can be:
  (?=pat)   lookahead
  (?!pat)   negative lookahead
  (?<=pat)  lookbehind

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.5-37-g278d8c58e8

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 278d8c58e85c646b61e60fe48207e090278bb61c
Author: David Mitchell 
Date:   Tue Nov 27 13:26:39 2018 +

handle /(?(?{code}))/ mixed compile-and runtime

Where a runtime pattern contains both compile-time and run-time code
blocks, e.g.:

$re = '(?{ RRR })';
/ $re X(?{ CCC })Y/

The compile-time code-block CCC is parsed at the same time as the
surrounding text. The runtime code RRR is parsed at runtime by
constructing a fake pattern and re-parsing it, but with any compile-time
code-blocks blanked out (so they don't get compiled twice). The compiled
regex is then thrown away, but any optrees just created for the runtime
code blocks are kept.

For example at runtime, the re-parsed pattern looks like:

/ (?{ RRR }) X__Y/

Unfortunately this was failing for the conditional pattern, e.g.

/ $re X(?(?{ CCC }))Y/

which was getting blanked as

/ (?{ RRR }) X(?___)Y/

which isn't valid syntax.

This commit blanks (?{...}) into (?=) instead which is always legal.

---

Summary of changes:
 regcomp.c  | 24 +++-
 t/re/pat_re_eval.t | 17 -
 2 files changed, 35 insertions(+), 6 deletions(-)

diff --git a/regcomp.c b/regcomp.c
index bf987f6e28..ff26f2242f 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -6756,13 +6756,27 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const 
pRExC_state,
&& n < pRExC_state->code_blocks->count
&& s == pRExC_state->code_blocks->cb[n].start)
{
-   /* blank out literal code block */
-   assert(pat[s] == '(');
-   while (s <= pRExC_state->code_blocks->cb[n].end) {
-   *p++ = '_';
+   /* blank out literal code block so that they aren't
+ * recompiled: eg change from/to:
+ * /(?{xyz})/
+ * /(?=)/
+ * and
+ * /(??{xyz})/
+ * /(?==)/
+ * and
+ * /(?(?{xyz}))/
+ * /(?(?=))/
+*/
+   assert(pat[s]   == '(');
+   assert(pat[s+1] == '?');
+*p++ = '(';
+*p++ = '?';
+s += 2;
+   while (s < pRExC_state->code_blocks->cb[n].end) {
+   *p++ = '=';
s++;
}
-   s--;
+*p++ = ')';
n++;
continue;
}
diff --git a/t/re/pat_re_eval.t b/t/re/pat_re_eval.t
index f88a8651a1..8325451377 100644
--- a/t/re/pat_re_eval.t
+++ b/t/re/pat_re_eval.t
@@ -23,7 +23,7 @@ BEGIN {
 
 our @global;
 
-plan tests => 502;  # Update this when adding/deleting tests.
+plan tests => 504;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1301,6 +1301,21 @@ sub run_tests {
 ok /^$qr$/,  "RT #132772 -  run time time qr//";
 }
 
+# RT #133687
+# mixing compile-time (?(?{code})) with run-time code blocks
+# was failing, because the second pass through the parser
+# (which compiles the runtime code blocks) was failing to adequately
+# mask the compile-time code blocks to shield them from a second
+# compile: /X(?{...})Y/ was being correctly masked as /XY/
+# but /X(?(?{...}))Y/ was being incorrectly masked as
+# /X(?)Y/
+
+{
+use re 'eval';
+my $runtime_re = '(??{ "A"; })';
+ok "ABC" =~ /^ $runtime_re (?(?{ 1; })BC)$/x, 'RT #133687 yes';
+ok "ABC" =~ /^ $runtime_re (?(?{ 0; })xy|BC) $/x, 'RT #133687 yes|no';
+}
 
 } # End of sub run_tests
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.5-9-gad9b9a4926

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit ad9b9a4926e4b0d348c048937df69e382f7e6d27
Author: Tomasz Konojacki 
Date:   Wed Nov 21 09:26:31 2018 +0100

optimize IV -> UV conversions

This commit replaces all instances of code that looks like this:

  uv = (iv == IV_MIN) ? (UV)iv : (UV)(-iv)

with simpler and more optimal:

  uv = -(UV)iv

While -iv indeed results in an undefined behaviour when iv == IV_MIN,
-(UV)iv is perfectly well defined and does the right thing.

C standard guarantees that the result of (UV)iv (for negative iv) is
equal to iv + UV_MAX + 1 (see 6.3.1.3, paragraph 2 in C11). It also
guarantees that the result of -uv is UV_MAX - uv + 1 (6.2.5,
paragraph 9).

That means that the result of -(UV)iv is UV_MAX - (iv + UV_MAX + 1) + 1
which is equal to -iv for *all* possible negative values of iv.

[perl #133677]

commit 9ba9a28aaea66bad2de041880a2c4210a911dda6
Author: David Mitchell 
Date:   Wed Nov 21 12:09:45 2018 +

S_hv_delete_common(): avoid undefined behaviour

ASAN -fsanitize-undefined was tripping on the second of these two lines:

svp = AvARRAY(isa);
end = svp + AvFILLp(isa)+1;

In the case where svp is NULL and AvFILLp(isa) is -1, the first addition
is undefined behaviour. Add the 1 first, so that it becomes
svp + (-1+1), which is safe.

---

Summary of changes:
 hv.c |  2 +-
 pp.c | 18 +-
 pp_hot.c |  4 ++--
 sv.c |  4 ++--
 4 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/hv.c b/hv.c
index d3d02d1046..fc90a5146b 100644
--- a/hv.c
+++ b/hv.c
@@ -1295,7 +1295,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char 
*key, STRLEN klen,
 SV **svp, **end;
 strip_magic:
 svp = AvARRAY(isa);
-end = svp + AvFILLp(isa)+1;
+end = svp + (AvFILLp(isa)+1);
 while (svp < end) {
 if (*svp)
 mg_free_type(*svp, PERL_MAGIC_isaelem);
diff --git a/pp.c b/pp.c
index 6d432acd31..880f266081 100644
--- a/pp.c
+++ b/pp.c
@@ -1319,7 +1319,7 @@ PP(pp_multiply)
auvok = TRUE; /* effectively it's a UV now */
} else {
 /* abs, auvok == false records sign */
-   alow = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
+   alow = -(UV)aiv;
}
}
if (buvok) {
@@ -1331,7 +1331,7 @@ PP(pp_multiply)
buvok = TRUE; /* effectively it's a UV now */
} else {
 /* abs, buvok == false records sign */
-   blow = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
+   blow = -(UV)biv;
}
}
 
@@ -1462,7 +1462,7 @@ PP(pp_divide)
 right_non_neg = TRUE; /* effectively it's a UV now */
 }
else {
-right = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
+right = -(UV)biv;
 }
 }
 /* historically undef()/0 gives a "Use of uninitialized value"
@@ -1483,7 +1483,7 @@ PP(pp_divide)
 left_non_neg = TRUE; /* effectively it's a UV now */
 }
else {
-left = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
+left = -(UV)aiv;
 }
 }
 
@@ -1566,7 +1566,7 @@ PP(pp_modulo)
 right = biv;
 right_neg = FALSE; /* effectively it's a UV now */
 } else {
-right = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
+right = -(UV)biv;
 }
 }
 }
@@ -1596,7 +1596,7 @@ PP(pp_modulo)
 left = aiv;
 left_neg = FALSE; /* effectively it's a UV now */
 } else {
-left = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
+left = -(UV)aiv;
 }
 }
 }
@@ -1893,8 +1893,8 @@ PP(pp_subtract)
if (aiv >= 0) {
auv = aiv;
auvok = 1;  /* Now acting as a sign flag.  */
-   } else { /* 2s complement assumption for IV_MIN */
-   auv = (aiv == IV_MIN) ? (UV)aiv : (UV)-aiv;
+   } else {
+   auv = -(UV)aiv;
}
}
   

[perl.git] branch blead updated. v5.29.4-99-g516795a038

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 516795a0389685dee830e0ca027811f000a5ed08
Author: David Mitchell 
Date:   Tue Nov 20 10:59:22 2018 +

t/perf/benchmarks.t: improve do error checks

Make the checks for "do 't/perf/benchmarks'" look more like those
suggested for 'do' in perlfunc.

In particular, this may help track down the issue in RT #133663.

---

Summary of changes:
 t/perf/benchmarks.t | 9 +++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/t/perf/benchmarks.t b/t/perf/benchmarks.t
index 57dbcf8793..9babda3b01 100644
--- a/t/perf/benchmarks.t
+++ b/t/perf/benchmarks.t
@@ -15,8 +15,13 @@ use strict;
 
 my $file = 'perf/benchmarks';
 my $benchmark_array = do $file;
-die $@ if $@;
-die "$! while trying to read '$file'" if $!;
+unless ($benchmark_array) {
+die "Error while parsing '$file': $@\n" if $@;
+die "Error while trying to read '$file': $!"
+unless defined $benchmark_array;
+die "Unknown error running '$file'\n";
+}
+
 die "'$file' did not return an array ref\n"
 unless ref $benchmark_array eq 'ARRAY';
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.4-91-g2d0e7d1fca

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 2d0e7d1fcad776bfaaeaa7049e51eaf521767967
Author: David Mitchell 
Date:   Mon Nov 19 16:28:03 2018 +

perlguts: clarify SV types which are scalars

The '< SVt_PVAV' entry looked to one reader like malformed HTML
rather than indicating a numerical range.

http://nntp.perl.org/group/perl.perl5.porters/252585

---

Summary of changes:
 pod/perlguts.pod | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index 16bd0ecba7..5f33bbb80a 100644
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -681,12 +681,14 @@ macro and then check the return value.
 
 The most useful types that will be returned are:
 
-< SVt_PVAV  Scalar
 SVt_PVAVArray
 SVt_PVHVHash
 SVt_PVCVCode
 SVt_PVGVGlob (possibly a file handle)
 
+Any numerical value returned which is less than SVt_PVAV will be a scalar
+of some form.
+
 See L for more details.
 
 =head2 Blessed References and Class Objects

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.4-90-gf09dd912ca

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit f09dd912ca46cc4e5553da867bc148656110510c
Author: David Mitchell 
Date:   Mon Nov 19 14:12:05 2018 +

ext/File-Find: support parallel testing

t/harness was recently modified to run tests under ext/ etc in parallel.
ext/File-Find/t/ has two test scripts which both use the same temporary
directory names.
Make taint.t use different names, so that it can run in parallel with
the other script.

---

Summary of changes:
 ext/File-Find/t/taint.t | 124 
 t/harness   |   2 +-
 2 files changed, 63 insertions(+), 63 deletions(-)

diff --git a/ext/File-Find/t/taint.t b/ext/File-Find/t/taint.t
index d126e69c59..5c3833a8bf 100644
--- a/ext/File-Find/t/taint.t
+++ b/ext/File-Find/t/taint.t
@@ -85,30 +85,30 @@ my $FastFileTests_OK = 0;
 sub cleanup {
 chdir($orig_dir_untainted);
 my $need_updir = 0;
-if (-d dir_path('for_find')) {
-$need_updir = 1 if chdir(dir_path('for_find'));
+if (-d dir_path('for_find_taint')) {
+$need_updir = 1 if chdir(dir_path('for_find_taint'));
 }
-if (-d dir_path('fa')) {
-   unlink file_path('fa', 'fa_ord'),
-  file_path('fa', 'fsl'),
-  file_path('fa', 'faa', 'faa_ord'),
-  file_path('fa', 'fab', 'fab_ord'),
-  file_path('fa', 'fab', 'faba', 'faba_ord'),
-  file_path('fb', 'fb_ord'),
-  file_path('fb', 'fba', 'fba_ord');
-   rmdir dir_path('fa', 'faa');
-   rmdir dir_path('fa', 'fab', 'faba');
-   rmdir dir_path('fa', 'fab');
-   rmdir dir_path('fa');
-   rmdir dir_path('fb', 'fba');
-   rmdir dir_path('fb');
+if (-d dir_path('fa_taint')) {
+   unlink file_path('fa_taint', 'fa_ord'),
+  file_path('fa_taint', 'fsl'),
+  file_path('fa_taint', 'faa', 'faa_ord'),
+  file_path('fa_taint', 'fab', 'fab_ord'),
+  file_path('fa_taint', 'fab', 'faba', 'faba_ord'),
+  file_path('fb_taint', 'fb_ord'),
+  file_path('fb_taint', 'fba', 'fba_ord');
+   rmdir dir_path('fa_taint', 'faa');
+   rmdir dir_path('fa_taint', 'fab', 'faba');
+   rmdir dir_path('fa_taint', 'fab');
+   rmdir dir_path('fa_taint');
+   rmdir dir_path('fb_taint', 'fba');
+   rmdir dir_path('fb_taint');
 }
 if ($need_updir) {
 my $updir = $^O eq 'VMS' ? File::Spec::VMS->updir() : 
File::Spec->updir;
 chdir($updir);
 }
-if (-d dir_path('for_find')) {
-   rmdir dir_path('for_find') or print "# Can't rmdir for_find: $!\n";
+if (-d dir_path('for_find_taint')) {
+   rmdir dir_path('for_find_taint') or print "# Can't rmdir for_find: 
$!\n";
 }
 }
 
@@ -157,29 +157,29 @@ sub simple_wanted {
 *file_path_name = \&file_path;
 
 
-mkdir_ok( dir_path('for_find'), 0770 );
-ok( chdir( dir_path('for_find')), 'successful chdir() to for_find' );
+mkdir_ok( dir_path('for_find_taint'), 0770 );
+ok( chdir( dir_path('for_find_taint')), 'successful chdir() to for_find_taint' 
);
 
 $cwd = cwd(); # save cwd
 ( $cwd_untainted ) = $cwd =~ m|^(.+)$|; # untaint it
 
-mkdir_ok( dir_path('fa'), 0770 );
-mkdir_ok( dir_path('fb'), 0770  );
-create_file_ok( file_path('fb', 'fb_ord') );
-mkdir_ok( dir_path('fb', 'fba'), 0770  );
-create_file_ok( file_path('fb', 'fba', 'fba_ord') );
+mkdir_ok( dir_path('fa_taint'), 0770 );
+mkdir_ok( dir_path('fb_taint'), 0770  );
+create_file_ok( file_path('fb_taint', 'fb_ord') );
+mkdir_ok( dir_path('fb_taint', 'fba'), 0770  );
+create_file_ok( file_path('fb_taint', 'fba', 'fba_ord') );
 SKIP: {
skip "Creating symlink", 1, unless $symlink_exists;
-   ok( symlink('../fb','fa/fsl'), 'Created symbolic link' );
+   ok( symlink('../fb_taint','fa_taint/fsl'), 'Created symbolic link' );
 }
-create_file_ok( file_path('fa', 'fa_ord') );
+create_file_ok( file_path('fa_taint', 'fa_ord') );
 
-mkdir_ok( dir_path('fa', 'faa'), 0770  );
-create_file_ok( file_path('fa', 'faa', 'faa_ord') );
-mkdir_ok( dir_path('fa', 'fab'), 0770  );
-create_file_ok( file_path('fa', 'fab', 'fab_ord') );
-mkdir_ok( dir_path('fa', 'fab', 'faba'), 0770  );
-create_file_ok( file_path('fa', 'fab', 'faba', 'faba_ord') );
+mkdir_ok( dir_path('fa_taint', 'faa'), 0770  );
+create_file_ok( file_path('fa_taint', 'faa', 'faa_ord') );
+mkdir_ok( dir_path('fa_taint', 'fab'), 0770  );
+create_file_ok( file_path('fa_taint', 'fab', 'fab_ord') );
+mkdir_ok( dir_path('fa_taint', 'fab', 'faba'), 0770  );
+create_file_ok( file_path('fa_taint', 'fab', 'faba', 'faba_ord') );
 
 print "# check untainting (no follow)\n";
 
@@ -192,14 +192,14 @@ print "# check untainting (no follo

[perl.git] branch blead updated. v5.29.4-89-gd33f9fbdb3

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit d33f9fbdb3bb27a3b32a2ffa9aa035617c07f7a1
Author: David Mitchell 
Date:   Mon Nov 19 13:52:46 2018 +

ext/GDBM_File/t/fatal.t: support parallel testing

t/harness was recently modified to run tests under ext/ etc in parallel.
ext/GDBM_File/t/ has two test scripts which both use the same filename.
Make fatal.t use a different name, so that it can run in parallel with
the other script.

---

Summary of changes:
 ext/GDBM_File/t/fatal.t | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/ext/GDBM_File/t/fatal.t b/ext/GDBM_File/t/fatal.t
index 0e426d4dbc..3ba66be598 100644
--- a/ext/GDBM_File/t/fatal.t
+++ b/ext/GDBM_File/t/fatal.t
@@ -16,7 +16,7 @@ BEGIN {
 use_ok('GDBM_File');
 }
 
-unlink ;
+unlink ;
 
 open my $fh, '<', $^X or die "Can't open $^X: $!";
 my $fileno = fileno $fh;
@@ -28,7 +28,7 @@ is((open $fh, "<&=$fileno"), undef,
 
 umask(0);
 my %h;
-isa_ok(tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640), 'GDBM_File');
+isa_ok(tie(%h, 'GDBM_File', 'fatal_dbmx', GDBM_WRCREAT, 0640), 'GDBM_File');
 
 isnt((open $fh, "<&=$fileno"), undef, "dup fileno $fileno")
 or diag("\$! = $!");
@@ -46,4 +46,4 @@ is(eval {
 like($@, qr/ at .*\bfatal\.t line \d+\.\n\z/,
  'expected error message from GDBM_File');
 
-unlink ;
+unlink ;

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.4-88-g6a4c4cd41c

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 6a4c4cd41c54334613baa6cada2145fd51e180e6
Author: David Mitchell 
Date:   Mon Nov 19 12:38:27 2018 +

autodoc.pl: escape POD

RT #133638

This script generates perlapi.pod, and contains snippets of POD
which it inserts into that file. The metacpan web site was interpreting
this as pod for autodoc.pl and displaying it.

Escape the pod by prefixing each line with '|'.

---

Summary of changes:
 autodoc.pl | 213 +++--
 1 file changed, 107 insertions(+), 106 deletions(-)

diff --git a/autodoc.pl b/autodoc.pl
index cf82639db3..788dc359fd 100644
--- a/autodoc.pl
+++ b/autodoc.pl
@@ -273,6 +273,11 @@ sub sort_helper {
 
 sub output {
 my ($podname, $header, $dochash, $missing, $footer) = @_;
+#
+# strip leading '|' from each line which had been used to hide
+# pod from pod checkers.
+s/^\|//gm for $header, $footer;
+
 my $fh = open_new("pod/$podname.pod", undef,
  {by => "$0 extracting documentation",
from => 'the C source files'}, 1);
@@ -315,17 +320,13 @@ around to documenting it.  In the latter case, you will 
be asked to submit a
 patch to document the function.  Once your patch is accepted, it will indicate
 that the interface is stable (unless it is explicitly marked otherwise) and
 usable by you.
-
-=over
-
 _EOB_
 The following functions are currently undocumented.  If you use one of
 them, you may wish to consider creating and submitting documentation for
 it.
-
-=over
-
 _EOB_
+print $fh "\n=over\n\n";
+
 for my $missing (sort @$missing) {
 print $fh "=item $missing\nX<$missing>\n\n";
 }
@@ -383,83 +384,83 @@ foreach (sort keys %missing) {
 # deprecated.
 my @missing_api = grep $funcflags{$_}{flags} =~ /A/ && $funcflags{$_}{flags} 
!~ /[MD]/ && !$docs{api}{$_}, keys %funcflags;
 output('perlapi', <<'_EOB_', $docs{api}, \@missing_api, <<'_EOE_');
-=encoding UTF-8
-
-=head1 NAME
-
-perlapi - autogenerated documentation for the perl public API
-
-=head1 DESCRIPTION
-X X X
-
-This file contains the documentation of the perl public API generated by
-F, specifically a listing of functions, macros, flags, and variables
-that may be used by extension writers.  L
-is a list of functions which have yet to be documented.  The interfaces of
-those are subject to change without notice.  Anything not listed here is
-not part of the public API, and should not be used by extension writers at
-all.  For these reasons, blindly using functions listed in proto.h is to be
-avoided when writing extensions.
-
-In Perl, unlike C, a string of characters may generally contain embedded
-C characters.  Sometimes in the documentation a Perl string is referred
-to as a "buffer" to distinguish it from a C string, but sometimes they are
-both just referred to as strings.
-
-Note that all Perl API global variables must be referenced with the C
-prefix.  Again, those not listed here are not to be used by extension writers,
-and can be changed or removed without notice; same with macros.
-Some macros are provided for compatibility with the older,
-unadorned names, but this support may be disabled in a future release.
-
-Perl was originally written to handle US-ASCII only (that is characters
-whose ordinal numbers are in the range 0 - 127).
-And documentation and comments may still use the term ASCII, when
-sometimes in fact the entire range from 0 - 255 is meant.
-
-The non-ASCII characters below 256 can have various meanings, depending on
-various things.  (See, most notably, L.)  But usually the whole
-range can be referred to as ISO-8859-1.  Often, the term "Latin-1" (or
-"Latin1") is used as an equivalent for ISO-8859-1.  But some people treat
-"Latin1" as referring just to the characters in the range 128 through 255, or
-somethimes from 160 through 255.
-This documentation uses "Latin1" and "Latin-1" to refer to all 256 characters.
-
-Note that Perl can be compiled and run under either ASCII or EBCDIC (See
-L).  Most of the documentation (and even comments in the code)
-ignore the EBCDIC possibility.  
-For almost all purposes the differences are transparent.
-As an example, under EBCDIC,
-instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so
-whenever this documentation refers to C
-(and variants of that name, including in function names),
-it also (essentially transparently) means C.
-But the ordinals of characters differ between ASCII, EBCDIC, and
-the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy a different
-number of bytes than in UTF-8.
-
-The listing below is alphabetical, case insensitive

[perl.git] branch blead updated. v5.29.4-86-gea89b3331b

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit ea89b3331b133e1d454a75dcf79315d311770d83
Author: David Mitchell 
Date:   Mon Nov 19 08:34:40 2018 +

perldelta for davem's commits

---

Summary of changes:
 pod/perldelta.pod | 14 ++
 1 file changed, 14 insertions(+)

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 355eaa585b..7332175ff3 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -398,6 +398,20 @@ C or C now properly 
removes the
 C<:utf8> flag from the default C<:crlf> I/O layer on Win32.  [perl
 #133604]
 
+=item *
+
+The experimental reference aliasing feature was misinterpreting array and
+hash slice assignment as being localised, e.g.
+
+\(@a[3,5,7]) = \();
+
+was being interpreted as:
+
+local \(@a[3,5,7]) = \();
+
+[perl #133538]
+
+
 =back
 
 =head1 Known Problems

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.4-35-gb97fe865ad

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit b97fe865adca6799771c93fc17e9f36ae7272e72
Author: David Mitchell 
Date:   Mon Nov 5 12:29:27 2018 +

Don't localise array / hash slice ref assignment

RT #133538

The experimental ref assignment aliasing feature, when applied to
array or hash slices, was treating the slice as if it was always localized;
e.g.

\(@a[3,5,7]) = \();

was being interpreted as

local \(@a[3,5,7]) = \();

The fix is simple: check for the OPpLVAL_INTRO flag actually being set
on the op, rather than unconditionally localising the array/hash
elements.

---

Summary of changes:
 pp.c | 10 ++
 t/op/lvref.t | 38 +-
 2 files changed, 43 insertions(+), 5 deletions(-)

diff --git a/pp.c b/pp.c
index cfa343fbbb..6d432acd31 100644
--- a/pp.c
+++ b/pp.c
@@ -6599,10 +6599,12 @@ PP(pp_lvrefslice)
 
 while (++MARK <= SP) {
SV * const elemsv = *MARK;
-   if (SvTYPE(av) == SVt_PVAV)
-   S_localise_aelem_lval(aTHX_ av, elemsv, can_preserve);
-   else
-   S_localise_helem_lval(aTHX_ (HV *)av, elemsv, can_preserve);
+if (UNLIKELY(localizing)) {
+if (SvTYPE(av) == SVt_PVAV)
+S_localise_aelem_lval(aTHX_ av, elemsv, can_preserve);
+else
+S_localise_helem_lval(aTHX_ (HV *)av, elemsv, can_preserve);
+}
*MARK = sv_2mortal(newSV_type(SVt_PVMG));
sv_magic(*MARK,(SV *)av,PERL_MAGIC_lvref,(char *)elemsv,HEf_SVKEY);
 }
diff --git a/t/op/lvref.t b/t/op/lvref.t
index 28adc6ad23..3d5e952fb0 100644
--- a/t/op/lvref.t
+++ b/t/op/lvref.t
@@ -4,7 +4,7 @@ BEGIN {
 set_up_inc("../lib");
 }
 
-plan 156;
+plan 164;
 
 eval '\$x = \$y';
 like $@, qr/^Experimental aliasing via reference not enabled/,
@@ -603,3 +603,39 @@ pass("RT #123821");
 eval q{sub{\@0[0]=0};};
 pass("RT #128252");
 }
+
+# RT #133538 slices were inadvertently always localising
+
+{
+use feature 'refaliasing';
+no warnings 'experimental';
+
+my @src = (100,200,300);
+
+my @a = (1,2,3);
+my %h = qw(one 10 two 20 three 30);
+
+{
+use feature 'declared_refs';
+local \(@a[0,1,2]) = \(@src);
+local \(@h{qw(one two three)}) = \(@src);
+$src[0]++;
+is("@a", "101 200 300", "rt #133538 \@a aliased");
+is("$h{one} $h{two} $h{three}", "101 200 300", "rt #133538 %h 
aliased");
+}
+is("@a", "1 2 3", "rt #133538 \@a restored");
+is("$h{one} $h{two} $h{three}", "10 20 30", "rt #133538 %h restored");
+
+{
+\(@a[0,1,2]) = \(@src);
+\(@h{qw(one two three)}) = \(@src);
+$src[0]++;
+is("@a", "102 200 300", "rt #133538 \@a aliased try 2");
+is("$h{one} $h{two} $h{three}", "102 200 300",
+"rt #133538 %h aliased try 2");
+}
+$src[2]++;
+is("@a", "102 200 301", "rt #133538 \@a still aliased");
+is("$h{one} $h{two} $h{three}", "102 200 301", "rt #133538 %h still 
aliased");
+
+}

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.3-65-gd6139ec4a9

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit d6139ec4a9065ae249ab512398326a70dfb2fea2
Author: David Mitchell 
Date:   Wed Oct 17 15:10:10 2018 +0100

fix 'for reverse @array' bug on AIX

RT #133558

Due to what appears to be a compiler bug on AIX (or perhaps it's
undefined behaviour which happens to work on other platforms), this line
of code in pp_iter():

inc = 1 - (PL_op->op_private & OPpITER_REVERSED);

was setting inc to 4294967295 rather than to the expected -1 (inc was a
64-bit signed long).

Fix it with a couple of judicious (IV) casts (which ought to be a NOOP).

---

Summary of changes:
 pp_hot.c   |  4 ++--
 t/op/for.t | 16 +++-
 2 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/pp_hot.c b/pp_hot.c
index 56e3cbe6e1..dc02612042 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -3932,7 +3932,7 @@ PP(pp_iter)
 case CXt_LOOP_LIST: /* for (1,2,3) */
 
 assert(OPpITER_REVERSED == 2); /* so inc becomes -1 or 1 */
-inc = 1 - (PL_op->op_private & OPpITER_REVERSED);
+inc = (IV)1 - (IV)(PL_op->op_private & OPpITER_REVERSED);
 ix = (cx->blk_loop.state_u.stack.ix += inc);
 if (UNLIKELY(inc > 0
 ? ix > cx->blk_oldsp
@@ -3947,7 +3947,7 @@ PP(pp_iter)
 case CXt_LOOP_ARY: /* for (@ary) */
 
 av = cx->blk_loop.state_u.ary.ary;
-inc = 1 - (PL_op->op_private & OPpITER_REVERSED);
+inc = (IV)1 - (IV)(PL_op->op_private & OPpITER_REVERSED);
 ix = (cx->blk_loop.state_u.ary.ix += inc);
 if (UNLIKELY(inc > 0
 ? ix > AvFILL(av)
diff --git a/t/op/for.t b/t/op/for.t
index a114180f0b..f34fbd8b56 100644
--- a/t/op/for.t
+++ b/t/op/for.t
@@ -5,7 +5,7 @@ BEGIN {
 require "./test.pl";
 }
 
-plan(124);
+plan(126);
 
 # A lot of tests to check that reversed for works.
 
@@ -664,3 +664,17 @@ is(fscope(), 1, 'return via loop in sub');
 }
 is($foo, "outside", "RT #123994 array outside");
 }
+
+# RT #133558 'reverse' under AIX was causing loop to terminate
+# immediately, probably due to compiler bug
+
+{
+my @a = qw(foo);
+my @b;
+push @b, $_ for (reverse @a);
+is "@b", "foo", " RT #133558 reverse array";
+
+@b = ();
+push @b, $_ for (reverse 'bar');
+is "@b", "bar", " RT #133558 reverse list";
+}

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.2-35-g0fe04e1dc7

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 0fe04e1dc741a43190e79a985fb0cec0493ebfe9
Author: David Mitchell 
Date:   Wed Aug 29 14:32:24 2018 +0100

multiconcat: mutator not seen in (lex = ...) .= ...

RT #133441

TL;DR:
(($lex = expr1.expr2) .= expr3) was being misinterpreted as
(expr1 . expr2 . expr3) when the ($lex = expr1) subtree had had the
assign op optimised away by the OPpTARGET_MY optimisation.

Full details.

S_maybe_multiconcat() looks for suitable chains of OP_CONCAT to convert
into a single OP_MULTICONCAT.

Part of the code needs to distinguish between (expr . expr) and
(expr .= expr). This didn't used to be easy, as both are just OP_CONCAT
ops, but with the OPf_STACKED set on the second one. But...

perl also used to optimise ($a . $b . $c) into ($a . $b) .= $c, to
reuse the padtmp returned by the $a.$b concat. This meant that an
OP_CONCAT could have the OPf_STACKED flag on even when it was a '.'
rather than a '.='.

I disambiguated these cases by seeing whether the top op in the LHS
expression had the OPf_MOD flag set too - if so, it implies '.='.

This fails in the specific case where the LHS expression is a
sub-expression which is assigned to a lexical variable, e.g.

($lex = $a+$b) .= $c.

Initially the top node in the LHS expression above is OP_SASSIGN, with
OPf_MOD set due to the enclosing '.='. Then the OPpTARGET_MY
optimisation kicks in, and the ($lex = $a + $b) part of the optree is
converted from

sassign sKPRMS
add[t4] sK
padsv[a$] s
padsv[$b] s
padsv[$lex] s

to
add[$lex] sK/TARGMY
padsv[a$] s
padsv[$b] s

which is all fine and dandy, except that the top node of that optree no
longer has the OPf_MOD flag set, which trips up S_maybe_multiconcat into
no longer spotting that the outer concat is a '.=' rather than a '.'.

Whether the OPpTARGET_MY optimising code should copy the OPf_MOD from
the being-removed sassign op to its successor is an issue I won't
address here. But in the meantime, the good news is that for 5.28.0
I added the OPpCONCAT_NESTED private flag, which is set whenever
($a . $b . $c) is optimised into ($a . $b) .= $c. This means that it's
no longer necessary to inspect the OPf_MOD flag of the first child to
disambiguate the two cases. So the fix is trivial.

---

Summary of changes:
 op.c   |  1 -
 t/opbasic/concat.t | 10 +-
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/op.c b/op.c
index ddeb484b64..d0dcffbecb 100644
--- a/op.c
+++ b/op.c
@@ -2722,7 +2722,6 @@ S_maybe_multiconcat(pTHX_ OP *o)
 }
 else if (   topop->op_type == OP_CONCAT
  && (topop->op_flags & OPf_STACKED)
- && (cUNOPo->op_first->op_flags & OPf_MOD)
  && (!(topop->op_private & OPpCONCAT_NESTED))
 )
 {
diff --git a/t/opbasic/concat.t b/t/opbasic/concat.t
index 9ce9722f5c..4b73b22c1c 100644
--- a/t/opbasic/concat.t
+++ b/t/opbasic/concat.t
@@ -39,7 +39,7 @@ sub is {
 return $ok;
 }
 
-print "1..253\n";
+print "1..254\n";
 
 ($a, $b, $c) = qw(foo bar);
 
@@ -853,3 +853,11 @@ package RT132595 {
 my $res = $a.$t.$a.$t;
 ::is($res, "b1c1b1c2", "RT #132595");
 }
+
+# RT #133441
+# multiconcat wasn't seeing a mutator as a mutator
+{
+my ($a, $b)  = qw(a b);
+($a = 'A'.$b) .= 'c';
+is($a, "Abc", "RT #133441");
+}

-- 
Perl5 Master Repository

[perl.git] branch smoke-me/davem/captures created. v5.29.2-35-gd0f9ad5d5b

[Dave Mitchell]

In perl.git, the branch smoke-me/davem/captures has been created



at  d0f9ad5d5ba5300a04bba7be2ea8cded41e95666 (commit)

- Log -
commit d0f9ad5d5ba5300a04bba7be2ea8cded41e95666
Author: David Mitchell 
Date:   Tue Aug 28 09:15:04 2018 +0100

regex: restore failed branch capture within repeat

RT #133352

There are two competing behaviours for what to do with any captures
within a failed alternation branch.

Normally the regex engine invalidates any captures created during
execution of the failed branch. For example in something like

/(A)  (?: (B)(C) | (D)(E) ) /x

perl remembers the current highest capture index at the start of each
branch attempt (1 in this example), and if the branch fails it
invalidates all captures above this level (i.e. 2..3 or 2..5 depending
on which branch failed) before trying the next branch (if any).

However for repeats, such as (...)*, on each new iteration any captures
inside the repeat initially maintain their value from the previous
iteration, until updated within the current iteration. For example in

"ABCD" =~ /(?: (.)(.) )*/x

At the start of the first iteration, \1 and \2 are invalid.
At the start of the second iteration, \1 and \2 are 'A', 'B'.
During the course of the second iteration, \1 changes to 'C', then
\2 changes to 'D'.

This causes a problem when there's an alternation within a repeat.
Taking the first example above and adding a repeat:

/(A)  (?: (B)(C) | (D)(E) )* /x

Now on the second iteration, on entry to the branch the current highest
capture index is no longer 1 (i.e. A), but is instead 3 or 5 depending
on what was captured on the previous iteration. Thus on branch failure,
the 'disable everything above the previous floor' technique no longer
works: rather than disabling (1+1)..5 say, it disables (5+1)..5 - i.e.
failed captures are left as-is. This is the essence of the bug in this
ticket.

It is not clear what the correct behaviour should be - arguably failed
branch captures could be either invalidated or restored to their value
at the start of the branch. Invalidating is probably cheaper. However,
there are a couple of tests in t/te/re_tests added many years ago by
Ilya which assume the latter behaviour (they pass because the pattern of
branches and backtracking happen to leave $1 with the correct value;
a slight alteration to the tests and they would have the wrong value).
But in any case the tests aren't expecting $1 to be undefined.

This commit fixes the bug by, at the start of any branch, saving any
captures beyond the start of the innermost enclosing repeat, but only if
it *is* within a repeat, and if there are any valid captures beyond the
start of that repeat. These are restored on branch failure. Otherwise
it just invalidates back to the highest capture index at the start of
the branch, as before.

So for example this is unchanged, just invalidating indices 2+ on each
branch failure:

/(A)  (?: (B)(C) | (D)(E) ) /x

While this:

"ABCD" =~ /(?: ([AC]) ([BD]) )*/x

does invalidation on the first iteration, and full saving/restore of
capture indices 2+ on subsequent iterations, while this:

"-AB-CD" =~ /(?: (-) ([AC]) ([BD]) )*/x

saves and restores on *every* iteration, since the (-) is above the
floor of the curlyx, so at the start of each branch, lastparen is always
above cur_curlyx->lastparen.

In terms of performance, the benchmarks included with this commit show
that a plain branch is unaffected; a plain branch with captures is a few
% slower, and a branch within a repeat is now about half the speed.

This fix could be made a lot more efficient if the current paren index
was stored in every BRANCH/BRANCHJ/TRIE/TRIEC node, and if a pointer to
the current WHILEM node was maintained. Since every iteration of a
CURLYX/WHILEM saves all paren indices above the curlyx floor anyway, it
wouldn't be necessary to save them again for each branch; just on branch
failure, restore all saved indices from that last WHILEM which are above
the branch floor,

---

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.2-31-g1cfb6d7bef

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 1cfb6d7befa06ab0aba4adfd61117af3bf8693cb
Merge: 42f10b3ffc 0b9dad94ed
Author: David Mitchell 
Date:   Sun Aug 26 21:10:16 2018 +0100

[MERGE] various regex capture fixups

Improve the code and macros in S_regmatch() to make opening and closing
captures (groups) more consistent and simpler.

Shouldn't make any changes to behaviour apart from improved debugging
output.

commit 0b9dad94ed37e484db3e29d315fc26305c88f250
Author: David Mitchell 
Date:   Sun Aug 19 13:55:30 2018 +0100

Improve docs for lastparen, lastcloseparen

There's lots of confusion here, especially about lastparen - some of
the docs are just plain wrong.

commit befca383a461d1ce6deea75d7e0c73084408db3d
Author: David Mitchell 
Date:   Sat Aug 18 13:21:31 2018 +0100

S_regmatch: add debugging to UNWIND_PAREN()

(and tweak the debugging output of CLOSE_CAPTURE())

commit 3be2a9fdd7457a889837547a6bc98b1068add744
Author: David Mitchell 
Date:   Sat Aug 18 12:49:12 2018 +0100

S_rematch(): CLOSE_CAPTURE(): set last(close)paren

Every use of the CLOSE_CAPTURE() macro is followed by the setting of
lastparen and lastcloseparen, so include these actions in the macro
itself.

commit db0098d3b52693a85d8f8c125d2a4e12fa9b9754
Author: David Mitchell 
Date:   Sat Aug 18 12:40:08 2018 +0100

S_regmatch(): use CLOSE_CAPTURE() macro more

This macro includes debugging output, so by using it rather than
setting rex->offs[paren].start/end directly, you get better debugging.

commit 8e9ed7cc75d056033f4eae0c0e4c05913a9f2726
Author: David Mitchell 
Date:   Sat Aug 18 12:28:31 2018 +0100

S_regmatch(): parameterise CLOSE_CAPTURE macro

Make its index and start+end values into parameters. This will shortly
allow its use in other places, bringing consistent code and debug logging
to the whole of S_regmatch().

commit 69cd26179c68c48214a282ff90d0d3f2bdb8643c
Author: David Mitchell 
Date:   Sat Aug 18 12:19:16 2018 +0100

S_regmatch(): move CLOSE_CAPTURE macro definition

Move this macro to earlier in the file to be with the other functions
and macros which deal with setting and restoring captures.

No changes (functional or textual) apart from the physical moving of the
13 lines.

commit 6b72642a6fc3bf2929aeab13ce50cde069cd1661
Author: David Mitchell 
Date:   Thu Aug 16 20:07:43 2018 +0100

S_regmatch(): handle GOSUB within (.)* specially

The (?n) mechanism allows you to 'gosub' to a subpattern delineated by
capture n. For 1-char-width repeats, such as a+, \w*?, (\d)*, then
currently the code checks whether it's in a gosub each time it attempts
to start executing the B part of A*B, regardless of whether the A is
in a capture.

This commit moves the GOSUB check to within the capture-only variant
(CURLYN), which then directly just looks for one instance of A and
returns. This moves the check away from more frequently called code
paths.

commit 8a78f117cf44eec3094ecd24df412c86870040ea
Author: David Mitchell 
Date:   Thu Aug 16 19:24:23 2018 +0100

add more /(?1)/ tests

specifically, the code path wasn't being exercised where the gosub
goes to a capture which is a 1-char wide *non-greedy* repeat, such as

/ ... (\d)*? ... (?1) ... /

commit 21cbe0098921b51ccea087caa9ad5c71b2cda029
Author: David Mitchell 
Date:   Wed Aug 15 18:02:53 2018 +0100

S_regmatch(): combine CURLY_B_min/_known states

There are currently two similar backtracking states for simple
non-greedy pattern repeats:

CURLY_B_min
CURLY_B_min_known

the latter is a variant of the former for when the character which must
follow the repeat is known, e.g.  /(...)*?X.../, which allows quick
skipping to the next viable position.

The code for the two cases:

case CURLY_B_min_fail:
case CURLY_B_min_known_fail:

share a lot of similarities. This commit merges the two states into a
single CURLY_B_min state, with an associated single CURLY_B_min_fail
fail state.

That one code block can handle both types, with a single

if (ST.c1 == CHRTEST_VOID) ...

test to choose between the two variant parts of the code.

This makes the code smaller and more maintainable, at the cost of one
extra test per backtrack.

---

Summary of changes:
 pod/perlreapi.pod |   7 ++-
 pod/perlvar.pod   |  15 -
 regcomp.sym   |   2 +-
 regexec.c | 162 ++
 regexp.h  |   4 +-
 regnodes.h|  64 ++

[perl.git] branch smoke-me/davem/time_hires_nsec deleted. v5.27.11-18-g3e15af2f6d

[Dave Mitchell]

In perl.git, the branch smoke-me/davem/time_hires_nsec has been deleted



   was  3e15af2f6d937772d14e95e9b7443423f157d5cd

- Log -
3e15af2f6d937772d14e95e9b7443423f157d5cd time::HiRes: don't truncate nanosec 
utime
---

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.1-73-gecbf46993f

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit ecbf46993f6ffbdc255f6ded3c6c05a8266a71e8
Author: David Mitchell 
Date:   Tue Aug 7 12:26:31 2018 +0100

Time-HiRes/t/itimer.t: avoid race condition.

This test script sets a repeating interval timer going, and after 4
'ticks' (SIGVTALRM), disables the timer (by setting it to zero).

The main loop which does CPU burning, does a getitmer() every now and
again, and when the value is zero, assumes the signal handler has
disabled the timer,  and so finishes.

The trouble was that it was checking the 'time left', which can reach
zero because the interval timer has counted down to zero, and the signal
handler is about to be called, but the interval hasn't been reset back
to 0.4s yet.

i.e. the code doesn't distinguish between "timer disabled" and "timer
just reached zero".

In that scenario, the cleanup code in the test script disables the
SIGVTALRM handler while the timer is still active, and so the process
gets killed if another signal is raised.

This commit changes the test to check the second value returned by
getitmer() for being zero rather than the first - the second being the
repeat interval, whichb is always 0.4 until the timer is disabled.

---

Summary of changes:
 dist/Time-HiRes/t/itimer.t | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/dist/Time-HiRes/t/itimer.t b/dist/Time-HiRes/t/itimer.t
index e196b1648c..432b224488 100644
--- a/dist/Time-HiRes/t/itimer.t
+++ b/dist/Time-HiRes/t/itimer.t
@@ -51,7 +51,9 @@ ok(defined $virt && abs($virt / 0.5) - 1 < $limit,
 printf("# getitimer: %s\n", join(" ",
Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL)));
 
-while (Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL)) {
+# burn CPU until the VTALRM signal handler sets the repeat interval to
+# zero, indicating that the timer has fired 4 times.
+while ((Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL))[1]) {
 my $j;
 for (1..1000) { $j++ } # Can't be unbreakable, must test getitimer().
 }

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.1-29-g3d50648cc4

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 3d50648cc4f452d51a0564164a214e51dd6aad95
Author: David Mitchell 
Date:   Mon Jul 23 09:15:38 2018 +0100

Don't compile S_env_alloc() when not used

RT #133360

I recently added S_env_alloc() as a helper function for
Perl_my_setenv(); but it's not needed on all platforms, so #ifdef it to
only be compiled on platforms where its needed.

Avoids a compiler warning.

---

Summary of changes:
 util.c | 20 
 1 file changed, 12 insertions(+), 8 deletions(-)

diff --git a/util.c b/util.c
index 9d3f5ba0f1..37a71a1a81 100644
--- a/util.c
+++ b/util.c
@@ -2065,10 +2065,19 @@ Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const 
char *const bits,
 #ifdef USE_ENVIRON_ARRAY
 /* NB: VMS' my_setenv() is in vms.c */
 
+/* Configure doesn't test for HAS_SETENV yet, so decide based on platform.
+ * For Solaris, setenv() and unsetenv() were introduced in Solaris 9, so
+ * testing for HAS UNSETENV is sufficient.
+ */
+#  if defined(__CYGWIN__)|| defined(__SYMBIAN32__) || defined(__riscos__) || 
(defined(__sun) && defined(HAS_UNSETENV)) || defined(PERL_DARWIN)
+#define MY_HAS_SETENV
+#  endif
+
 /* small wrapper for use by Perl_my_setenv that mallocs, or reallocs if
  * 'current' is non-null, with up to three sizes that are added together.
  * It handles integer overflow.
  */
+#  ifndef MY_HAS_SETENV
 static char *
 S_env_alloc(void *current, Size_t l1, Size_t l2, Size_t l3, Size_t size)
 {
@@ -2093,6 +2102,7 @@ S_env_alloc(void *current, Size_t l1, Size_t l2, Size_t 
l3, Size_t size)
   panic:
 croak_memory_wrap();
 }
+#  endif
 
 
 #  if !defined(WIN32) && !defined(NETWARE)
@@ -2174,13 +2184,7 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
 
 #endif /* !PERL_USE_SAFE_PUTENV */
 
-/* This next branch should only be called #if defined(HAS_SETENV), but
-   Configure doesn't test for that yet.  For Solaris, setenv() and
-   unsetenv() were introduced in Solaris 9, so testing for HAS
-   UNSETENV is sufficient.
-*/
-#if defined(__CYGWIN__)|| defined(__SYMBIAN32__) || defined(__riscos__) || 
(defined(__sun) && defined(HAS_UNSETENV)) || defined(PERL_DARWIN)
-
+#ifdef MY_HAS_SETENV
 #  if defined(HAS_UNSETENV)
 if (val == NULL) {
 (void)unsetenv(nam);
@@ -2218,7 +,7 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
 my_setenv_format(new_env, nam, nlen, val, vlen);
 (void)putenv(new_env);
 
-#endif /* __CYGWIN__ */
+#endif /* MY_HAS_SETENV */
 
 #ifndef PERL_USE_SAFE_PUTENV
 }

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.0-88-g6b877bbd2c

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 6b877bbd2c071b3e0659fab552a74dc2ff7e08fb
Author: David Mitchell 
Date:   Sat Jul 14 10:47:04 2018 +0100

treat when(index() > -1) as a boolean expression

RT #133368

when(X) is normally compiled as when($_ ~~ X) *except* when X appears to
be a boolean expression, in which case it's used directly.

5.28.0 introduced an optimisation whereby comparisons involving index
like

index(...) != -1

eliminated the comparison, and pp_index() returned a boolean value
directly. This defeated the 'look for a boolean op' mechanism, and so

when(index(...) != -1)

and similar were being incorrectly compiled as

when($_ ~~ (index(...) != -1))

---

Summary of changes:
 op.c  |  8 +++-
 t/op/switch.t | 23 ++-
 2 files changed, 29 insertions(+), 2 deletions(-)

diff --git a/op.c b/op.c
index a05a1319d4..ddeb484b64 100644
--- a/op.c
+++ b/op.c
@@ -9072,6 +9072,13 @@ S_looks_like_bool(pTHX_ const OP *o)
case OP_FLOP:
 
return TRUE;
+
+   case OP_INDEX:
+   case OP_RINDEX:
+/* optimised-away (index() != -1) or similar comparison */
+if (o->op_private & OPpTRUEBOOL)
+return TRUE;
+return FALSE;

case OP_CONST:
/* Detect comparisons that have been optimized away */
@@ -9081,7 +9088,6 @@ S_looks_like_bool(pTHX_ const OP *o)
return TRUE;
else
return FALSE;
-
/* FALLTHROUGH */
default:
return FALSE;
diff --git a/t/op/switch.t b/t/op/switch.t
index e5385df0b4..6ff69e0bce 100644
--- a/t/op/switch.t
+++ b/t/op/switch.t
@@ -10,7 +10,7 @@ use strict;
 use warnings;
 no warnings 'experimental::smartmatch';
 
-plan tests => 195;
+plan tests => 197;
 
 # The behaviour of the feature pragma should be tested by lib/feature.t
 # using the tests in t/lib/feature/*. This file tests the behaviour of
@@ -1358,6 +1358,27 @@ given("xyz") {
"scalar value of false when";
 }
 
+# RT #133368
+# index() and rindex() comparisons such as '> -1' are optimised away. Make
+# sure that they're still treated as a direct boolean expression rather
+# than when(X) being implicitly converted to when($_ ~~ X)
+
+{
+my $s = "abc";
+my $ok = 0;
+given("xyz") {
+when (index($s, 'a') > -1) { $ok = 1; }
+}
+ok($ok, "RT #133368 index");
+
+$ok = 0;
+given("xyz") {
+when (rindex($s, 'a') > -1) { $ok = 1; }
+}
+ok($ok, "RT #133368 rindex");
+}
+
+
 # Okay, that'll do for now. The intricacies of the smartmatch
 # semantics are tested in t/op/smartmatch.t. Taintedness of
 # returned values is checked in t/op/taint.t.

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.29.0-18-g6ee81574cd

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 6ee81574cd3682da001e8c3e7a931f034c4c31b9
Merge: 957a9e817d adebb90ded
Author: David Mitchell 
Date:   Fri Jun 29 14:38:10 2018 +0100

[MERGE] fixups to Perl_my_setenv()

commit adebb90ded7502ff44bd789b300b1193c89c047c
Author: David Mitchell 
Date:   Fri Jun 29 14:30:17 2018 +0100

Perl_my_setenv(): re-indent cpp directive lines

The indentation was all over the place.  Whitespace-only changes apart
from fixing code comments at end of '#endif' lines.

commit de5576aa52889a6b4c37e8137a9ebfe0abe75619
Author: David Mitchell 
Date:   Fri Jun 29 14:12:18 2018 +0100

Perl_my_setenv: move code comment

This comment about VMS seems to have drifted over time away from the
ifdef it refs to

commit 34716e2a6ee2af96078d62b065b7785c001194be
Author: David Mitchell 
Date:   Fri Jun 29 13:37:03 2018 +0100

Perl_my_setenv(); handle integer wrap

RT #133204

Wean this function off int/I32 and onto UV/Size_t.
Also, replace all malloc-ish calls with a wrapper that does
overflow checks,

In particular, it was doing (nlen + vlen + 2) which could wrap when
the combined length of the environment variable name and value
exceeded around 0x7fff.

The wrapper check function is probably overkill, but belt and braces...

NB this function has several variant parts, #ifdef'ed by platform
type; I have blindly changed the parts that aren't compiled under linux.

---

Summary of changes:
 util.c | 154 -
 1 file changed, 104 insertions(+), 50 deletions(-)

diff --git a/util.c b/util.c
index 7282dd9cfe..53fa197b60 100644
--- a/util.c
+++ b/util.c
@@ -2060,149 +2060,203 @@ Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, 
const char *const bits,
Copy(val, s+(nlen+1), vlen, char); \
*(s+(nlen+1+vlen)) = '\0'
 
+
+
 #ifdef USE_ENVIRON_ARRAY
-   /* VMS' my_setenv() is in vms.c */
-#if !defined(WIN32) && !defined(NETWARE)
+/* NB: VMS' my_setenv() is in vms.c */
+
+/* small wrapper for use by Perl_my_setenv that mallocs, or reallocs if
+ * 'current' is non-null, with up to three sizes that are added together.
+ * It handles integer overflow.
+ */
+static char *
+S_env_alloc(void *current, Size_t l1, Size_t l2, Size_t l3, Size_t size)
+{
+void *p;
+Size_t sl, l = l1 + l2;
+
+if (l < l2)
+goto panic;
+l += l3;
+if (l < l3)
+goto panic;
+sl = l * size;
+if (sl < l)
+goto panic;
+
+p = current
+? safesysrealloc(current, sl)
+: safesysmalloc(sl);
+if (p)
+return (char*)p;
+
+  panic:
+croak_memory_wrap();
+}
+
+
+#  if !defined(WIN32) && !defined(NETWARE)
+
 void
 Perl_my_setenv(pTHX_ const char *nam, const char *val)
 {
   dVAR;
-#ifdef __amigaos4__
+#ifdef __amigaos4__
   amigaos4_obtain_environ(__FUNCTION__);
-#endif
-#ifdef USE_ITHREADS
+#endif
+
+#ifdef USE_ITHREADS
   /* only parent thread can modify process environment */
   if (PL_curinterp == aTHX)
-#endif
+#endif
   {
-#ifndef PERL_USE_SAFE_PUTENV
+
+#ifndef PERL_USE_SAFE_PUTENV
 if (!PL_use_safe_putenv) {
 /* most putenv()s leak, so we manipulate environ directly */
-I32 i;
-const I32 len = strlen(nam);
-int nlen, vlen;
+UV i;
+Size_t vlen, nlen = strlen(nam);
 
 /* where does it go? */
 for (i = 0; environ[i]; i++) {
-if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
+if (strnEQ(environ[i], nam, nlen) && environ[i][nlen] == '=')
 break;
 }
 
 if (environ == PL_origenviron) {   /* need we copy environment? */
-I32 j;
-I32 max;
+UV j, max;
 char **tmpenv;
 
 max = i;
 while (environ[max])
 max++;
-tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*));
+
+/* XXX shouldn't that be max+1 rather than max+2 ??? - DAPM */
+tmpenv = (char**)S_env_alloc(NULL, max, 2, 0, sizeof(char*));
+
 for (j=0; j

[perl.git] branch blead updated. v5.28.0-RC2-9-g9133f949d3

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 9133f949d34a239b65fafbd6fd54bcbe1dd2dad3
Author: David Mitchell 
Date:   Mon Jun 18 14:29:09 2018 +0100

bump Maintainers.pl entry for Archive-Tar

2.26 -> 2.28 after recent pull.

---

Summary of changes:
 Porting/Maintainers.pl | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 9b897cffdc..d760ba8dbc 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -120,7 +120,7 @@ use File::Glob qw(:case);
 %Modules = (
 
 'Archive::Tar' => {
-'DISTRIBUTION' => 'BINGOS/Archive-Tar-2.26.tar.gz',
+'DISTRIBUTION' => 'BINGOS/Archive-Tar-2.28.tar.gz',
 'FILES'=> q[cpan/Archive-Tar],
 'BUGS' => 'bug-archive-...@rt.cpan.org',
 'EXCLUDED' => [

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.28.0-RC2-8-gd778388fc4

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit d778388fc467242fe415dd05b11ed321de856353
Author: Smylers 
Date:   Thu Jun 7 16:26:12 2018 +0100

perldelta headings without full stops

Most of the headings don't end with full stops (even when they are
complete sentences), so remove the full stops from the few that do, so
they all follow the same style

commit 0ba4cd08e0edda2938e982938c9ac520e86a8302
Author: Smylers 
Date:   Thu Jun 7 16:21:11 2018 +0100

Clarify that /({...)/ is deprecated

Previously this was just a noun phrase, describing the thing that is
deprecated. Turn that into a statement, explicitly saying it is
deprecated.

Admittedly, the noun phrase is in a section headed ‘Deprecations’, but
some of the items in the list are about changes to deprecations, and
everything else in the list is a full sentence, so make this be one too.

commit 4d31efb6c54b7fc0d262a523c115d3ff533d
Author: Smylers 
Date:   Thu Jun 7 16:17:33 2018 +0100

Document delete %hash{key} return value

cc0776d64 introduced delete on key-value hash slices. That intuitively
returns a list of key- value pairs, which is two elements per specified
hash key. Update the docs to reflect this.

commit eefffb17d642061c02ee20eb2929449b00b6f33b
Author: Smylers 
Date:   Thu Jun 7 16:06:28 2018 +0100

Pod fix: Escape / inside L

When linking to a section name that contains a literal slash, podchecker
complains.

In practice this isn't ambiguous (the first slash separates the page name
from the section name, and everything after that, including subsequent
slashes, must be the section name) and the link was working on MetaCpan.
But since podcheck complains, it seems safer to fix this.

commit 604776f743450b2ff3f80f53cc4bd5ead106eb13
Author: Smylers 
Date:   Thu Jun 7 16:05:40 2018 +0100

Clarify key-value slices are of hashes

For somebody reading the perldelta without context, make it clear that the
‘key/value’ slices that are mentioned are hash slices, with a link to
their documentation.

commit 91f84d6f2b00acf02762066502c8fac8f7a11cd8
Author: David Mitchell 
Date:   Mon Jun 18 14:00:04 2018 +0100

Update Archive-Tar to CPAN version 2.28

  [DELTA]

+- fix creating file with trailing whitespace on filename - fixes 103279
+- allow archiving with absolute pathnames - fixes 97748
+- small POD fix
+- Speed up extract when archive contains lots of files
+- CVE-2018-12015 directory traversal vulnerability [RT#125523]

---

Summary of changes:
 cpan/Archive-Tar/lib/Archive/Tar.pm  | 36 +++-
 cpan/Archive-Tar/lib/Archive/Tar/Constant.pm |  2 +-
 cpan/Archive-Tar/lib/Archive/Tar/File.pm | 13 +++---
 cpan/Archive-Tar/t/04_resolved_issues.t  | 28 ++
 pod/perldelta.pod| 19 ---
 pod/perlfunc.pod |  9 ---
 6 files changed, 73 insertions(+), 34 deletions(-)

diff --git a/cpan/Archive-Tar/lib/Archive/Tar.pm 
b/cpan/Archive-Tar/lib/Archive/Tar.pm
index b585f7cfe2..5950b3ea20 100644
--- a/cpan/Archive-Tar/lib/Archive/Tar.pm
+++ b/cpan/Archive-Tar/lib/Archive/Tar.pm
@@ -31,7 +31,7 @@ use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK 
$CHOWN $CHMOD
 $DEBUG  = 0;
 $WARN   = 1;
 $FOLLOW_SYMLINK = 0;
-$VERSION= "2.26";
+$VERSION= "2.28";
 $CHOWN  = 1;
 $CHMOD  = 1;
 $SAME_PERMISSIONS   = $> == 0 ? 1 : 0;
@@ -601,6 +601,7 @@ sub extract {
 my $self= shift;
 my @args= @_;
 my @files;
+my $hashmap;
 
 # use the speed optimization for all extracted files
 local($self->{cwd}) = cwd() unless $self->{cwd};
@@ -617,16 +618,15 @@ sub extract {
 ### go find it then
 } else {
 
-my $found;
-for my $entry ( @{$self->_data} ) {
-next unless $file eq $entry->full_path;
+# create hash-map once to speed up lookup
+$hashmap = $hashmap || {
+map { $_->full_path, $_ } @{$self->_data}
+};
 
+if (exists $hashmap->{$file}) {
 ### we found the file you're looking for
-push @files, $entry;
-$found++;
-}
-
-unless( $found ) {
+push @files, $hashmap->{$file};
+} else {
 return $self->_error(
 qq[Could not find '$file' in archive] );

[perl.git] branch blead updated. v5.28.0-RC2-2-g197e7984e9

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 197e7984e9f640254af80f8553707bad217f3814
Author: David Mitchell 
Date:   Wed Jun 6 20:23:11 2018 +0100

run Porting/makemeta

Don't know why this needs doing, but t/porting/regen.t was failing:

not ok - Porting/makemeta META.json

and this seems to fix it.

---

Summary of changes:
 META.json | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/META.json b/META.json
index b330910aeb..d5172298c8 100644
--- a/META.json
+++ b/META.json
@@ -114,7 +114,7 @@
  "vxs.inc"
   ]
},
-   "release_status" : "testing",
+   "release_status" : "stable",
"resources" : {
   "bugtracker" : {
  "web" : "https://rt.perl.org/";

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.28.0-RC1-17-g94fc6237e5

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 94fc6237e538cf9cdd709b7ff2617619a369fe72
Author: David Mitchell 
Date:   Tue May 29 13:17:58 2018 +0100

perldelta tweaks

Improve some descriptions, eliminate some entries for changes which were
later reverted or for bugs which only appeared and were fixed within the
5.27.x development cycle; and wrap some long lines.

---

Summary of changes:
 pod/perldelta.pod | 152 ++
 1 file changed, 73 insertions(+), 79 deletions(-)

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 8b03b48319..25c91e5b37 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -150,7 +150,8 @@ flag set, but some were being missed.
 =head2 String- and number-specific bitwise ops are no longer experimental
 
 The new string-specific (C<&. |. ^. ~.>) and number-specific (C<& | ^ ~>)
-bitwise operators introduced in Perl 5.22 are no longer experimental.
+bitwise operators introduced in Perl 5.22 that are available within the
+scope of C are no longer experimental.
 Because the number-specific ops are spelled the same way as the existing
 operators that choose their behaviour based on their operands, these
 operators must still be enabled via the "bitwise" feature, in either of
@@ -178,12 +179,13 @@ may need to be changed to this:
 
 SV *
 bitop_handler (lobj, robj, swap, ...)
+
 =head2 Locales are now thread-safe on systems that support them
 
 These systems include Windows starting with Visual Studio 2005, and in
 POSIX 2008 systems.
 
-The implication is that you are now free to use locales and changes them
+The implication is that you are now free to use locales and change them
 in a threaded environment.  Your changes affect only your thread.
 See L
 
@@ -295,7 +297,7 @@ since Perl 5.20.
 
 This was deprecated since Perl 5.24.
 
-=head2 C no longer exists.
+=head2 The C method has been removed.
 
 Use C instead.
 
@@ -305,9 +307,11 @@ This was deprecated in Perl 5.004.
 
 =head2 Use of strings with code points over 0xFF is not allowed for bitwise 
string operators
 
-Code points over C<0xFF> do not make sense for bitwise operators.
+Code points over C<0xFF> do not make sense for bitwise operators and such
+an operation will now croak, except for a few remaining cases. See
+L.
 
-See L.
+This was deprecated in Perl 5.24.
 
 =head2 Setting C<${^ENCODING}> to a defined value is now illegal
 
@@ -375,11 +379,11 @@ Such strings are represented internally in UTF-8, and 
C is a
 bit-oriented operation that will likely give unexpected results on those
 strings.
 
-=head2 Some uses of unescaped C<"{"> are no longer fatal
+=head2 Some uses of unescaped C<"{"> in regexes are no longer fatal
 
 Perl 5.26.0 fatalized some uses of an unescaped left brace, but an
 exception was made at the last minute, specifically crafted to be a
-minimal change to allow GNU Autoconf to work.  This code is heavily
+minimal change to allow GNU Autoconf to work.  That tool is heavily
 depended upon, and continues to use the deprecated usage.  Its use of an
 unescaped left brace is one where we have no intention of repurposing
 C<"{"> to be something other than itself.
@@ -490,7 +494,10 @@ C in void and scalar contexts is now more 
efficient.
 
 =item *
 
-C<< if (index(...) != -1) { ... } >> is now more efficient.
+The common idiom of comparing the result of index() with -1 is now
+specifically optimised,  e.g.
+
+if (index(...) != -1) { ... }
 
 =item *
 
@@ -504,7 +511,7 @@ for more details.
 
 =item *
 
-C is now more efficient.
+The XS-level C API function is now more efficient.
 
 =item *
 
@@ -545,19 +552,20 @@ Key highlights in this release across several modules:
 
 =head2 Removal of use vars
 
-The usage of C has been discouraged since the introduction of C 
in
-Perl 5.6.0. Where possible the usage of this pragma has now been removed from
-the Perl source code.
+The usage of C has been discouraged since the introduction of
+C in Perl 5.6.0. Where possible the usage of this pragma has now been
+removed from the Perl source code.
 
 This had a slight effect (for the better) on the output of WARNING_BITS in
 L.
 
 =head2 Use of DynaLoader changed to XSLoader in many modules
 
-XSLoader is more modern, and most modules already require perl 5.6 or greater, 
so
-no functionality is lost by switching. In some cases, we have also made 
changes to
-the local implementation that may not be reflected in the version on CPAN due
-to a desire to maintain more backwards compatibility.
+XSLoader is more modern, and most modules already require perl 5.6 or
+greater, so no functionality is lost by switching. In some cases, we have
+also made changes to the loc

[perl.git] branch blead updated. v5.28.0-RC1-16-g2022b8aed7

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 2022b8aed7b7c9601d90b3e285262db88d1d07d0
Author: SHIRAKATA Kentaro 
Date:   Fri May 25 04:49:16 2018 +0900

more link to RT

---

Summary of changes:
 pod/perldelta.pod | 19 ++-
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index e517105813..8b03b48319 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -773,7 +773,8 @@ L has been upgraded from version 2.23 to 2.24.
 
 L has been upgraded from version 2.32 to 2.33.
 
-It will now use L utime where available (perl #132401).
+It will now use L utime where available
+L<[perl #132401|https://rt.perl.org/Ticket/Display.html?id=132401>.
 
 =item *
 
@@ -1936,15 +1937,15 @@ L<[perl 
#132729]|https://rt.perl.org/Ticket/Display.html?id=132729>
 =item *
 
 List assignment (C) could in some rare cases allocate an
-entry on the mortal stack and leave the entry uninitialized. [perl
-#131570]
+entry on the mortal stack and leave the entry uninitialized.
+L<[perl #131570]|https://rt.perl.org/Ticket/Display.html?id=131570>
 
 =item *
 
 Attempting to apply an attribute to an C variable where a
 function of that name already exists could result in a NULL pointer
-being supplied where an SV was expected, crashing perl.  [perl
-#131597]
+being supplied where an SV was expected, crashing perl.
+L<[perl #131597]|https://rt.perl.org/Ticket/Display.html?id=131597>
 
 =item *
 
@@ -2009,8 +2010,8 @@ C<$@>. For example:
 =item *
 
 Fixed a duplicate symbol failure with C<-flto -mieee-fp> builds.
-F defined C<_LIB_VERSION> which C<-lieee> already defines. [perl
-#131786]
+F defined C<_LIB_VERSION> which C<-lieee> already defines.
+L<[perl #131786]|https://rt.perl.org/Ticket/Display.html?id=131786>
 
 =item *
 
@@ -2024,8 +2025,8 @@ On non-threaded builds, for C where C<$null> is 
an empty
 string is no longer treated as if the C flag was present when the
 previous matching match operator included the C flag.  The
 rewriting used to implement this behavior could confuse the
-interpreter.  This matches the behaviour of threaded builds.  [perl
-#124368]
+interpreter.  This matches the behaviour of threaded builds.
+L<[perl #124368]|https://rt.perl.org/Ticket/Display.html?id=124368>
 
 =item *
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.28.0-RC1-15-g9f9606382c

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 9f9606382c45ba5e9600dddf96abfe956762af99
Author: David Mitchell 
Date:   Mon May 28 15:54:57 2018 +0100

revert perl_run() 0 -> 256 return mapping

RT #133220

This commit partially reverts v5.27.6-180-g0301e89953.

That commit changed the return values of perl_parse() and perl_run()
so that an exit(0) wouldn't return 0 (which indicates a normal finish)
and instead return 0x100, which a indicates non-normal return, but with
a value which if used as an 8-bit process exit value on UNIX, has the
modulo value of 0.

However, it turns out that perl_run() (via S_run_body()) does a my_exit(0)
rather than just running to completion. So it turns out that it's not
possible to distinguish between perl code finishing normally, and perl
code doing exit(0).

This broke code which embedded perl and expected perl_run() to return 0
on normal completion.

It may be possible to fix this by getting S_run_body() to not call
my_exit(0), but that's too unpredictable change while we're at -RC1.

So just revert the new perl_run() 0x100 behaviour for now.

---

Summary of changes:
 perl.c | 13 +++--
 1 file changed, 3 insertions(+), 10 deletions(-)

diff --git a/perl.c b/perl.c
index 2914d39238..e6dfa8dc05 100644
--- a/perl.c
+++ b/perl.c
@@ -2594,7 +2594,7 @@ int
 perl_run(pTHXx)
 {
 I32 oldscope;
-int ret = 0, exit_called = 0;
+int ret = 0;
 dJMPENV;
 
 PERL_ARGS_ASSERT_PERL_RUN;
@@ -2615,10 +2615,8 @@ perl_run(pTHXx)
 case 0:/* normal completion */
  redo_body:
run_body(oldscope);
-   goto handle_exit;
+   /* FALLTHROUGH */
 case 2:/* my_exit() */
-   exit_called = 1;
-handle_exit:
while (PL_scopestack_ix > oldscope)
LEAVE;
FREETMPS;
@@ -2632,12 +2630,7 @@ perl_run(pTHXx)
if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
dump_mstats("after execution:  ");
 #endif
-   if (exit_called) {
-   ret = STATUS_EXIT;
-   if (ret == 0) ret = 0x100;
-   } else {
-   ret = 0;
-   }
+   ret = STATUS_EXIT;
break;
 case 3:
if (PL_restartop) {

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.28.0-RC1-5-g35573a3609

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 35573a36098f1f3076718ecc2974da3793c924e4
Author: David Mitchell 
Date:   Mon May 21 16:26:10 2018 +0100

update with perl527*delta removal

Update a few build files so that they know that the perl527*delta.pod
files no longer exist.

---

Summary of changes:
 MANIFEST  | 12 
 pod/perl.pod  | 12 
 win32/pod.mak | 48 
 3 files changed, 72 deletions(-)

diff --git a/MANIFEST b/MANIFEST
index 82f0669bfd..2005f544cd 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5068,18 +5068,6 @@ pod/perl5244delta.podPerl changes in version 
5.24.4
 pod/perl5260delta.pod  Perl changes in version 5.26.0
 pod/perl5261delta.pod  Perl changes in version 5.26.1
 pod/perl5262delta.pod  Perl changes in version 5.26.2
-pod/perl5270delta.pod  Perl changes in version 5.27.0
-pod/perl52710delta.pod Perl changes in version 5.27.10
-pod/perl52711delta.pod Perl changes in version 5.27.11
-pod/perl5271delta.pod  Perl changes in version 5.27.1
-pod/perl5272delta.pod  Perl changes in version 5.27.2
-pod/perl5273delta.pod  Perl changes in version 5.27.3
-pod/perl5274delta.pod  Perl changes in version 5.27.4
-pod/perl5275delta.pod  Perl changes in version 5.27.5
-pod/perl5276delta.pod  Perl changes in version 5.27.6
-pod/perl5277delta.pod  Perl changes in version 5.27.7
-pod/perl5278delta.pod  Perl changes in version 5.27.8
-pod/perl5279delta.pod  Perl changes in version 5.27.9
 pod/perl561delta.pod   Perl changes in version 5.6.1
 pod/perl56delta.podPerl changes in version 5.6
 pod/perl581delta.pod   Perl changes in version 5.8.1
diff --git a/pod/perl.pod b/pod/perl.pod
index 4ce0c226c4..15c6b4427d 100644
--- a/pod/perl.pod
+++ b/pod/perl.pod
@@ -181,18 +181,6 @@ aux h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp
 
 perlhist   Perl history records
 perldelta  Perl changes since previous version
-perl52711delta Perl changes in version 5.27.11
-perl52710delta Perl changes in version 5.27.10
-perl5279delta  Perl changes in version 5.27.9
-perl5278delta  Perl changes in version 5.27.8
-perl5277delta  Perl changes in version 5.27.7
-perl5276delta  Perl changes in version 5.27.6
-perl5275delta  Perl changes in version 5.27.5
-perl5274delta  Perl changes in version 5.27.4
-perl5273delta  Perl changes in version 5.27.3
-perl5272delta  Perl changes in version 5.27.2
-perl5271delta  Perl changes in version 5.27.1
-perl5270delta  Perl changes in version 5.27.0
 perl5262delta  Perl changes in version 5.26.2
 perl5261delta  Perl changes in version 5.26.1
 perl5260delta  Perl changes in version 5.26.0
diff --git a/win32/pod.mak b/win32/pod.mak
index 63d7afe668..4638153d9d 100644
--- a/win32/pod.mak
+++ b/win32/pod.mak
@@ -53,18 +53,6 @@ POD = perl.pod   \
perl5260delta.pod   \
perl5261delta.pod   \
perl5262delta.pod   \
-   perl5270delta.pod   \
-   perl52710delta.pod  \
-   perl52711delta.pod  \
-   perl5271delta.pod   \
-   perl5272delta.pod   \
-   perl5273delta.pod   \
-   perl5274delta.pod   \
-   perl5275delta.pod   \
-   perl5276delta.pod   \
-   perl5277delta.pod   \
-   perl5278delta.pod   \
-   perl5279delta.pod   \
perl5280delta.pod   \
perl561delta.pod\
perl56delta.pod \
@@ -214,18 +202,6 @@ MAN = perl.man \
perl5260delta.man   \
perl5261delta.man   \
perl5262delta.man   \
-   perl5270delta.man   \
-   perl52710delta.man  \
-   perl52711delta.man  \
-   perl5271delta.man   \
-   perl5272delta.man   \
-   perl5273delta.man   \
-   perl5274delta.man   \
-   perl5275delta.man   \
-   perl5276delta.man   \
-   perl5277delta.man   \
-   perl5278delta.man   \
-   perl5279delta.man   \
perl5280delta.man   \
perl561delta.man\
perl56delta.man \
@@ -375,18 +351,6 @@ HTML = perl.html   \
perl5260delta.html  \
perl5261delta.html  \
perl5262delta.html  \
-   perl5270delta.html  \
-   perl52710delta.html \
-   perl52711delta.html \
-   perl5271delta.html  \
-   perl5272delta.html  \
-   perl5273delta.html  \
-   perl5274de

[perl.git] branch blead updated. v5.27.11-38-g64a9c78095

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 64a9c780950becebc7326a31d067801ec9b187a2
Author: David Mitchell 
Date:   Wed May 9 10:54:55 2018 +0100

Revert "set PERL_EXIT_DESTRUCT_END in all embeddings"

This reverts commit 8e920bd341e241f50a74dbf8aa343319f204e200.
Also skip the tests in t/op/blocks.t

RT #132863

8e920bd341 sets the PERL_EXIT_DESTRUCT_END flag on non-UNIXy platforms,
like is already done on UNIXy platforms.  This makes things like
BEGIN { exit(1) } call END blocks on those platforms (like they already
do on UNIX).

But it caused problems with win32 pseudo-forks, so revert for 5.28
and re-address the issues sometime later.

commit 6b12a45f5c460336891492f0e67595db5af4983d
Author: David Mitchell 
Date:   Wed May 9 13:52:50 2018 +0100

t/op/blocks.t: indent 6 tests in a new skip block

Apart from the whitespace change, this just wraps 6 tests in
a SKIP: { ... } block which isn't (yet) used.

commit 21e22e9eed0096c170cdd5eb23d7fae995620591
Author: David Mitchell 
Date:   Wed May 9 13:49:14 2018 +0100

t/op/blocks.t: consolidate VMS-skips together

Put the three tests skipped under VMS together into a single SKIP
block rather than 3 separate skips.

As well as being tidier, as a side effect, it makes 6 tests contiguous
that are shortly to be skipped under win32,

commit 0d18e3dc7f3c6651b74dcaf1f7799d9b210ec1e5
Author: David Mitchell 
Date:   Wed May 9 13:35:42 2018 +0100

t/op/blocks.t: add some whitespace

Makes the tests a bit easier to read.

---

Summary of changes:
 NetWare/interface.c   |   1 -
 NetWare/interface.cpp |   1 -
 os2/perlrexx.c|   1 -
 symbian/PerlBase.cpp  |   4 --
 t/op/blocks.t | 124 ++
 win32/perllib.c   |   1 -
 6 files changed, 105 insertions(+), 27 deletions(-)

diff --git a/NetWare/interface.c b/NetWare/interface.c
index b943d21147..1d298854c9 100644
--- a/NetWare/interface.c
+++ b/NetWare/interface.c
@@ -62,7 +62,6 @@ ClsPerlHost::PerlCreate(PerlInterpreter *my_perl)
 /* if (!(my_perl = perl_alloc()))  // Allocate memory for Perl.
return (1);*/
 perl_construct(my_perl);
-PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
 
return 1;
 }
diff --git a/NetWare/interface.cpp b/NetWare/interface.cpp
index 7fe027933c..b08d6c249e 100644
--- a/NetWare/interface.cpp
+++ b/NetWare/interface.cpp
@@ -53,7 +53,6 @@ ClsPerlHost::PerlCreate(PerlInterpreter *my_perl)
 /* if (!(my_perl = perl_alloc()))  // Allocate memory for Perl.
return (1);*/
 perl_construct(my_perl);
-PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
 
return 1;
 }
diff --git a/os2/perlrexx.c b/os2/perlrexx.c
index b9f6789677..18d655137d 100644
--- a/os2/perlrexx.c
+++ b/os2/perlrexx.c
@@ -74,7 +74,6 @@ init_perl(int doparse)
if (!my_perl)
return 0;
perl_construct(my_perl);
-   PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
PL_perl_destruct_level = 1;
 }
 if (!doparse)
diff --git a/symbian/PerlBase.cpp b/symbian/PerlBase.cpp
index 88810bfd12..9312abeb55 100644
--- a/symbian/PerlBase.cpp
+++ b/symbian/PerlBase.cpp
@@ -141,10 +141,6 @@ void CPerlBase::ConstructL()
 User::LeaveIfNull(iPerl);
 iState = EPerlAllocated;
 perl_construct(iPerl); // returns void
-{
-   PerlInterpreter *my_perl = iPerl;
-   PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
-}
 if (!iStdioInitFunc) {
 iConsole =
   Console::NewL(_L("Perl Console"),
diff --git a/t/op/blocks.t b/t/op/blocks.t
index f220ab2bc9..1fb369a1a1 100644
--- a/t/op/blocks.t
+++ b/t/op/blocks.t
@@ -147,30 +147,116 @@ fresh_perl_is('END { print "ok\n" } INIT { bless {} and 
exit }', "ok\n",
   {}, 'null PL_curcop in newGP');
 
 # [perl #2754] exit(0) didn't exit from inside a UNITCHECK or CHECK block
-my $testblocks = join(" ", "BEGIN { \$| = 1; }", (map { "@{[uc($_)]} { print 
\"$_\\n\"; }" } qw(begin unitcheck check init end)), "print \"main\\n\";");
-fresh_perl_is($testblocks, "begin\nunitcheck\ncheck\ninit\nmain\nend", {}, 
'blocks execute in right order');
-SKIP: {
-skip "VMS doesn't have the perl #2754 bug", 1 if $^O eq 'VMS';
-fresh_perl_is("$testblocks BEGIN { exit 0; }", 
"begin\nunitcheck\ncheck\ninit\nend", {}, "BEGIN{exit 0} doesn't exit yet");
-}
-fresh_perl_is("$testblocks BEGIN { exit 1; }", "begin\nunitcheck\ncheck\nend", 
{}, "BEGIN{exit 1} should exit");
-fresh_perl_like("$testblocks BEGIN { die; }", qr/\Abegin\nDied[^\n]*\.\nBEGIN 
failed[^\n]*\.\nunitcheck\ncheck\nend\z/, {}, "BEGIN{die} should exit");
+
+my $testblocks =
+jo

[perl.git] branch blead updated. v5.27.11-34-g14ccab5a6b

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 14ccab5a6b00da04dd7a4eeb19bb8caadde2bd72
Author: Gene Sullivan 
Date:   Fri May 4 22:17:25 2018 -0400

perlretut correction: 'qw' should be inside parens

RT #133172

---

Summary of changes:
 Porting/checkAUTHORS.pl | 1 +
 pod/perlretut.pod   | 2 +-
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/Porting/checkAUTHORS.pl b/Porting/checkAUTHORS.pl
index f0cb984282..2f34a8428b 100755
--- a/Porting/checkAUTHORS.pl
+++ b/Porting/checkAUTHORS.pl
@@ -627,6 +627,7 @@ fugazi\100zyx.net   larrysh\100cpan.org
 gbacon\100itsc.uah.edu  gbacon\100adtrn-srv4.adtran.com
 gerberb\100zenez.comroot\100devsys0.zenez.com
 gfuji\100cpan.org   g.psy.va\100gmail.com
+genesullivan50\100yahoo.com gsullivan\100cpan.org
 gerard\100ggoossen.net  gerard\100tty.nl
 gibreel\100pobox.com
stephen.zander\100interlock.mckesson.com
 +   srz\100loopback
diff --git a/pod/perlretut.pod b/pod/perlretut.pod
index 3add259f79..1e1cdd49b2 100644
--- a/pod/perlretut.pod
+++ b/pod/perlretut.pod
@@ -880,7 +880,7 @@ matching operation combines the three patterns as 
alternatives:
 $fmt1 = '(?\d\d\d\d)-(?\d\d)-(?\d\d)';
 $fmt2 = '(?\d\d)/(?\d\d)/(?\d\d\d\d)';
 $fmt3 = '(?\d\d)\.(?\d\d)\.(?\d\d\d\d)';
-for my $d qw( 2006-10-21 15.01.2007 10/31/2005 ){
+for my $d (qw(2006-10-21 15.01.2007 10/31/2005)) {
 if ( $d =~ m{$fmt1|$fmt2|$fmt3} ){
 print "day=$+{d} month=$+{m} year=$+{y}\n";
 }

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.27.11-33-ge9c9cf5759

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit e9c9cf57594854df9f5802f7f149be4738212e96
Author: David Mitchell 
Date:   Fri May 11 08:03:42 2018 +0100

fix build failure with recent glibc

RT #133184

pp_crypt() directly manipulates a field inside 'struct crypt_data' to work
around a bug in an ancient glibc version from circa 2002. New glibc
releases don't have this field so perl fails to compile. Make the hack
conditional on glibc version.

Stolen from a patch to the Fedora 28 distribution.

---

Summary of changes:
 pp.c | 6 +-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/pp.c b/pp.c
index 826c20748b..33eac6040d 100644
--- a/pp.c
+++ b/pp.c
@@ -3653,8 +3653,12 @@ PP(pp_crypt)
 #if defined(__GLIBC__) || defined(__EMX__)
if (PL_reentrant_buffer->_crypt_struct_buffer) {
PL_reentrant_buffer->_crypt_struct_buffer->initialized = 0;
-   /* work around glibc-2.2.5 bug */
+#if (defined(__GLIBC__) && __GLIBC__ == 2) && \
+(defined(__GLIBC_MINOR__) && __GLIBC_MINOR__ >= 2 && __GLIBC_MINOR__ < 4)
+   /* work around glibc-2.2.5 bug, has been fixed at some
+* time in glibc-2.3.X */
PL_reentrant_buffer->_crypt_struct_buffer->current_saltbits = 0;
+#endif
}
 #endif
 }

-- 
Perl5 Master Repository

[perl.git] branch smoke-me/davem/win32_exit_revert created. v5.27.11-35-g49836af79e

[Dave Mitchell]

In perl.git, the branch smoke-me/davem/win32_exit_revert has been created



at  49836af79ea2212d3039ee3819b25046e4c5dd8a (commit)

- Log -
commit 49836af79ea2212d3039ee3819b25046e4c5dd8a
Author: David Mitchell 
Date:   Wed May 9 10:54:55 2018 +0100

Revert "set PERL_EXIT_DESTRUCT_END in all embeddings"

This reverts commit 8e920bd341e241f50a74dbf8aa343319f204e200.
Also skip the tests in t/op/blocks.t

RT #132863

8e920bd341 sets the PERL_EXIT_DESTRUCT_END flag on non-UNIXy platforms,
like is already done on UNIXy platforms.  This makes things like
BEGIN { exit(1) } call END blocks on those platforms (like they already
do on UNIX).

But it caused problems with win32 pseudo-forks, so revert for 5.28
and re-address the issues sometime later.

commit 3442dd28658819854a21f9eb32b26ba823277492
Author: David Mitchell 
Date:   Wed May 9 13:52:50 2018 +0100

t/op/blocks.t: indent 6 tests in a new skip block

Apart from the whitespace change, this just wraps 6 tests in
a SKIP: { ... } block which isn't (yet) used.

commit 33bcf4507640e9e7d805b51f20818c15751d864c
Author: David Mitchell 
Date:   Wed May 9 13:49:14 2018 +0100

t/op/blocks.t: consolidate VMS-skips together

Put the three tests skipped under VMS together into a single SKIP
block rather than 3 separate skips.

As well as being tidier, as a side effect, it makes 6 tests contiguous
that are shortly to be skipped under win32,

commit 347a6778d4da68a4945855f9709afcf057e32353
Author: David Mitchell 
Date:   Wed May 9 13:35:42 2018 +0100

t/op/blocks.t: add some whitespace

Makes the tests a bit easier to read.

---

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.27.11-31-gd6f040aa42

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit d6f040aa42ca83e5e2ddbd3502921c8fee6197c4
Author: David Mitchell 
Date:   Mon May 7 17:44:02 2018 +0100

fix typo in Artistic

RT #133120

Spotted by Alexandr Savca

Change approved by Makoto Nozaki of TPF

---

Summary of changes:
 Artistic | 2 +-
 pod/perlartistic.pod | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/Artistic b/Artistic
index d1b6e5ad69..4ece078a5d 100644
--- a/Artistic
+++ b/Artistic
@@ -126,6 +126,6 @@ products derived from this software without specific prior 
written permission.
 
 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
 IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
 
 The End
diff --git a/pod/perlartistic.pod b/pod/perlartistic.pod
index 63813ff4fb..65565018ad 100644
--- a/pod/perlartistic.pod
+++ b/pod/perlartistic.pod
@@ -213,7 +213,7 @@ products derived from this software without specific prior 
written permission.
 
 THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
 IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
 
 =back
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.27.11-30-g38c84d6ad1

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 38c84d6ad1b77d7b1de424eab465e018c7cef576
Author: David Mitchell 
Date:   Tue May 1 15:28:49 2018 +0100

sprintf2.t: mark TODO bad denorm values under g++

Some t/op/sprintf2.t tests were failing under g++. This is due the perl
toker interpreting very small literal hex floating pointers as 0 rather
than as a subnormal value.

For example:

perl -le'print "bad" if 0x1.fp-1022 == 0.0'

This breaks some of the sprintf2.t tests, so mark them TODO them if the
literal value evaluates to zero.

Note that this is a bug in the toker/g++/glibc rather than sprintf.

The issue is due to the use of pow() in scan_num():

under gcc and plain g++, pow(2.0, -1074) returns the smallest denorm
number; however, under 'g++ -ansi', it returns 0.0.

---

Summary of changes:
 t/op/sprintf2.t | 12 +++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index 5fb75974cb..3f4c126c68 100644
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -808,7 +808,17 @@ SKIP: {
 for my $t (@subnormals) {
# Note that "0x1p+2" is not considered numeric,
# since neither is "0x12", hence the eval.
-my $s = sprintf($t->[1], eval $t->[0]);
+my $f = eval $t->[0];
+# XXX under g++ -ansi, pow(2.0, -1074) returns 0 rather
+# than the smallest denorm number. Which means that very small
+# string literals on a perl compiled under g++ may be seen as 0.
+# This is either a bug in the g++ math library or scan_num() in
+# toke.c; but in either case, its not a bug in sprintf(), so
+# skip the test.
+local $::TODO = "denorm literals treated as zero"
+if $f == 0.0 && $t->[2] ne '0x0p+0';
+
+my $s = sprintf($t->[1], $f);
 is($s, $t->[2], "subnormal @$t got $s");
 }
 

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.27.11-28-gb974d2c0b3

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit b974d2c0b3ae119172675913e129ce2d772c9cfb
Author: Karl Williamson 
Date:   Sat Apr 28 10:18:05 2018 -0600

lib/locale.t: TODO some locales on Solaris

There is a bug in Solaris with locales which have a multi-byte decimal
radix character.  Make these TODO, like we do cygwin, which has had a
similar problem.

commit a6bc52d6f49f1a3477d77477fff906f8b7a72350
Author: Karl Williamson 
Date:   Sat Apr 28 10:16:08 2018 -0600

lib/locale.t: Mark a test problematic

We now have found a system that fails this test.  Tests that are listed
as problematic automatically get marked as TODO when they fail with
specified platforms.  The next commit will specify the platform that
this is fails on.

commit e3e8c0d65ca7b9ba2165dec478a6bb59586a8281
Author: Karl Williamson 
Date:   Thu Apr 19 14:43:43 2018 -0600

t/run/locale.t: Skip some Solaris locales

Solaris is buggy in dealing with locales that have a multi-byte UTF-8
decimal radix character.  Skip using these, like we do on cygwin, which
has a similar problem.

---

Summary of changes:
 lib/locale.t   | 6 ++
 t/run/locale.t | 7 +++
 2 files changed, 13 insertions(+)

diff --git a/lib/locale.t b/lib/locale.t
index 85843acae7..17931c894d 100644
--- a/lib/locale.t
+++ b/lib/locale.t
@@ -78,6 +78,11 @@ my %known_bad_locales = (
   darwin => qr/ ^ lt_LT.ISO8859 /ix,
   os390 => qr/ ^ italian /ix,
   netbsd => qr/\bISO8859-2\b/i,
+
+  # This may be the same bug as the cygwin below; it's
+  # generating malformed UTF-8 on the radix being
+  # mulit-byte
+  solaris => qr/ ^ ( ar_ | pa_ ) /x,
 );
 
 # cygwin isn't returning proper radix length in this locale, but supposedly to
@@ -2237,6 +2242,7 @@ foreach my $Locale (@Locale) {
 
 report_result($Locale, ++$locales_test_number, $ok15);
 $test_names{$locales_test_number} = 'Verify that a number with a UTF-8 
radix has a UTF-8 stringification';
+$problematical_tests{$locales_test_number} = 1;
 
 report_result($Locale, ++$locales_test_number, $ok16);
 $test_names{$locales_test_number} = 'Verify that a sprintf of a number 
with a UTF-8 radix yields UTF-8';
diff --git a/t/run/locale.t b/t/run/locale.t
index 13bc25d7a7..282fbb5f86 100644
--- a/t/run/locale.t
+++ b/t/run/locale.t
@@ -88,6 +88,13 @@ if ($non_C_locale) {
 @test_numeric_locales = grep { $_ !~ m/ps_AF/i } @test_numeric_locales;
 }
 
+# Similarly the arabic locales on solaris don't work right on the
+# multi-byte radix character, generating malformed UTF-8.
+if ($^O eq 'solaris') {
+@test_numeric_locales = grep { $_ !~ m/ ^ ( ar_ | pa_ ) /x }
+@test_numeric_locales;
+}
+
 fresh_perl_is("for (qw(@test_numeric_locales)) {\n" . <<'EOF',
 use POSIX qw(locale_h);
 use locale;

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.27.11-25-g02bf4969b4

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 02bf4969b4ef09662846e14c3d8199fee18ebe35
Author: Tomasz Konojacki 
Date:   Sun Apr 22 23:49:59 2018 +0200

getcwd() doesn't fail on non-existent directories on DragonFly BSD.

Until it's fixed upstream, we should skip tests that don't expect
this behaviour.

[RT #133141]

---

Summary of changes:
 dist/PathTools/t/cwd_enoent.t | 4 
 1 file changed, 4 insertions(+)

diff --git a/dist/PathTools/t/cwd_enoent.t b/dist/PathTools/t/cwd_enoent.t
index ee99423cbb..b9adddeab7 100644
--- a/dist/PathTools/t/cwd_enoent.t
+++ b/dist/PathTools/t/cwd_enoent.t
@@ -24,6 +24,10 @@ foreach my $type (qw(regular perl)) {
skip "_perl_abs_path() not expected to work", 4
if $type eq "perl" &&
!(($Config{prefix} =~ m/\//) && $^O ne "cygwin");
+
+   skip "getcwd() doesn't fail on non-existent directories on this 
platform", 4
+   if $type eq 'regular' && $^O eq 'dragonfly';
+
no warnings "redefine";
local *Cwd::abs_path = \&Cwd::_perl_abs_path if $type eq "perl";
local *Cwd::getcwd = \&Cwd::_perl_getcwd if $type eq "perl";

-- 
Perl5 Master Repository

[perl.git] branch smoke-me/davem/win32_exit created. v5.27.11-24-g9fafc52ee1

[Dave Mitchell]

In perl.git, the branch smoke-me/davem/win32_exit has been created



at  9fafc52ee15897a9f799bf28336e5f7f389a0df7 (commit)

- Log -
commit 9fafc52ee15897a9f799bf28336e5f7f389a0df7
Author: David Mitchell 
Date:   Mon Apr 30 21:42:55 2018 +0100

win323 fork(): honour PERL_EXIT_DESTRUCT_END

RT #132863

The PERL_EXIT_DESTRUCT_END flag in PL_exit_flags is designed to defer
the calling of END blocks in perl_run() to being called from
perl_destruct() instead. On UNIX-like builds, perlmain.c sets this flag.
So main() looks like, in outline:

PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
if (!perl_parse(my_perl, xs_init, argc, argv, (char **)NULL))
perl_run(my_perl);
exitstatus = perl_destruct(my_perl);

which means that it doesn't matter whether perl_parse() finishes
normally or prematurely (e.g. via BEGIN { exit(1) } or BEGIN { die });
in all cases, due to PERL_EXIT_DESTRUCT_END being set, the END blocks
will always be called (from perl_destruct()).

Commit v5.27.7-9-g8e920bd341 added PERL_EXIT_DESTRUCT_END to the
equivalent of main() on other platforms such as win32; this
means that the new tests in t/op/blocks.t pass on win32 too, and all
platforms have the same behaviour for e.g.

END { print "end\n"; } BEGIN { exit 1; } # prints "end"

However, that commit was causing some tests in some CPAN distributions to
hang. These were using the win32 fork() emulation.

PerlProcFork() on win32 clones an interpreter, starts a new thread,
and makes the new thread call win32_start_child(), which
does the rough equivalent of C,
except that it rolls it's own perl_run() equivalent which
*doesn't* honour the PERL_EXIT_DESTRUCT_END flag. So by setting
PERL_EXIT_DESTRUCT_END, END blocks in fork()ed processes were getting
executed twice: once by win32_start_child() emulating perl_run(),
and once by perl_destruct() called from win32_start_child().

This commit makes win32_start_child() honour PERL_EXIT_DESTRUCT_END.

---

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.27.11-23-ga161cde74a

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit a161cde74ab6bd0def025bb5691c39d682c4204e
Author: Daniel Dragan 
Date:   Fri Apr 27 21:09:49 2018 -0400

utf8.c: use TRUE not true

"true" token was added in commit 394d2d3f37 but "true" is C++ and C99,
"TRUE" is portable perl API

Win32 VC 2003 C mode (C89) build faiure
..\utf8.c(6177) : error C2065: 'true' : undeclared identifier

---

Summary of changes:
 utf8.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/utf8.c b/utf8.c
index e66c328b11..ceb4723113 100644
--- a/utf8.c
+++ b/utf8.c
@@ -6174,7 +6174,7 @@ Perl_parse_uniprop_string(pTHX_ const char * const name, 
const Size_t len, const
 return NULL;
 }
 
-starts_with_In_or_Is = true;
+starts_with_In_or_Is = TRUE;
 }
 
 /* Get the index into our pointer table of the inversion list corresponding

-- 
Perl5 Master Repository

[perl.git] branch smoke-me/davem/weak_sort deleted. v5.27.11-20-gd830645338

[Dave Mitchell]

In perl.git, the branch smoke-me/davem/weak_sort has been deleted



   was  d8306453385a4991e40b4738982bf9617b6c1ccf

- Log -
d8306453385a4991e40b4738982bf9617b6c1ccf Revert "Strengthen weak refs when 
sorting in-place"
---

-- 
Perl5 Master Repository

[perl.git] branch smoke-me/davem/time_hires_nsec created. v5.27.11-18-g3e15af2f6d

[Dave Mitchell]

In perl.git, the branch smoke-me/davem/time_hires_nsec has been created



at  3e15af2f6d937772d14e95e9b7443423f157d5cd (commit)

- Log -
commit 3e15af2f6d937772d14e95e9b7443423f157d5cd
Author: David Mitchell 
Date:   Fri Apr 27 12:43:44 2018 +0100

time::HiRes: don't truncate nanosec utime

When passed a floating point atime/mtime value, T::HR::utime()
was converting it into two longs: secs and nsec. But the nanosec value
was calculated using a final NV to long cast, which truncates any
fractional part rather than rounding to nearest. Use a 0.5 addition to
force rounding.

This was manifesting as a test in lib/File/Copy.t failing to preserve
the same mtime after a couple of round trips with utime() and stat().

In particular, the test was attempting to set an mtime to the literal
floating-point value

10.12345

This value can't be represented exactly as an NV, so was actually
(under -Dquadmath)

10.12344568211720247320

which was (using truncation) being converted into the two sec/nsec
longs:

10, 12344

After this commit, it instead correctly gets converted to

10, 12345

---

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.27.11-21-g9fba38f0c3

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit 9fba38f0c306686a0a62e378ff28e2cd58fb0fbb
Merge: 5dbe8f0a91 d830645338
Author: David Mitchell 
Date:   Fri Apr 27 10:35:09 2018 +0100

[MERGE] temporarily revert weak in-place sort fix

---

Summary of changes:
 pp.c   |  7 ---
 pp_sort.c  |  3 ---
 t/op/reverse.t | 16 +---
 t/op/sort.t| 13 +
 4 files changed, 2 insertions(+), 37 deletions(-)

diff --git a/pp.c b/pp.c
index d777ae4309..826c20748b 100644
--- a/pp.c
+++ b/pp.c
@@ -5618,14 +5618,7 @@ PP(pp_reverse)
SV * const tmp = *begin;
*begin++ = *end;
*end--   = tmp;
-
-if (tmp && SvWEAKREF(tmp))
-sv_rvunweaken(tmp);
}
-
-/* make sure we catch the middle element */
-if (begin == end && *begin && SvWEAKREF(*begin))
-sv_rvunweaken(*begin);
}
}
}
diff --git a/pp_sort.c b/pp_sort.c
index 8be778e2f2..b4a9dd91e7 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1094,9 +1094,6 @@ PP(pp_sort)
 base[i] = newSVsv(sv);
 else
 SvREFCNT_inc_simple_void_NN(sv);
-
-if (SvWEAKREF(sv))
-sv_rvunweaken(sv);
 }
 av_clear(av);
 if (max > 0) {
diff --git a/t/op/reverse.t b/t/op/reverse.t
index a7d3178211..16c732bc3f 100644
--- a/t/op/reverse.t
+++ b/t/op/reverse.t
@@ -6,7 +6,7 @@ BEGIN {
 set_up_inc('../lib');
 }
 
-plan tests => 26;
+plan tests => 24;
 
 is(reverse("abc"), "cba", 'simple reverse');
 
@@ -92,20 +92,6 @@ use Tie::Array;
 is($a, $c, 'Unicode string double reversal matches original');
 }
 
-# in-place reversing of weak references
-SKIP: {
-skip_if_miniperl("no dynamic loading on miniperl, no extension 
Scalar::Util", 2);
-require Scalar::Util;
-my @a = map { \(my $dummy = $_) } 1..5; # odd number of elements
-my @r = @a[0,2];# middle and non-middle element
-Scalar::Util::weaken($a[0]);
-Scalar::Util::weaken($a[2]);
-@a = reverse @a;
-@r = ();
-ok defined $a[-1] && ${$a[-1]} eq '1', "in-place reverse strengthens weak 
reference";
-ok defined $a[2] && ${$a[2]} eq '3', "in-place reverse strengthens weak 
reference in the middle";
-}
-
 # [perl #132544] stack pointer used to go wild when nullary reverse
 # required extending the stack
 for(0..1000){()=(0..$_,scalar reverse )}
diff --git a/t/op/sort.t b/t/op/sort.t
index 610db691b8..d201f00afd 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -7,7 +7,7 @@ BEGIN {
 set_up_inc('../lib');
 }
 use warnings;
-plan(tests => 200);
+plan(tests => 199);
 
 # these shouldn't hang
 {
@@ -492,18 +492,7 @@ cmp_ok($x,'eq','123',q(optimized-away comparison block 
doesn't take any other ar
 @a = sort { $a <=> $b } @a;
 $$r = "z";
 is ("@a", "3 4 5", "RT #128340");
-}
 
-# in-place sorting of weak references
-SKIP: {
-skip_if_miniperl("no dynamic loading on miniperl, no extension 
Scalar::Util", 1);
-require Scalar::Util;
-my @a = map { \(my $dummy = $_) } qw(c a d b);
-my $r = $a[1];
-Scalar::Util::weaken($a[1]);
-@a = sort { $$a cmp $$b } @a;
-undef $r;
-ok defined $a[0] && ${$a[0]} eq 'a', "in-place sort strengthens weak 
references";
 }
 
 # Test optimisations of reversed sorts. As we now guarantee stability by

-- 
Perl5 Master Repository