In perl.git, the branch maint-5.26 has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/d05b59d55be3b732cdd217d2384f24339112df3b?hp=a27a54a85e64b3cc63a68bfbaa117bbb3803c908>
- Log -----------------------------------------------------------------
commit d05b59d55be3b732cdd217d2384f24339112df3b
Author: reneeb <i...@perl-services.de>
Date: Tue Feb 20 20:32:06 2018 +0100
update checkAUTHORS
(cherry picked from commit 8f6628e3029399ac1e48dfcb59c3cd30e5127c3e)
commit 7b86aed2b751355de4d811ef73c8edec03b15fbb
Author: Tony Cook <t...@develop-help.com>
Date: Thu Aug 24 15:52:33 2017 +1000
(perl #131954) don't initialize mark before a possible move of the stack
(cherry picked from commit 57bd660029d94312ca4eb88993889d981f41b484)
commit ab5bbd91192c7f049cd8031831ed308f58dd79ee
Author: Karl Williamson <k...@cpan.org>
Date: Mon Dec 18 19:03:26 2017 -0700
perldiag: Fix obsolete text
Since 5.26.0, code points must fit in a signed integer, not unsigned.
This commit should be considered for backporting to a future 5.26.x
release
(cherry picked from commit 0202c428e2e1febe76c0cfbb1a64a76cd3f6f756)
commit 5c6dacbd286b19b42a2cafabaa5a078e3a00d761
Author: Karl Williamson <k...@cpan.org>
Date: Fri Mar 2 19:50:38 2018 +0000
Unicode::UCD: max code point is now IV_MAX
Return the correct value when asked.
(cherry picked from commit b2cd5cb1d8b3c8a7a7f033784d5134d2fbd8cad8)
commit 1c9c8a80d4895a019fcbfb854a347afdca85cd80
Author: Yves Orton <demer...@gmail.com>
Date: Sun Feb 25 14:29:03 2018 +0100
if an SV IsCOW_shared_hash then we can assume it has a null at the end
(cherry picked from commit f1d945b85ac2d18ddd1ed2e1d4f72011246d905a)
commit 5a5ca318130c4cf6f4c8c363efd8e194a665f981
Author: Yves Orton <demer...@gmail.com>
Date: Fri Mar 2 19:42:20 2018 +0000
add a svleak.t test for RT #132892
This tests the change applied in
910a6a8be166fb3780dcd2520e3526e537383ef2
I tested that when that commit is reverted this test fails,
and when it is in place it does not.
(cherry picked from commit 06f26dc89ebc43d50835aaecc477ec160a5a5835)
commit b905b8ef06584ae6a8db871d446e8b2cfda4dc4f
Author: Yves Orton <demer...@gmail.com>
Date: Fri Feb 23 04:13:49 2018 +0100
perl #132892: avoid leak by mortalizing temporary copy of pattern
(cherry picked from commit 910a6a8be166fb3780dcd2520e3526e537383ef2)
commit 72fae23930e992d44fd0e3695b517e1f45ad8260
Author: Zefram <zef...@fysh.org>
Date: Fri Mar 2 19:32:42 2018 +0000
properly check readpipe()'s argument list
readpipe() wasn't applying context to its argument list, resulting in
readpipe()'s context leaking in, and broken stack discipline when a list
expression was used. Fixes [perl #4574].
(cherry picked from commit 397baf232086e0a9ad6f881a9614d3dbaea853fc)
commit 2f3749f70f4382388eeaaf05b2c9a5cf0971c8b7
Author: reneeb <i...@perl-services.de>
Date: Fri Mar 2 19:22:17 2018 +0000
update Module::CoreList for v5.27.9
(manually cherry picked from commit
9862549e18ce884c834a61a7eeed90e9a10412f8)
commit 5f0c4b3403298d70986b99d4136c53f039eae8a5
Author: reneeb <i...@perl-services.de>
Date: Tue Feb 20 22:23:18 2018 +0100
Update epigraph.pod
(cherry picked from commit e60142ac4ee7a9ea05f15c3467311c25d3a80fc6)
commit 67ed89e5f3afd5cda51fd737a32e826c3d31b780
Author: reneeb <i...@perl-services.de>
Date: Tue Feb 20 19:23:23 2018 +0100
add new release to perlhist
(cherry picked from commit 987cf6a02ef79898831f1294a6fe97c5884cfa5a)
commit 2d389a1a7aa5636824e716a9ad46f76d3a35aad7
Author: reneeb <i...@perl-services.de>
Date: Tue Feb 20 22:24:23 2018 +0100
Tick release in release schedule
(cherry picked from commit 782b064f740988379881535c77192abf9b36a326)
-----------------------------------------------------------------------
Summary of changes:
Porting/checkAUTHORS.pl | 1 +
Porting/epigraphs.pod | 23 +++++
Porting/release_schedule.pod | 2 +-
charclass_invlists.h | 2 +-
dist/Module-CoreList/lib/Module/CoreList.pm | 139 +++++++++++++++++++++++++++-
lib/Unicode/UCD.pm | 12 +--
lib/Unicode/UCD.t | 8 ++
op.c | 1 +
pod/perldiag.pod | 2 +-
pod/perlhist.pod | 1 +
pp.c | 4 +-
regcharclass.h | 2 +-
regcomp.c | 6 +-
t/op/exec.t | 27 +++++-
t/op/list.t | 42 ++++++++-
t/op/svleak.t | 8 +-
16 files changed, 258 insertions(+), 22 deletions(-)
diff --git a/Porting/checkAUTHORS.pl b/Porting/checkAUTHORS.pl
index 9ee55f7724..3992687832 100755
--- a/Porting/checkAUTHORS.pl
+++ b/Porting/checkAUTHORS.pl
@@ -835,6 +835,7 @@ mod...@renee-baecker.de
renee.baecker\100smart-websolutions.de
+ otrs\100ubuntu.(none)
+ perl\100renee-baecker.de
+ reb\100perl-services.de
++ info\100perl-services.de
richard.foley\100rfi.net richard.foley\100t-online.de
+ richard.foley\100ubs.com
+ richard.foley\100ubsw.com
diff --git a/Porting/epigraphs.pod b/Porting/epigraphs.pod
index 0265383570..094ea54eba 100644
--- a/Porting/epigraphs.pod
+++ b/Porting/epigraphs.pod
@@ -17,6 +17,29 @@ Consult your favorite dictionary for details.
=head1 EPIGRAPHS
+=head2 v5.27.9 - Agatha Christie, "The Mysterious Affair at Styles"
+
+L<Announced on 2018-02-20 by Renee
Bäcker|https://www.nntp.perl.org/group/perl.perl5.porters/2018/02/msg249549.html>
+
+ Poirot was an extraordinary looking little man. He was hardly more
+ than five feet, four inches, but carried himself with great dignity.
+ His head was exactly the shape of an egg, and he always perched it
+ a little on one side. His moustache was very stiff and military.
+ The neatness of his attire was almost incredible. I believe a
+ speck of dust would have caused him more pain than a bullet wound.
+ Yet this quaint dandified little man who, I was sorry to see, now
+ limped badly, had been in his time one of the most celebrated members
+ of the Belgian police. As a detective, his flair had been extraordinary,
+ and he had achieved triumphs by unravelling some of the most baffling
+ cases of the day.
+ He pointed out to me the little house inhabited by him and his fellow
+ Belgians, and I promised to go and see him at an early date. Then he
+ raised his hat with a flourish to Cynthia, and we drove away.
+ "He's a dear little man," said Cynthia. "I'd no idea you knew him."
+ "You've been entertaining a celebrity unawares," I replied.
+ And, for the rest of the way home, I recited to them the various
+ exploits and triumphs of Hercule Poirot.
+
=head2 v5.27.8 - Jasper Fforde, "Shades of Grey"
L<Announced on 2018-01-20 by
Abigail|http://nntp.perl.org/group/perl.perl5.porters/248914>
diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod
index 6cdb10aaa9..a2216ce7ce 100644
--- a/Porting/release_schedule.pod
+++ b/Porting/release_schedule.pod
@@ -68,7 +68,7 @@ you should reset the version numbers to the next blead series.
2017-11-20 5.27.6 ✓ Karen Etheridge
2017-12-20 5.27.7 ✓ BinGOs
2018-01-20 5.27.8 ✓ Abigail
- 2018-02-20 5.27.9 Renee Backer
+ 2018-02-20 5.27.9 ✓ Renee Bäcker
2018-03-20 5.27.10 Todd Rinaldo
(RC0 for 5.28.0 will be released once we think that all the blockers have been
diff --git a/charclass_invlists.h b/charclass_invlists.h
index 7b5b7eae1c..6d476d35c8 100644
--- a/charclass_invlists.h
+++ b/charclass_invlists.h
@@ -95364,7 +95364,7 @@ static const U8 WB_table[24][24] = {
#endif /* defined(PERL_IN_REGEXEC_C) */
/* Generated from:
- * 59e717586b720a821ee0d7397679d5322e38b49f6fb7840545aedf669c733b70
lib/Unicode/UCD.pm
+ * 3d90f60be77f44dea803ca765001cbcbe92d7e0044c7ebbbd120893410ce7bd7
lib/Unicode/UCD.pm
* 47cb62a53beea6d0263e2147331c7e751853c9327225d95bbe2d9e1dc3e1aa44
lib/unicore/ArabicShaping.txt
* 153f0a100c315f9f3945e78f57137611d36c44b3a975919c499fd403413fede8
lib/unicore/BidiBrackets.txt
* fbe806975c1bf9fc9960bbaa39ff6290c42c7da8315f9cd459109b024cc1c485
lib/unicore/BidiMirroring.txt
diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm
b/dist/Module-CoreList/lib/Module/CoreList.pm
index c3bba39d61..3504d1c883 100644
--- a/dist/Module-CoreList/lib/Module/CoreList.pm
+++ b/dist/Module-CoreList/lib/Module/CoreList.pm
@@ -15026,12 +15026,149 @@ for my $version ( sort { $a <=> $b } keys %released
) {
delta_from => 5.027008,
changed => {
'B::Op_private' => '5.027009',
+ 'Carp' => '1.46',
+ 'Carp::Heavy' => '1.46',
'Config' => '5.027009',
+ 'Cwd' => '3.74',
+ 'Devel::PPPort' => '3.39',
+ 'Encode' => '2.96',
+ 'Encode::Unicode' => '2.17',
+ 'Errno' => '1.29',
+ 'ExtUtils::Command' => '7.32',
+ 'ExtUtils::Command::MM' => '7.32',
+ 'ExtUtils::Liblist' => '7.32',
+ 'ExtUtils::Liblist::Kid'=> '7.32',
+ 'ExtUtils::MM' => '7.32',
+ 'ExtUtils::MM_AIX' => '7.32',
+ 'ExtUtils::MM_Any' => '7.32',
+ 'ExtUtils::MM_BeOS' => '7.32',
+ 'ExtUtils::MM_Cygwin' => '7.32',
+ 'ExtUtils::MM_DOS' => '7.32',
+ 'ExtUtils::MM_Darwin' => '7.32',
+ 'ExtUtils::MM_MacOS' => '7.32',
+ 'ExtUtils::MM_NW5' => '7.32',
+ 'ExtUtils::MM_OS2' => '7.32',
+ 'ExtUtils::MM_QNX' => '7.32',
+ 'ExtUtils::MM_UWIN' => '7.32',
+ 'ExtUtils::MM_Unix' => '7.32',
+ 'ExtUtils::MM_VMS' => '7.32',
+ 'ExtUtils::MM_VOS' => '7.32',
+ 'ExtUtils::MM_Win32' => '7.32',
+ 'ExtUtils::MM_Win95' => '7.32',
+ 'ExtUtils::MY' => '7.32',
+ 'ExtUtils::MakeMaker' => '7.32',
+ 'ExtUtils::MakeMaker::Config'=> '7.32',
+ 'ExtUtils::MakeMaker::Locale'=> '7.32',
+ 'ExtUtils::MakeMaker::version'=> '7.32',
+ 'ExtUtils::MakeMaker::version::regex'=> '7.32',
+ 'ExtUtils::Mkbootstrap' => '7.32',
+ 'ExtUtils::Mksymlists' => '7.32',
+ 'ExtUtils::ParseXS' => '3.38',
+ 'ExtUtils::ParseXS::Constants'=> '3.38',
+ 'ExtUtils::ParseXS::CountLines'=> '3.38',
+ 'ExtUtils::ParseXS::Eval'=> '3.38',
+ 'ExtUtils::ParseXS::Utilities'=> '3.38',
+ 'ExtUtils::Typemaps' => '3.38',
+ 'ExtUtils::Typemaps::Cmd'=> '3.38',
+ 'ExtUtils::Typemaps::InputMap'=> '3.38',
+ 'ExtUtils::Typemaps::OutputMap'=> '3.38',
+ 'ExtUtils::Typemaps::Type'=> '3.38',
+ 'ExtUtils::testlib' => '7.32',
+ 'File::Spec' => '3.74',
+ 'File::Spec::AmigaOS' => '3.74',
+ 'File::Spec::Cygwin' => '3.74',
+ 'File::Spec::Epoc' => '3.74',
+ 'File::Spec::Functions' => '3.74',
+ 'File::Spec::Mac' => '3.74',
+ 'File::Spec::OS2' => '3.74',
+ 'File::Spec::Unix' => '3.74',
+ 'File::Spec::VMS' => '3.74',
+ 'File::Spec::Win32' => '3.74',
+ 'IPC::Cmd' => '1.00',
+ 'Math::BigFloat::Trace' => '0.49',
+ 'Math::BigInt::Trace' => '0.49',
'Module::CoreList' => '5.20180220',
- 'Module::CoreList::TieHashDelta'=> '5.20180220',
'Module::CoreList::Utils'=> '5.20180220',
+ 'POSIX' => '1.82',
+ 'PerlIO::encoding' => '0.26',
+ 'Storable' => '3.06',
+ 'Storable::Limit' => undef,
+ 'Storable::__Storable__'=> '3.06',
+ 'Test2' => '1.302122',
+ 'Test2::API' => '1.302122',
+ 'Test2::API::Breakage' => '1.302122',
+ 'Test2::API::Context' => '1.302122',
+ 'Test2::API::Instance' => '1.302122',
+ 'Test2::API::Stack' => '1.302122',
+ 'Test2::Event' => '1.302122',
+ 'Test2::Event::Bail' => '1.302122',
+ 'Test2::Event::Diag' => '1.302122',
+ 'Test2::Event::Encoding'=> '1.302122',
+ 'Test2::Event::Exception'=> '1.302122',
+ 'Test2::Event::Fail' => '1.302122',
+ 'Test2::Event::Generic' => '1.302122',
+ 'Test2::Event::Note' => '1.302122',
+ 'Test2::Event::Ok' => '1.302122',
+ 'Test2::Event::Pass' => '1.302122',
+ 'Test2::Event::Plan' => '1.302122',
+ 'Test2::Event::Skip' => '1.302122',
+ 'Test2::Event::Subtest' => '1.302122',
+ 'Test2::Event::TAP::Version'=> '1.302122',
+ 'Test2::Event::Waiting' => '1.302122',
+ 'Test2::EventFacet' => '1.302122',
+ 'Test2::EventFacet::About'=> '1.302122',
+ 'Test2::EventFacet::Amnesty'=> '1.302122',
+ 'Test2::EventFacet::Assert'=> '1.302122',
+ 'Test2::EventFacet::Control'=> '1.302122',
+ 'Test2::EventFacet::Error'=> '1.302122',
+ 'Test2::EventFacet::Info'=> '1.302122',
+ 'Test2::EventFacet::Meta'=> '1.302122',
+ 'Test2::EventFacet::Parent'=> '1.302122',
+ 'Test2::EventFacet::Plan'=> '1.302122',
+ 'Test2::EventFacet::Render'=> '1.302122',
+ 'Test2::EventFacet::Trace'=> '1.302122',
+ 'Test2::Formatter' => '1.302122',
+ 'Test2::Formatter::TAP' => '1.302122',
+ 'Test2::Hub' => '1.302122',
+ 'Test2::Hub::Interceptor'=> '1.302122',
+ 'Test2::Hub::Interceptor::Terminator'=> '1.302122',
+ 'Test2::Hub::Subtest' => '1.302122',
+ 'Test2::IPC' => '1.302122',
+ 'Test2::IPC::Driver' => '1.302122',
+ 'Test2::IPC::Driver::Files'=> '1.302122',
+ 'Test2::Tools::Tiny' => '1.302122',
+ 'Test2::Util' => '1.302122',
+ 'Test2::Util::ExternalMeta'=> '1.302122',
+ 'Test2::Util::Facets2Legacy'=> '1.302122',
+ 'Test2::Util::HashBase' => '1.302122',
+ 'Test2::Util::Trace' => '1.302122',
+ 'Test::Builder' => '1.302122',
+ 'Test::Builder::Formatter'=> '1.302122',
+ 'Test::Builder::Module' => '1.302122',
+ 'Test::Builder::Tester' => '1.302122',
+ 'Test::Builder::Tester::Color'=> '1.302122',
+ 'Test::Builder::TodoDiag'=> '1.302122',
+ 'Test::More' => '1.302122',
+ 'Test::Simple' => '1.302122',
+ 'Test::Tester' => '1.302122',
+ 'Test::Tester::Capture' => '1.302122',
+ 'Test::Tester::CaptureRunner'=> '1.302122',
+ 'Test::Tester::Delegate'=> '1.302122',
+ 'Test::use::ok' => '1.302122',
+ 'Time::HiRes' => '1.9753',
+ 'XS::APItest' => '0.96',
+ 'bigint' => '0.49',
+ 'bignum' => '0.49',
+ 'bigrat' => '0.49',
+ 'encoding' => '2.22',
+ 'if' => '0.0608',
+ 'mro' => '1.22',
+ 'ok' => '1.302122',
+ 'threads' => '2.22',
+ 'warnings' => '1.41',
},
removed => {
+ 'Module::CoreList::TieHashDelta'=> 1,
}
},
5.026002 => {
diff --git a/lib/Unicode/UCD.pm b/lib/Unicode/UCD.pm
index 4939677fcc..42d376eff6 100644
--- a/lib/Unicode/UCD.pm
+++ b/lib/Unicode/UCD.pm
@@ -5,7 +5,7 @@ use warnings;
no warnings 'surrogate'; # surrogates can be inputs to this
use charnames ();
-our $VERSION = '0.68';
+our $VERSION = '0.69';
require Exporter;
@@ -2444,8 +2444,8 @@ sub prop_value_aliases ($$) {
return ( $list_ref->[0], $list_ref->[0] );
}
-# All 1 bits is the largest possible UV.
-$Unicode::UCD::MAX_CP = ~0;
+# All 1 bits but the top one is the largest possible IV.
+$Unicode::UCD::MAX_CP = (~0) >> 1;
=pod
@@ -2537,11 +2537,7 @@ code points that have the property-value:
for (my $i = 0; $i < @invlist; $i += 2) {
my $upper = ($i + 1) < @invlist
? $invlist[$i+1] - 1 # In range
- : $Unicode::UCD::MAX_CP; # To infinity. You may want
- # to stop much much earlier;
- # going this high may expose
- # perl deficiencies with very
- # large numbers.
+ : $Unicode::UCD::MAX_CP; # To infinity.
for my $j ($invlist[$i] .. $upper) {
push @full_list, $j;
}
diff --git a/lib/Unicode/UCD.t b/lib/Unicode/UCD.t
index a7bb666483..424f736f0d 100644
--- a/lib/Unicode/UCD.t
+++ b/lib/Unicode/UCD.t
@@ -2700,4 +2700,12 @@ if (! ok(@warnings == 0, "No warnings were generated")) {
diag(join "\n", "The warnings are:", @warnings);
}
+# And make sure that the max code point returned actually fits in an IV, which
+# currently range iterators are.
+my $count = 0;
+for my $i ($Unicode::UCD::MAX_CP - 1 .. $Unicode::UCD::MAX_CP) {
+ $count++;
+}
+is($count, 2, "MAX_CP isn't too large");
+
done_testing();
diff --git a/op.c b/op.c
index 1517fa73b6..3e2e712b46 100644
--- a/op.c
+++ b/op.c
@@ -9610,6 +9610,7 @@ Perl_ck_backtick(pTHX_ OP *o)
OP *newop = NULL;
OP *sibl;
PERL_ARGS_ASSERT_CK_BACKTICK;
+ o = ck_fun(o);
/* qx and `` have a null pushmark; CORE::readpipe has only one kid. */
if (o->op_flags & OPf_KIDS && (sibl = OpSIBLING(cUNOPo->op_first))
&& (gv = gv_override("readpipe",8)))
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 730010a882..106fe41121 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -3473,7 +3473,7 @@ not be portable
(S non_unicode) Perl allows strings to contain a superset of
Unicode code points; each code point may be as large as what is storable
-in an unsigned integer on your system, but these may not be accepted by
+in a signed integer on your system, but these may not be accepted by
other languages/systems. This message occurs when you matched a string
containing such a code point against a regular expression pattern, and
the code point was matched against a Unicode property, C<\p{...}> or
diff --git a/pod/perlhist.pod b/pod/perlhist.pod
index bf32694b7a..d6b4344720 100644
--- a/pod/perlhist.pod
+++ b/pod/perlhist.pod
@@ -634,6 +634,7 @@ the strings?).
Ether 5.27.6 2017-Nov-20
BinGOs 5.27.7 2017-Dec-20
Abigail 5.27.8 2018-Jan-20
+ Renee 5.27.9 2018-Feb-20
=head2 SELECTED RELEASE SIZES
diff --git a/pp.c b/pp.c
index 1f7e03599f..1d09a1ff48 100644
--- a/pp.c
+++ b/pp.c
@@ -5186,9 +5186,11 @@ PP(pp_list)
{
I32 markidx = POPMARK;
if (GIMME_V != G_ARRAY) {
- SV **mark = PL_stack_base + markidx;
+ /* don't initialize mark here, EXTEND() may move the stack */
+ SV **mark;
dSP;
EXTEND(SP, 1); /* in case no arguments, as in @empty */
+ mark = PL_stack_base + markidx;
if (++MARK <= SP)
*MARK = *SP; /* unwanted list, return last item */
else
diff --git a/regcharclass.h b/regcharclass.h
index 273176af22..cde4f1e039 100644
--- a/regcharclass.h
+++ b/regcharclass.h
@@ -1854,7 +1854,7 @@
#endif /* H_REGCHARCLASS */
/* Generated from:
- * 59e717586b720a821ee0d7397679d5322e38b49f6fb7840545aedf669c733b70
lib/Unicode/UCD.pm
+ * 3d90f60be77f44dea803ca765001cbcbe92d7e0044c7ebbbd120893410ce7bd7
lib/Unicode/UCD.pm
* 47cb62a53beea6d0263e2147331c7e751853c9327225d95bbe2d9e1dc3e1aa44
lib/unicore/ArabicShaping.txt
* 153f0a100c315f9f3945e78f57137611d36c44b3a975919c499fd403413fede8
lib/unicore/BidiBrackets.txt
* fbe806975c1bf9fc9960bbaa39ff6290c42c7da8315f9cd459109b024cc1c485
lib/unicore/BidiMirroring.txt
diff --git a/regcomp.c b/regcomp.c
index b2de7f05e1..d0d08352c0 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -6389,13 +6389,13 @@ S_concat_pat(pTHX_ RExC_state_t * const pRExC_state,
* it is properly null terminated or we will fail asserts
* later. In theory we probably shouldn't get such SV's,
* but if we do we should handle it gracefully. */
- if ( SvTYPE(msv) != SVt_PV || (SvLEN(msv) > SvCUR(msv) &&
*(SvEND(msv)) == 0) ) {
+ if ( SvTYPE(msv) != SVt_PV || (SvLEN(msv) > SvCUR(msv) &&
*(SvEND(msv)) == 0) || SvIsCOW_shared_hash(msv) ) {
/* not a string, or a string with a trailing null */
pat = msv;
} else {
/* a string with no trailing null, we need to copy it
- * so it we have a trailing null */
- pat = newSVsv(msv);
+ * so it has a trailing null */
+ pat = sv_2mortal(newSVsv(msv));
}
}
diff --git a/t/op/exec.t b/t/op/exec.t
index 11554395b9..237388bd91 100644
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -36,7 +36,7 @@ $ENV{LANGUAGE} = 'C'; # Ditto in GNU.
my $Is_VMS = $^O eq 'VMS';
my $Is_Win32 = $^O eq 'MSWin32';
-plan(tests => 25);
+plan(tests => 34);
my $Perl = which_perl();
@@ -128,8 +128,29 @@ is( <<~`END`, "ok\n", '<<~`HEREDOC`'
);
END
{
- local $_ = qq($Perl -le "print 'ok'");
- is( readpipe, "ok\n", 'readpipe default argument' );
+ sub rpecho { qq($Perl -le "print '$_[0]'") }
+ is scalar(readpipe(rpecho("b"))), "b\n",
+ "readpipe with one argument in scalar context";
+ is join(",", "a", readpipe(rpecho("b")), "c"), "a,b\n,c",
+ "readpipe with one argument in list context";
+ local $_ = rpecho("f");
+ is scalar(readpipe), "f\n",
+ "readpipe default argument in scalar context";
+ is join(",", "a", readpipe, "c"), "a,f\n,c",
+ "readpipe default argument in list context";
+ sub rpechocxt {
+ rpecho(wantarray ? "list" : defined(wantarray) ? "scalar" : "void");
+ }
+ is scalar(readpipe(rpechocxt())), "scalar\n",
+ "readpipe argument context in scalar context";
+ is join(",", "a", readpipe(rpechocxt()), "b"), "a,scalar\n,b",
+ "readpipe argument context in list context";
+ foreach my $args ("(\$::p,\$::q)", "((\$::p,\$::q))") {
+ foreach my $lvalue ("my \$r", "my \@r") {
+ eval("$lvalue = readpipe$args if 0");
+ like $@, qr/\AToo many arguments for /;
+ }
+ }
}
package o {
diff --git a/t/op/list.t b/t/op/list.t
index 3f9487b96f..2acb03a321 100644
--- a/t/op/list.t
+++ b/t/op/list.t
@@ -6,7 +6,7 @@ BEGIN {
set_up_inc(qw(. ../lib));
}
-plan( tests => 71 );
+plan( tests => 72 );
@foo = (1, 2, 3, 4);
cmp_ok($foo[0], '==', 1, 'first elem');
@@ -228,3 +228,43 @@ ok(($0[()[()]],1), "[perl #126193] list slice with zero
indexes");
@x;
pass('no panic'); # panics only under DEBUGGING
}
+
+fresh_perl_is(<<'EOS', "", {}, "[perl #131954] heap use after free in
pp_list");
+#!./perl
+BEGIN {
+my $bar = "bar";
+
+sub test_no_error {
+ eval $_[0];
+}
+
+test_no_error($_) for split /\n/,
+q[ x
+ definfoo, $bar;
+ x
+ x
+ x
+ grep((not $bar, $bar, $bar), $bar);
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ ];
+}
+EOS
diff --git a/t/op/svleak.t b/t/op/svleak.t
index e4e881d11c..cd502dcf00 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
use Config;
-plan tests => 141;
+plan tests => 142;
# run some code N times. If the number of SVs at the end of loop N is
# greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -593,3 +593,9 @@ EOF
}
::leak(2, 0, \&named, "Perl_reg_named_buff_fetch() on no-name RE");
}
+
+{
+ my %rh= ( qr/^foo/ => 1);
+ sub Regex_Key_Leak { my ($r)= keys %rh; "foo"=~$r; }
+ leak 2, 0, \&Regex_Key_Leak,"RT #132892 - regex patterns should not leak";
+}
--
Perl5 Master Repository
