Compare commits
52 Commits
Author | SHA1 | Date |
---|---|---|
Yaakov Selkowitz | a287727639 | |
Jitka Plesnikova | 917c041e8e | |
Jitka Plesnikova | dee564d443 | |
Fedora Release Engineering | 7f6cc3daf9 | |
Jitka Plesnikova | 9fc99617aa | |
Jitka Plesnikova | 5793c6513a | |
Petr Písař | 745f3da90d | |
Jitka Plesnikova | 27c8969138 | |
Jitka Plesnikova | 19e3e78be7 | |
Fedora Release Engineering | 0a27b0717e | |
Florian Weimer | f509e07f88 | |
Jitka Plesnikova | 0a669179f7 | |
Jitka Plesnikova | 6004999de2 | |
Jitka Plesnikova | 1ff223c740 | |
Fedora Release Engineering | be2b9c584d | |
Jitka Plesnikova | e139ada695 | |
Jitka Plesnikova | b2be526c62 | |
Jitka Plesnikova | d1c1ebf4da | |
Jitka Plesnikova | 8a058d72b1 | |
Michal Josef Špaček | 024eae9d94 | |
Michal Josef Špaček | f51ea6d1da | |
Jitka Plesnikova | abb08767a7 | |
Jitka Plesnikova | 4751b01e52 | |
Jitka Plesnikova | 793124ca9e | |
Fedora Release Engineering | a471b953f4 | |
Petr Písař | 551de2548e | |
Fedora Release Engineering | 1a70288d2e | |
Petr Písař | 50dc9d5a0f | |
Jitka Plesnikova | c422acbc80 | |
Jitka Plesnikova | 56c2cb6399 | |
Jitka Plesnikova | f91f2971b5 | |
Jitka Plesnikova | be48db0106 | |
Jitka Plesnikova | d1468a76dd | |
Petr Písař | 52e852fe4f | |
Petr Písař | d4be40cd41 | |
Petr Písař | 5d5818adb5 | |
Jitka Plesnikova | 969ecdace2 | |
Jitka Plesnikova | 6b6d673d59 | |
Jitka Plesnikova | c61591b4f1 | |
Petr Písař | a55ccccced | |
Petr Písař | c43a56bb9c | |
Petr Písař | 622440427f | |
Petr Písař | 4f72402355 | |
Petr Písař | 316f16da49 | |
Petr Písař | 8355c1611d | |
Petr Písař | a12f1b7585 | |
Petr Písař | 9efe548119 | |
Petr Písař | 27a18537fa | |
Petr Písař | c38e1c6cd8 | |
Fedora Release Engineering | 9260824722 | |
Jitka Plesnikova | bfabef3880 | |
Jitka Plesnikova | c0ce9f4aa6 |
|
@ -35,3 +35,9 @@ perl-5.12.1.tar.gz
|
|||
/perl-5.30.2.tar.xz
|
||||
/perl-5.30.3.tar.xz
|
||||
/perl-5.32.0.tar.xz
|
||||
/perl-5.32.1.tar.xz
|
||||
/perl-5.34.0.tar.xz
|
||||
/perl-5.34.1.tar.xz
|
||||
/perl-5.36.0.tar.xz
|
||||
/perl-5.36.1.tar.xz
|
||||
/perl-5.38.0.tar.xz
|
||||
|
|
4
diffrpms
4
diffrpms
|
@ -22,8 +22,8 @@ function process_dir() {
|
|||
if [ ! -e "$OLD_RPM" ]; then echo "+ Package ${F}"; continue; fi
|
||||
if [ ! -e "$NEW_RPM" ]; then echo "- Package ${F}"; continue; fi
|
||||
|
||||
DIFF=$(rpmdiff -i S -i 5 -i T "$OLD_RPM" "$NEW_RPM" | \
|
||||
grep -vE 'REQUIRES perl = | REQUIRES rpmlib\(' )
|
||||
DIFF=$(rpmdiff "$OLD_RPM" "$NEW_RPM" -i S 5 T | \
|
||||
grep -vE 'REQUIRES perl = | REQUIRES rpmlib\(|build-id' )
|
||||
|
||||
test -n "$DIFF" && printf '* %s:\n%s\n' "$F" "$DIFF"
|
||||
done
|
||||
|
|
1151
gendep.macros
1151
gendep.macros
File diff suppressed because it is too large
Load Diff
|
@ -1,12 +1,12 @@
|
|||
diff -up perl-5.10.0/Configure.didi perl-5.10.0/Configure
|
||||
--- perl-5.10.0/Configure.didi 2007-12-18 11:47:07.000000000 +0100
|
||||
+++ perl-5.10.0/Configure 2008-07-21 10:51:16.000000000 +0200
|
||||
@@ -1483,7 +1483,7 @@ archname=''
|
||||
@@ -1510,7 +1510,7 @@ archname=''
|
||||
usereentrant='undef'
|
||||
: List of libraries we want.
|
||||
: If anyone needs extra -lxxx, put those in a hint file.
|
||||
-libswanted="cl pthread socket bind inet nsl ndbm gdbm dbm db malloc dl ld"
|
||||
+libswanted="cl pthread socket resolv inet nsl ndbm gdbm dbm db malloc dl ld"
|
||||
-libswanted="cl pthread socket bind inet ndbm gdbm dbm db malloc dl ld"
|
||||
+libswanted="cl pthread socket resolv inet ndbm gdbm dbm db malloc dl ld"
|
||||
libswanted="$libswanted sun m crypt sec util c cposix posix ucb bsd BSD"
|
||||
: We probably want to search /usr/shlib before most other libraries.
|
||||
: This is only used by the lib/ExtUtils/MakeMaker.pm routine extliblist.
|
||||
|
|
|
@ -1,14 +1,18 @@
|
|||
diff -up perl-5.14.1/cpan/File-Temp/t/fork.t.off perl-5.14.1/cpan/File-Temp/t/fork.t
|
||||
--- perl-5.14.1/cpan/File-Temp/t/fork.t.off 2011-04-13 13:36:34.000000000 +0200
|
||||
+++ perl-5.14.1/cpan/File-Temp/t/fork.t 2011-06-20 10:29:31.536282611 +0200
|
||||
@@ -12,12 +12,8 @@ BEGIN {
|
||||
diff -up perl-5.33.9/cpan/File-Temp/t/fork.t.orig perl-5.33.9/cpan/File-Temp/t/fork.t
|
||||
--- perl-5.33.9/cpan/File-Temp/t/fork.t.orig 2021-04-22 16:24:11.736220616 +0200
|
||||
+++ perl-5.33.9/cpan/File-Temp/t/fork.t 2021-04-22 16:26:31.466593123 +0200
|
||||
@@ -12,16 +12,8 @@ BEGIN {
|
||||
$Config::Config{useithreads} and
|
||||
$Config::Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
|
||||
);
|
||||
- if ( $can_fork ) {
|
||||
- if ( $can_fork && !(($^O eq 'MSWin32') && $Devel::Cover::VERSION) ) {
|
||||
- print "1..8\n";
|
||||
- } else {
|
||||
- print "1..0 # Skip No fork available\n";
|
||||
- if ( ($^O eq 'MSWin32') && $Devel::Cover::VERSION ) {
|
||||
- print "1..0 # Skip Devel::Cover coverage testing is incompatible with fork under 'MSWin32'\n";
|
||||
- } else {
|
||||
- print "1..0 # Skip No fork available\n";
|
||||
- }
|
||||
+ print "1..0 # Skip Koji doesn't work with Perl fork tests\n";
|
||||
exit;
|
||||
- }
|
||||
|
|
|
@ -20,14 +20,14 @@ diff --git a/MANIFEST b/MANIFEST
|
|||
index 397252a..d7c519b 100644
|
||||
--- a/MANIFEST
|
||||
+++ b/MANIFEST
|
||||
@@ -3424,6 +3424,7 @@ dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm CBuilder methods fo
|
||||
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/cygwin.pm CBuilder methods for cygwin
|
||||
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/darwin.pm CBuilder methods for darwin
|
||||
@@ -3886,6 +3886,7 @@ dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm CBuilder methods fo
|
||||
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/cygwin.pm CBuilder methods for cygwin
|
||||
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/darwin.pm CBuilder methods for darwin
|
||||
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/dec_osf.pm CBuilder methods for OSF
|
||||
+dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm CBuilder methods for Linux
|
||||
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/os2.pm CBuilder methods for OS/2
|
||||
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Unix.pm CBuilder methods for Unix
|
||||
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm CBuilder methods for VMS
|
||||
+dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm CBuilder methods for Linux
|
||||
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/os2.pm CBuilder methods for OS/2
|
||||
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Unix.pm CBuilder methods for Unix
|
||||
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm CBuilder methods for VMS
|
||||
diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm
|
||||
new file mode 100644
|
||||
index 0000000..e3251c4
|
||||
|
|
|
@ -14,7 +14,7 @@ diff --git a/Makefile.SH b/Makefile.SH
|
|||
index d1da0a0..7733a32 100755
|
||||
--- a/Makefile.SH
|
||||
+++ b/Makefile.SH
|
||||
@@ -70,11 +70,11 @@ true)
|
||||
@@ -64,11 +64,11 @@ true)
|
||||
${revision}.${patchlevel}.${subversion}"
|
||||
case "$osvers" in
|
||||
1[5-9]*|[2-9]*)
|
||||
|
@ -28,7 +28,7 @@ index d1da0a0..7733a32 100755
|
|||
;;
|
||||
esac
|
||||
;;
|
||||
@@ -76,13 +76,15 @@ true)
|
||||
@@ -78,13 +78,15 @@ true)
|
||||
;;
|
||||
sunos*)
|
||||
linklibperl="-lperl"
|
||||
|
@ -45,12 +45,12 @@ index d1da0a0..7733a32 100755
|
|||
;;
|
||||
aix*)
|
||||
case "$cc" in
|
||||
@@ -120,6 +122,9 @@ true)
|
||||
linklibperl='libperl.x'
|
||||
DPERL_EXTERNAL_GLOB=''
|
||||
;;
|
||||
@@ -127,6 +129,9 @@ true)
|
||||
;;
|
||||
esac
|
||||
;;
|
||||
+ linux*)
|
||||
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||
+ ;;
|
||||
esac
|
||||
case "$ldlibpthname" in
|
||||
|
|
|
@ -23,14 +23,14 @@ diff --git a/MANIFEST b/MANIFEST
|
|||
index 6af238c..d4f0c56 100644
|
||||
--- a/MANIFEST
|
||||
+++ b/MANIFEST
|
||||
@@ -784,6 +784,7 @@ cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm MakeMaker methods for OS/2
|
||||
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm MakeMaker methods for OS/2
|
||||
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm MakeMaker methods for QNX
|
||||
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm MakeMaker methods for Unix
|
||||
+cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm Independed MM methods
|
||||
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm MakeMaker methods for U/WIN
|
||||
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm MakeMaker methods for VMS
|
||||
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm MakeMaker methods for VOS
|
||||
@@ -1037,6 +1037,7 @@ cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm
|
||||
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm MakeMaker methods for OS 390
|
||||
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm MakeMaker methods for QNX
|
||||
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm MakeMaker methods for Unix
|
||||
+cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm Independed MM methods
|
||||
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm MakeMaker methods for U/WIN
|
||||
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm MakeMaker methods for VMS
|
||||
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm MakeMaker methods for VOS
|
||||
diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm
|
||||
new file mode 100644
|
||||
index 0000000..6bbc0d8
|
||||
|
|
|
@ -1,175 +0,0 @@
|
|||
From bafffe7f2ca587960177ed03216e2d5692fe6143 Mon Sep 17 00:00:00 2001
|
||||
From: Karl Williamson <khw@cpan.org>
|
||||
Date: Wed, 19 Aug 2020 11:57:17 -0600
|
||||
Subject: [PATCH] Add av_count()
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
This returns the number of elements in an array in a clearly named
|
||||
function.
|
||||
|
||||
av_top_index(), av_tindex() are clearly named, but are less than ideal,
|
||||
and came about because no one back then thought of this one, until now
|
||||
Paul Evans did.
|
||||
|
||||
Petr Písař: Port 87306e0674dfe3af29804b4641347cd5ac9b0521 to 5.32.0.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
av.c | 17 ++++++++++++++---
|
||||
av.h | 3 ++-
|
||||
embed.fnc | 3 ++-
|
||||
embed.h | 2 +-
|
||||
inline.h | 16 ++++++++++++----
|
||||
proto.h | 11 ++++++++---
|
||||
6 files changed, 39 insertions(+), 13 deletions(-)
|
||||
|
||||
diff --git a/av.c b/av.c
|
||||
index 27b2f12..b5ddaca 100644
|
||||
--- a/av.c
|
||||
+++ b/av.c
|
||||
@@ -814,9 +814,10 @@ The Perl equivalent for this is C<$#myarray>.
|
||||
=for apidoc av_len
|
||||
|
||||
Same as L</av_top_index>. Note that, unlike what the name implies, it returns
|
||||
-the highest index in the array, so to get the size of the array you need to use
|
||||
-S<C<av_len(av) + 1>>. This is unlike L</sv_len>, which returns what you would
|
||||
-expect.
|
||||
+the highest index in the array. This is unlike L</sv_len>, which returns what
|
||||
+you would expect.
|
||||
+
|
||||
+B<To get the true number of elements in the array, instead use C<L</av_count>>>.
|
||||
|
||||
=cut
|
||||
*/
|
||||
@@ -1089,6 +1090,16 @@ Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
|
||||
return sv;
|
||||
}
|
||||
|
||||
+SSize_t
|
||||
+Perl_av_top_index(pTHX_ AV *av)
|
||||
+{
|
||||
+ PERL_ARGS_ASSERT_AV_TOP_INDEX;
|
||||
+ assert(SvTYPE(av) == SVt_PVAV);
|
||||
+
|
||||
+ return AvFILL(av);
|
||||
+}
|
||||
+
|
||||
+
|
||||
/*
|
||||
* ex: set ts=8 sts=4 sw=4 et:
|
||||
*/
|
||||
diff --git a/av.h b/av.h
|
||||
index 5e39c42..90ebfff 100644
|
||||
--- a/av.h
|
||||
+++ b/av.h
|
||||
@@ -81,7 +81,8 @@ Same as C<av_top_index()>.
|
||||
|
||||
#define AvFILL(av) ((SvRMAGICAL((const SV *) (av))) \
|
||||
? mg_size(MUTABLE_SV(av)) : AvFILLp(av))
|
||||
-#define av_tindex(av) av_top_index(av)
|
||||
+#define av_top_index(av) AvFILL(av)
|
||||
+#define av_tindex(av) av_top_index(av)
|
||||
|
||||
/* Note that it doesn't make sense to do this:
|
||||
* SvGETMAGIC(av); IV x = av_tindex_nomg(av);
|
||||
diff --git a/embed.fnc b/embed.fnc
|
||||
index 589ab1a..789cd3c 100644
|
||||
--- a/embed.fnc
|
||||
+++ b/embed.fnc
|
||||
@@ -541,7 +541,8 @@ Apd |void |av_push |NN AV *av|NN SV *val
|
||||
EXp |void |av_reify |NN AV *av
|
||||
ApdR |SV* |av_shift |NN AV *av
|
||||
Apd |SV** |av_store |NN AV *av|SSize_t key|NULLOK SV *val
|
||||
-AidRp |SSize_t|av_top_index |NN AV *av
|
||||
+AMdRp |SSize_t|av_top_index |NN AV *av
|
||||
+AidRp |Size_t |av_count |NN AV *av
|
||||
AmdR |SSize_t|av_tindex |NN AV *av
|
||||
Apd |void |av_undef |NN AV *av
|
||||
Apdoex |SV** |av_create_and_unshift_one|NN AV **const avp|NN SV *const val
|
||||
diff --git a/embed.h b/embed.h
|
||||
index 182b12a..329ac40 100644
|
||||
--- a/embed.h
|
||||
+++ b/embed.h
|
||||
@@ -48,6 +48,7 @@
|
||||
#define atfork_lock Perl_atfork_lock
|
||||
#define atfork_unlock Perl_atfork_unlock
|
||||
#define av_clear(a) Perl_av_clear(aTHX_ a)
|
||||
+#define av_count(a) Perl_av_count(aTHX_ a)
|
||||
#define av_delete(a,b,c) Perl_av_delete(aTHX_ a,b,c)
|
||||
#define av_exists(a,b) Perl_av_exists(aTHX_ a,b)
|
||||
#define av_extend(a,b) Perl_av_extend(aTHX_ a,b)
|
||||
@@ -59,7 +60,6 @@
|
||||
#define av_push(a,b) Perl_av_push(aTHX_ a,b)
|
||||
#define av_shift(a) Perl_av_shift(aTHX_ a)
|
||||
#define av_store(a,b,c) Perl_av_store(aTHX_ a,b,c)
|
||||
-#define av_top_index(a) Perl_av_top_index(aTHX_ a)
|
||||
#define av_undef(a) Perl_av_undef(aTHX_ a)
|
||||
#define av_unshift(a,b) Perl_av_unshift(aTHX_ a,b)
|
||||
#define block_end(a,b) Perl_block_end(aTHX_ a,b)
|
||||
diff --git a/inline.h b/inline.h
|
||||
index 27005d2..35af18a 100644
|
||||
--- a/inline.h
|
||||
+++ b/inline.h
|
||||
@@ -39,13 +39,21 @@ SOFTWARE.
|
||||
|
||||
/* ------------------------------- av.h ------------------------------- */
|
||||
|
||||
-PERL_STATIC_INLINE SSize_t
|
||||
-Perl_av_top_index(pTHX_ AV *av)
|
||||
+/*
|
||||
+=for apidoc av_count
|
||||
+Returns the number of elements in the array C<av>. This is the true length of
|
||||
+the array, including any undefined elements. It is always the same as
|
||||
+S<C<av_top_index(av) + 1>>.
|
||||
+
|
||||
+=cut
|
||||
+*/
|
||||
+PERL_STATIC_INLINE Size_t
|
||||
+Perl_av_count(pTHX_ AV *av)
|
||||
{
|
||||
- PERL_ARGS_ASSERT_AV_TOP_INDEX;
|
||||
+ PERL_ARGS_ASSERT_AV_COUNT;
|
||||
assert(SvTYPE(av) == SVt_PVAV);
|
||||
|
||||
- return AvFILL(av);
|
||||
+ return AvFILL(av) + 1;
|
||||
}
|
||||
|
||||
/* ------------------------------- cv.h ------------------------------- */
|
||||
diff --git a/proto.h b/proto.h
|
||||
index 02ef4ed..83ba098 100644
|
||||
--- a/proto.h
|
||||
+++ b/proto.h
|
||||
@@ -219,6 +219,13 @@ PERL_CALLCONV SV** Perl_av_arylen_p(pTHX_ AV *av);
|
||||
PERL_CALLCONV void Perl_av_clear(pTHX_ AV *av);
|
||||
#define PERL_ARGS_ASSERT_AV_CLEAR \
|
||||
assert(av)
|
||||
+#ifndef PERL_NO_INLINE_FUNCTIONS
|
||||
+PERL_STATIC_INLINE Size_t Perl_av_count(pTHX_ AV *av)
|
||||
+ __attribute__warn_unused_result__;
|
||||
+#define PERL_ARGS_ASSERT_AV_COUNT \
|
||||
+ assert(av)
|
||||
+#endif
|
||||
+
|
||||
PERL_CALLCONV void Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val);
|
||||
#define PERL_ARGS_ASSERT_AV_CREATE_AND_PUSH \
|
||||
assert(avp); assert(val)
|
||||
@@ -284,12 +291,10 @@ PERL_CALLCONV SV** Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val);
|
||||
__attribute__warn_unused_result__; */
|
||||
#define PERL_ARGS_ASSERT_AV_TINDEX
|
||||
|
||||
-#ifndef PERL_NO_INLINE_FUNCTIONS
|
||||
-PERL_STATIC_INLINE SSize_t Perl_av_top_index(pTHX_ AV *av)
|
||||
+PERL_CALLCONV SSize_t Perl_av_top_index(pTHX_ AV *av)
|
||||
__attribute__warn_unused_result__;
|
||||
#define PERL_ARGS_ASSERT_AV_TOP_INDEX \
|
||||
assert(av)
|
||||
-#endif
|
||||
|
||||
PERL_CALLCONV void Perl_av_undef(pTHX_ AV *av);
|
||||
#define PERL_ARGS_ASSERT_AV_UNDEF \
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,49 +0,0 @@
|
|||
From b0d826f28ae47d22229949e754709e68afe5d83d Mon Sep 17 00:00:00 2001
|
||||
From: raiph <raiph.mellor@gmail.com>
|
||||
Date: Thu, 2 Jul 2020 17:30:07 +0100
|
||||
Subject: [PATCH] Fix 404 and text in New Unicode properties section
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
See https://github.com/Perl/perl5/issues/17881
|
||||
|
||||
I found a 404, and an "old" link. I investigated.
|
||||
|
||||
My conclusion was UC have landed new TR18 and TR39 since text in section
|
||||
New Unicode properties Identifier_Status and Identifier_Type supported
|
||||
was written.
|
||||
|
||||
I've guessed at a suitable update.
|
||||
|
||||
Petr Písař: Ported from e02f7c069a8e7dd98b0ec010e9b3c6619b46baf3
|
||||
upstream commmit.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pod/perldelta.pod | 6 +++---
|
||||
1 file changed, 3 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
|
||||
index b92ea53..bb3d1ef 100644
|
||||
--- a/pod/perldelta.pod
|
||||
+++ b/pod/perldelta.pod
|
||||
@@ -48,12 +48,12 @@ L<perlop/Operator Precedence and Associativity>.
|
||||
|
||||
=head2 New Unicode properties C<Identifier_Status> and C<Identifier_Type> supported
|
||||
|
||||
-Unicode is in the process of revising its regular expression
|
||||
-requirements: L<https://www.unicode.org/draft/reports/tr18/tr18.html>.
|
||||
+Unicode has revised its regular expression requirements:
|
||||
+L<https://www.unicode.org/reports/tr18/tr18-21.html>.
|
||||
As part of that they are wanting more properties to be exposed, ones
|
||||
that aren't part of the strict UCD (Unicode character database). These
|
||||
two are used for examining inputs for security purposes. Details on
|
||||
-their usage is at L<https://www.unicode.org/reports/tr39/proposed.html>.
|
||||
+their usage is at L<https://www.unicode.org/reports/tr39/>.
|
||||
|
||||
=head2 It is now possible to write C<qr/\p{Name=...}/>, or
|
||||
C<qr!\p{na=/(SMILING|GRINNING) FACE/}!>
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,196 +0,0 @@
|
|||
From d7504df2a5d8985f2a8b04f17acff5e324572c39 Mon Sep 17 00:00:00 2001
|
||||
From: Richard Leach <richardleach@users.noreply.github.com>
|
||||
Date: Sun, 11 Oct 2020 12:26:27 +0100
|
||||
Subject: [PATCH] pp_split: no SWITCHSTACK in @ary = split(...) optimisation
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Petr Písař: 607eaf26a99ff76ab48877e68f1d7b005dc51575 ported to 5.32.0.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp.c | 89 +++++++++++++++++++++++++++++-----------------------
|
||||
t/op/split.t | 23 +++++++++++++-
|
||||
2 files changed, 72 insertions(+), 40 deletions(-)
|
||||
|
||||
diff --git a/pp.c b/pp.c
|
||||
index df80830..e4863d3 100644
|
||||
--- a/pp.c
|
||||
+++ b/pp.c
|
||||
@@ -5985,6 +5985,7 @@ PP(pp_split)
|
||||
|
||||
/* handle @ary = split(...) optimisation */
|
||||
if (PL_op->op_private & OPpSPLIT_ASSIGN) {
|
||||
+ realarray = 1;
|
||||
if (!(PL_op->op_flags & OPf_STACKED)) {
|
||||
if (PL_op->op_private & OPpSPLIT_LEX) {
|
||||
if (PL_op->op_private & OPpLVAL_INTRO)
|
||||
@@ -6007,26 +6008,10 @@ PP(pp_split)
|
||||
oldsave = PL_savestack_ix;
|
||||
}
|
||||
|
||||
- realarray = 1;
|
||||
- PUTBACK;
|
||||
- av_extend(ary,0);
|
||||
- (void)sv_2mortal(SvREFCNT_inc_simple_NN(sv));
|
||||
- av_clear(ary);
|
||||
- SPAGAIN;
|
||||
if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) {
|
||||
PUSHMARK(SP);
|
||||
XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg));
|
||||
- }
|
||||
- else {
|
||||
- if (!AvREAL(ary)) {
|
||||
- I32 i;
|
||||
- AvREAL_on(ary);
|
||||
- AvREIFY_off(ary);
|
||||
- for (i = AvFILLp(ary); i >= 0; i--)
|
||||
- AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */
|
||||
- }
|
||||
- /* temporarily switch stacks */
|
||||
- SAVESWITCHSTACK(PL_curstack, ary);
|
||||
+ } else {
|
||||
make_mortal = 0;
|
||||
}
|
||||
}
|
||||
@@ -6358,29 +6343,56 @@ PP(pp_split)
|
||||
LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */
|
||||
SPAGAIN;
|
||||
if (realarray) {
|
||||
- if (!mg) {
|
||||
- if (SvSMAGICAL(ary)) {
|
||||
- PUTBACK;
|
||||
+ if (!mg) {
|
||||
+ PUTBACK;
|
||||
+ if(AvREAL(ary)) {
|
||||
+ if (av_count(ary) > 0)
|
||||
+ av_clear(ary);
|
||||
+ } else {
|
||||
+ AvREAL_on(ary);
|
||||
+ AvREIFY_off(ary);
|
||||
+
|
||||
+ if (AvMAX(ary) > -1) {
|
||||
+ /* don't free mere refs */
|
||||
+ Zero(AvARRAY(ary), AvMAX(ary), SV*);
|
||||
+ }
|
||||
+ }
|
||||
+ if(AvMAX(ary) < iters)
|
||||
+ av_extend(ary,iters);
|
||||
+ SPAGAIN;
|
||||
+
|
||||
+ /* Need to copy the SV*s from the stack into ary */
|
||||
+ Copy(SP + 1 - iters, AvARRAY(ary), iters, SV*);
|
||||
+ AvFILLp(ary) = iters - 1;
|
||||
+
|
||||
+ if (SvSMAGICAL(ary)) {
|
||||
+ PUTBACK;
|
||||
mg_set(MUTABLE_SV(ary));
|
||||
SPAGAIN;
|
||||
- }
|
||||
- if (gimme == G_ARRAY) {
|
||||
- EXTEND(SP, iters);
|
||||
- Copy(AvARRAY(ary), SP + 1, iters, SV*);
|
||||
- SP += iters;
|
||||
- RETURN;
|
||||
- }
|
||||
+ }
|
||||
+
|
||||
+ if (gimme != G_ARRAY) {
|
||||
+ /* SP points to the final SV* pushed to the stack. But the SV* */
|
||||
+ /* are not going to be used from the stack. Point SP to below */
|
||||
+ /* the first of these SV*. */
|
||||
+ SP -= iters;
|
||||
+ PUTBACK;
|
||||
+ }
|
||||
}
|
||||
else {
|
||||
- PUTBACK;
|
||||
- ENTER_with_name("call_PUSH");
|
||||
- call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED);
|
||||
- LEAVE_with_name("call_PUSH");
|
||||
- SPAGAIN;
|
||||
+ PUTBACK;
|
||||
+ av_extend(ary,iters);
|
||||
+ av_clear(ary);
|
||||
+
|
||||
+ ENTER_with_name("call_PUSH");
|
||||
+ call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED);
|
||||
+ LEAVE_with_name("call_PUSH");
|
||||
+ SPAGAIN;
|
||||
+
|
||||
if (gimme == G_ARRAY) {
|
||||
SSize_t i;
|
||||
/* EXTEND should not be needed - we just popped them */
|
||||
- EXTEND(SP, iters);
|
||||
+ EXTEND_SKIP(SP, iters);
|
||||
for (i=0; i < iters; i++) {
|
||||
SV **svp = av_fetch(ary, i, FALSE);
|
||||
PUSHs((svp) ? *svp : &PL_sv_undef);
|
||||
@@ -6389,13 +6401,12 @@ PP(pp_split)
|
||||
}
|
||||
}
|
||||
}
|
||||
- else {
|
||||
- if (gimme == G_ARRAY)
|
||||
- RETURN;
|
||||
- }
|
||||
|
||||
- GETTARGET;
|
||||
- XPUSHi(iters);
|
||||
+ if (gimme != G_ARRAY) {
|
||||
+ GETTARGET;
|
||||
+ XPUSHi(iters);
|
||||
+ }
|
||||
+
|
||||
RETURN;
|
||||
}
|
||||
|
||||
diff --git a/t/op/split.t b/t/op/split.t
|
||||
index 14f9158..7f37512 100644
|
||||
--- a/t/op/split.t
|
||||
+++ b/t/op/split.t
|
||||
@@ -7,7 +7,7 @@ BEGIN {
|
||||
set_up_inc('../lib');
|
||||
}
|
||||
|
||||
-plan tests => 176;
|
||||
+plan tests => 182;
|
||||
|
||||
$FS = ':';
|
||||
|
||||
@@ -648,6 +648,19 @@ is "@a", '1 2 3', 'assignment to split-to-array (stacked)';
|
||||
is (+@a, 0, "empty utf8 string");
|
||||
}
|
||||
|
||||
+# correct stack adjustments (gh#18232)
|
||||
+{
|
||||
+ sub foo { return @_ }
|
||||
+ my @a = foo(1, scalar split " ", "a b");
|
||||
+ is(join('', @a), "12", "Scalar split to a sub parameter");
|
||||
+}
|
||||
+
|
||||
+{
|
||||
+ sub foo { return @_ }
|
||||
+ my @a = foo(1, scalar(@x = split " ", "a b"));
|
||||
+ is(join('', @a), "12", "Split to @x then use scalar result as a sub parameter");
|
||||
+}
|
||||
+
|
||||
fresh_perl_is(<<'CODE', '', {}, "scalar split stack overflow");
|
||||
map{int"";split//.0>60for"0000000000000000"}split// for"00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
|
||||
CODE
|
||||
@@ -667,3 +680,11 @@ CODE
|
||||
ok(eq_array(\@result,['a','b']), "Resulting in ('a','b')");
|
||||
}
|
||||
}
|
||||
+
|
||||
+# check that the (@ary = split) optimisation survives @ary being modified
|
||||
+
|
||||
+fresh_perl_is('my @ary; @ary = split(/\w(?{ @ary[1000] = 1 })/, "abc");',
|
||||
+ '',{},'(@ary = split ...) survives @ary being Renew()ed');
|
||||
+fresh_perl_is('my @ary; @ary = split(/\w(?{ undef @ary })/, "abc");',
|
||||
+ '',{},'(@ary = split ...) survives an (undef @ary)');
|
||||
+
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,30 +0,0 @@
|
|||
From 3c53c6179afbdbef748c110abdb849cb463c2727 Mon Sep 17 00:00:00 2001
|
||||
From: Todd Rinaldo <toddr@cpan.org>
|
||||
Date: Thu, 30 Jul 2020 17:42:47 -0500
|
||||
Subject: [PATCH] Add missing MANIFEST entry from fix for debugger
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Add on fix to #17901
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
MANIFEST | 1 +
|
||||
1 file changed, 1 insertion(+)
|
||||
|
||||
diff --git a/MANIFEST b/MANIFEST
|
||||
index 990a75ad52..12601e46b4 100644
|
||||
--- a/MANIFEST
|
||||
+++ b/MANIFEST
|
||||
@@ -4826,6 +4826,7 @@ lib/perl5db/t/symbol-table-bug Tests for the Perl debugger
|
||||
lib/perl5db/t/taint Tests for the Perl debugger
|
||||
lib/perl5db/t/test-a-statement-1 Tests for the Perl debugger
|
||||
lib/perl5db/t/test-a-statement-2 Tests for the Perl debugger
|
||||
+lib/perl5db/t/test-a-statement-3 Tests for the Perl debugger
|
||||
lib/perl5db/t/test-dieLevel-option-1 Tests for the Perl debugger
|
||||
lib/perl5db/t/test-frame-option-1 Tests for the Perl debugger
|
||||
lib/perl5db/t/test-l-statement-1 Tests for the Perl debugger
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,90 +0,0 @@
|
|||
From b248789b64d6bd277c52bfe608ed3192023af1bd Mon Sep 17 00:00:00 2001
|
||||
From: "E. Choroba" <choroba@matfyz.cz>
|
||||
Date: Fri, 26 Jun 2020 21:19:24 +0200
|
||||
Subject: [PATCH] After running an action in the debugger, turn it off
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
When running with "c", there was no problem, but when running with "n"
|
||||
or "s", once the action was executed, it kept executing on the
|
||||
following lines, which wasn't expected. Clearing $action here prevents
|
||||
this unwanted behaviour.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
lib/perl5db.pl | 3 ++-
|
||||
lib/perl5db.t | 22 ++++++++++++++++++++++
|
||||
lib/perl5db/t/test-a-statement-3 | 6 ++++++
|
||||
3 files changed, 30 insertions(+), 1 deletion(-)
|
||||
create mode 100644 lib/perl5db/t/test-a-statement-3
|
||||
|
||||
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
|
||||
index 69a9bb6e64..e04a0e17fa 100644
|
||||
--- a/lib/perl5db.pl
|
||||
+++ b/lib/perl5db.pl
|
||||
@@ -529,7 +529,7 @@ BEGIN {
|
||||
use vars qw($VERSION $header);
|
||||
|
||||
# bump to X.XX in blead, only use X.XX_XX in maint
|
||||
-$VERSION = '1.57';
|
||||
+$VERSION = '1.58';
|
||||
|
||||
$header = "perl5db.pl version $VERSION";
|
||||
|
||||
@@ -2708,6 +2708,7 @@ If there are any preprompt actions, execute those as well.
|
||||
# The &-call is here to ascertain the mutability of @_.
|
||||
&DB::eval;
|
||||
}
|
||||
+ undef $action;
|
||||
|
||||
# Are we nested another level (e.g., did we evaluate a function
|
||||
# that had a breakpoint in it at the debugger prompt)?
|
||||
diff --git a/lib/perl5db.t b/lib/perl5db.t
|
||||
index 421229a54a..913a301d98 100644
|
||||
--- a/lib/perl5db.t
|
||||
+++ b/lib/perl5db.t
|
||||
@@ -2799,6 +2799,28 @@ SKIP:
|
||||
);
|
||||
}
|
||||
|
||||
+{
|
||||
+ # GitHub #17901
|
||||
+ my $wrapper = DebugWrap->new(
|
||||
+ {
|
||||
+ cmds =>
|
||||
+ [
|
||||
+ 'a 4 $s++',
|
||||
+ ('s') x 5,
|
||||
+ 'x $s',
|
||||
+ 'q'
|
||||
+ ],
|
||||
+ prog => '../lib/perl5db/t/test-a-statement-3',
|
||||
+ switches => [ '-d' ],
|
||||
+ stderr => 0,
|
||||
+ }
|
||||
+ );
|
||||
+ $wrapper->contents_like(
|
||||
+ qr/^0 +2$/m,
|
||||
+ 'Test that the a command runs only on the given lines.',
|
||||
+ );
|
||||
+}
|
||||
+
|
||||
{
|
||||
# perl 5 RT #126735 regression bug.
|
||||
local $ENV{PERLDB_OPTS} = "NonStop=0 RemotePort=non-existent-host.tld:9001";
|
||||
diff --git a/lib/perl5db/t/test-a-statement-3 b/lib/perl5db/t/test-a-statement-3
|
||||
new file mode 100644
|
||||
index 0000000000..b188c1c5c5
|
||||
--- /dev/null
|
||||
+++ b/lib/perl5db/t/test-a-statement-3
|
||||
@@ -0,0 +1,6 @@
|
||||
+use strict; use warnings;
|
||||
+
|
||||
+for my $x (1 .. 2) {
|
||||
+ my $y = $x + 1;
|
||||
+ my $x = $x - 1;
|
||||
+}
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
From 589464a875768e4b4a609d972488e3b592103097 Mon Sep 17 00:00:00 2001
|
||||
From: "E. Choroba" <choroba@matfyz.cz>
|
||||
Date: Mon, 27 Jul 2020 11:32:51 +0200
|
||||
Subject: [PATCH] Clearing DB::action at the end is no longer needed
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
as it's cleared right after it's been run.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
lib/perl5db.pl | 4 ----
|
||||
1 file changed, 4 deletions(-)
|
||||
|
||||
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
|
||||
index e04a0e17fa..af3b972da0 100644
|
||||
--- a/lib/perl5db.pl
|
||||
+++ b/lib/perl5db.pl
|
||||
@@ -3347,10 +3347,6 @@ use B<o> I<inhibit_exit> to avoid stopping after program termination,
|
||||
B<h q>, B<h R> or B<h o> to get additional info.
|
||||
EOP
|
||||
|
||||
- # Set the DB::eval context appropriately.
|
||||
- # At program termination disable any user actions.
|
||||
- $DB::action = undef;
|
||||
-
|
||||
$DB::package = 'main';
|
||||
$DB::usercontext = DB::_calc_usercontext($DB::package);
|
||||
} ## end elsif ($package eq 'DB::fake')
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
From 6841cd5977c2d35ad75233734c66983a65613fce Mon Sep 17 00:00:00 2001
|
||||
From: Karl Williamson <khw@cpan.org>
|
||||
Date: Wed, 12 Aug 2020 17:53:52 -0600
|
||||
Subject: [PATCH] Fix leak GH #18054
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
This was a simple matter of one path failing to free the memory.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regcomp.c | 2 ++
|
||||
1 file changed, 2 insertions(+)
|
||||
|
||||
diff --git a/regcomp.c b/regcomp.c
|
||||
index addf375450..01f297c299 100644
|
||||
--- a/regcomp.c
|
||||
+++ b/regcomp.c
|
||||
@@ -15191,6 +15191,8 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
|
||||
FAIL2("panic: loc_correspondence[%d] is 0",
|
||||
(int) (s - s_start));
|
||||
}
|
||||
+ Safefree(locfold_buf);
|
||||
+ Safefree(loc_correspondence);
|
||||
}
|
||||
else {
|
||||
upper_fill = s - s0;
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,74 +0,0 @@
|
|||
From 8a2562bec7cd9f8eff6812f340f99dddd028bb33 Mon Sep 17 00:00:00 2001
|
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
||||
Date: Thu, 6 Aug 2020 10:51:56 +0200
|
||||
Subject: [PATCH] IO::Handle: Fix a spurious error reported for regular file
|
||||
handles
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
89341f87 fix for GH #6799 introduced a regression when calling error()
|
||||
on an IO::Handle object that was opened for reading a regular file:
|
||||
|
||||
$ perl -e 'open my $f, q{<}, q{/etc/hosts} or die; print qq{error\n} if $f->error'
|
||||
error
|
||||
|
||||
In case of a regular file opened for reading, IoOFP() returns NULL and
|
||||
PerlIO_error(NULL) reports -1. Compare to the case of a file opened
|
||||
for writing when both IoIFP() and IoOFP() return non-NULL, equaled
|
||||
pointer.
|
||||
|
||||
This patch fixes handling the case of the NULL output stream.
|
||||
|
||||
GH #18019
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
dist/IO/IO.xs | 4 ++--
|
||||
dist/IO/t/io_xs.t | 10 +++++++++-
|
||||
2 files changed, 11 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
|
||||
index 9158106416..fb009774c4 100644
|
||||
--- a/dist/IO/IO.xs
|
||||
+++ b/dist/IO/IO.xs
|
||||
@@ -397,9 +397,9 @@ ferror(handle)
|
||||
CODE:
|
||||
if (in)
|
||||
#ifdef PerlIO
|
||||
- RETVAL = PerlIO_error(in) || (in != out && PerlIO_error(out));
|
||||
+ RETVAL = PerlIO_error(in) || (out && in != out && PerlIO_error(out));
|
||||
#else
|
||||
- RETVAL = ferror(in) || (in != out && ferror(out));
|
||||
+ RETVAL = ferror(in) || (out && in != out && ferror(out));
|
||||
#endif
|
||||
else {
|
||||
RETVAL = -1;
|
||||
diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t
|
||||
index a8833b0651..4657088629 100644
|
||||
--- a/dist/IO/t/io_xs.t
|
||||
+++ b/dist/IO/t/io_xs.t
|
||||
@@ -11,7 +11,7 @@ BEGIN {
|
||||
}
|
||||
}
|
||||
|
||||
-use Test::More tests => 8;
|
||||
+use Test::More tests => 10;
|
||||
use IO::File;
|
||||
use IO::Seekable;
|
||||
|
||||
@@ -69,3 +69,11 @@ SKIP: {
|
||||
ok(!$fh->error, "check clearerr removed the error");
|
||||
close $fh; # silently ignore the error
|
||||
}
|
||||
+
|
||||
+{
|
||||
+ # [GH #18019] IO::Handle->error misreported an error after successully
|
||||
+ # opening a regular file for reading. It was a regression in GH #6799 fix.
|
||||
+ ok(open(my $fh, '<', __FILE__), "a regular file opened for reading");
|
||||
+ ok(!$fh->error, "no spurious error reported by error()");
|
||||
+ close $fh;
|
||||
+}
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,80 +0,0 @@
|
|||
From fc5f3468dcbee38eb202cfd552a5b8dbff990c7b Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Tue, 12 May 2020 10:59:08 +1000
|
||||
Subject: [PATCH 2/2] IO::Handle: clear the error on both input and output
|
||||
streams
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Similarly to GH #6799 clearerr() only cleared the error status
|
||||
of the input stream, so clear both.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
dist/IO/IO.xs | 14 +++++++++++---
|
||||
dist/IO/t/io_xs.t | 8 +++++---
|
||||
2 files changed, 16 insertions(+), 6 deletions(-)
|
||||
|
||||
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
|
||||
index 99d523d2c1..9158106416 100644
|
||||
--- a/dist/IO/IO.xs
|
||||
+++ b/dist/IO/IO.xs
|
||||
@@ -410,13 +410,21 @@ ferror(handle)
|
||||
|
||||
int
|
||||
clearerr(handle)
|
||||
- InputStream handle
|
||||
+ SV * handle
|
||||
+ PREINIT:
|
||||
+ IO *io = sv_2io(handle);
|
||||
+ InputStream in = IoIFP(io);
|
||||
+ OutputStream out = IoOFP(io);
|
||||
CODE:
|
||||
if (handle) {
|
||||
#ifdef PerlIO
|
||||
- PerlIO_clearerr(handle);
|
||||
+ PerlIO_clearerr(in);
|
||||
+ if (in != out)
|
||||
+ PerlIO_clearerr(out);
|
||||
#else
|
||||
- clearerr(handle);
|
||||
+ clearerr(in);
|
||||
+ if (in != out)
|
||||
+ clearerr(out);
|
||||
#endif
|
||||
RETVAL = 0;
|
||||
}
|
||||
diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t
|
||||
index f890e92558..a8833b0651 100644
|
||||
--- a/dist/IO/t/io_xs.t
|
||||
+++ b/dist/IO/t/io_xs.t
|
||||
@@ -11,7 +11,7 @@ BEGIN {
|
||||
}
|
||||
}
|
||||
|
||||
-use Test::More tests => 7;
|
||||
+use Test::More tests => 8;
|
||||
use IO::File;
|
||||
use IO::Seekable;
|
||||
|
||||
@@ -58,12 +58,14 @@ SKIP: {
|
||||
# This isn't really a Linux/BSD specific test, but /dev/full is (I
|
||||
# hope) reasonably well defined on these. Patches welcome if your platform
|
||||
# also supports it (or something like it)
|
||||
- skip "no /dev/full or not a /dev/full platform", 2
|
||||
+ skip "no /dev/full or not a /dev/full platform", 3
|
||||
unless $^O =~ /^(linux|netbsd|freebsd)$/ && -c "/dev/full";
|
||||
open my $fh, ">", "/dev/full"
|
||||
- or skip "Could not open /dev/full: $!", 2;
|
||||
+ or skip "Could not open /dev/full: $!", 3;
|
||||
$fh->print("a" x 1024);
|
||||
ok(!$fh->flush, "should fail to flush");
|
||||
ok($fh->error, "stream should be in error");
|
||||
+ $fh->clearerr;
|
||||
+ ok(!$fh->error, "check clearerr removed the error");
|
||||
close $fh; # silently ignore the error
|
||||
}
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,61 +0,0 @@
|
|||
From c6439962c995d4d7052af9fb3f92da93c1584b84 Mon Sep 17 00:00:00 2001
|
||||
From: vividsnow <vividsnow@gmail.com>
|
||||
Date: Fri, 31 Jul 2020 00:37:58 +0300
|
||||
Subject: [PATCH] IO::Socket::UNIX: synchronize behavior with module
|
||||
documentation (#17787)
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
* synchronize behavior with module documentation
|
||||
|
||||
IO::Socket docs states that passing Blocking => 0 will be set socket to non-blocking mode
|
||||
|
||||
* Update AUTHORS
|
||||
* bump version
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
AUTHORS | 1 +
|
||||
dist/IO/lib/IO/Socket/UNIX.pm | 6 +++++-
|
||||
2 files changed, 6 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/AUTHORS b/AUTHORS
|
||||
index 577ba7d0ee..299fdec8a8 100644
|
||||
--- a/AUTHORS
|
||||
+++ b/AUTHORS
|
||||
@@ -1293,6 +1293,7 @@ Ville Skyttä <scop@cs132170.pp.htv.fi>
|
||||
Vincent Pit <perl@profvince.com>
|
||||
Vishal Bhatia <vishal@deja.com>
|
||||
Vitali Peil <vitali.peil@uni-bielefeld.de>
|
||||
+vividsnow <vividsnow@gmail.com>
|
||||
Vlad Harchev <hvv@hippo.ru>
|
||||
Vladimir Alexiev <vladimir@cs.ualberta.ca>
|
||||
Vladimir Marek <vlmarek@volny.cz>
|
||||
diff --git a/dist/IO/lib/IO/Socket/UNIX.pm b/dist/IO/lib/IO/Socket/UNIX.pm
|
||||
index 04b36eaf74..14d0b27a8c 100644
|
||||
--- a/dist/IO/lib/IO/Socket/UNIX.pm
|
||||
+++ b/dist/IO/lib/IO/Socket/UNIX.pm
|
||||
@@ -11,7 +11,7 @@ use IO::Socket;
|
||||
use Carp;
|
||||
|
||||
our @ISA = qw(IO::Socket);
|
||||
-our $VERSION = "1.41";
|
||||
+our $VERSION = "1.42";
|
||||
|
||||
IO::Socket::UNIX->register_domain( AF_UNIX );
|
||||
|
||||
@@ -30,6 +30,10 @@ sub configure {
|
||||
$sock->socket(AF_UNIX, $type, 0) or
|
||||
return undef;
|
||||
|
||||
+ if(exists $arg->{Blocking}) {
|
||||
+ $sock->blocking($arg->{Blocking}) or
|
||||
+ return undef;
|
||||
+ }
|
||||
if(exists $arg->{Local}) {
|
||||
my $addr = sockaddr_un($arg->{Local});
|
||||
$sock->bind($addr) or
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,32 +0,0 @@
|
|||
From 6c2255e0e80e0dc00c7fd96e073f1f524bbaa3e0 Mon Sep 17 00:00:00 2001
|
||||
From: Karl Williamson <khw@cpan.org>
|
||||
Date: Mon, 29 Jun 2020 09:21:24 -0600
|
||||
Subject: [PATCH] MUTABLE_PTR() Rmv non-standard syntax
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Variables in C are beginning with an underscore are reserved for use by
|
||||
the C implementation. Change this non-conformant usage.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
handy.h | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/handy.h b/handy.h
|
||||
index 287e2e206d..890b2b11a2 100644
|
||||
--- a/handy.h
|
||||
+++ b/handy.h
|
||||
@@ -54,7 +54,7 @@ Null SV pointer. (No longer available when C<PERL_CORE> is defined.)
|
||||
*/
|
||||
|
||||
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
|
||||
-# define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
|
||||
+# define MUTABLE_PTR(p) ({ void *p_ = (p); p_; })
|
||||
#else
|
||||
# define MUTABLE_PTR(p) ((void *) (p))
|
||||
#endif
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
From b26a606d84ae1a6da560c7cd71d1a33c0dc7178e Mon Sep 17 00:00:00 2001
|
||||
From: Karl Williamson <khw@cpan.org>
|
||||
Date: Sun, 14 Jun 2020 12:26:02 -0600
|
||||
Subject: [PATCH] Update pod for SvTRUE, to indicate single param evaluation
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
5.32 changed this macro into an inline function so that 'sv' only gets
|
||||
evaluated once, but didn't update the documentation to reflect that.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
sv.h | 3 ++-
|
||||
1 file changed, 2 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/sv.h b/sv.h
|
||||
index 3721b2fb1b..ad8accbf1a 100644
|
||||
--- a/sv.h
|
||||
+++ b/sv.h
|
||||
@@ -1607,7 +1607,8 @@ false. See C<L</SvOK>> for a defined/undefined test. Handles 'get' magic
|
||||
unless the scalar is already C<SvPOK>, C<SvIOK> or C<SvNOK> (the public, not the
|
||||
private flags).
|
||||
|
||||
-See C<L</SvTRUEx>> for a version which guarantees to evaluate C<sv> only once.
|
||||
+As of Perl 5.32, this is guaranteed to evaluate C<sv> only once. Prior to that
|
||||
+release, use C<L</SvTRUEx>> for single evaluation.
|
||||
|
||||
=for apidoc Am|bool|SvTRUE_nomg|SV* sv
|
||||
Returns a boolean indicating whether Perl would evaluate the SV as true or
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,45 +0,0 @@
|
|||
From 313464947382fab07299af0061f419a55540356a Mon Sep 17 00:00:00 2001
|
||||
From: Tomasz Konojacki <me@xenu.pl>
|
||||
Date: Mon, 27 Apr 2020 08:31:47 +0200
|
||||
Subject: [PATCH] XSUB.h: fix MARK and items variables inside BOOT XSUBs
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
ax was incremented by Perl_xs_handshake() and because of that
|
||||
MARK and items were off by one inside BOOT XSUBs.
|
||||
|
||||
fixes #17755
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
XSUB.h | 6 +++---
|
||||
1 file changed, 3 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/XSUB.h b/XSUB.h
|
||||
index e3147ce9fb..5f17a5acde 100644
|
||||
--- a/XSUB.h
|
||||
+++ b/XSUB.h
|
||||
@@ -160,16 +160,16 @@ is a lexical C<$_> in scope.
|
||||
PL_xsubfilename. */
|
||||
#define dXSBOOTARGSXSAPIVERCHK \
|
||||
I32 ax = XS_BOTHVERSION_SETXSUBFN_POPMARK_BOOTCHECK; \
|
||||
- SV **mark = PL_stack_base + ax; dSP; dITEMS
|
||||
+ SV **mark = PL_stack_base + ax - 1; dSP; dITEMS
|
||||
#define dXSBOOTARGSAPIVERCHK \
|
||||
I32 ax = XS_APIVERSION_SETXSUBFN_POPMARK_BOOTCHECK; \
|
||||
- SV **mark = PL_stack_base + ax; dSP; dITEMS
|
||||
+ SV **mark = PL_stack_base + ax - 1; dSP; dITEMS
|
||||
/* dXSBOOTARGSNOVERCHK has no API in xsubpp to choose it so do
|
||||
#undef dXSBOOTARGSXSAPIVERCHK
|
||||
#define dXSBOOTARGSXSAPIVERCHK dXSBOOTARGSNOVERCHK */
|
||||
#define dXSBOOTARGSNOVERCHK \
|
||||
I32 ax = XS_SETXSUBFN_POPMARK; \
|
||||
- SV **mark = PL_stack_base + ax; dSP; dITEMS
|
||||
+ SV **mark = PL_stack_base + ax - 1; dSP; dITEMS
|
||||
|
||||
#define dXSTARG SV * const targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \
|
||||
? PAD_SV(PL_op->op_targ) : sv_newmortal())
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,38 +0,0 @@
|
|||
From 73b535d23d98bd3bdc31a27da26222e2e56166ac Mon Sep 17 00:00:00 2001
|
||||
From: Karl Williamson <khw@cpan.org>
|
||||
Date: Tue, 30 Jun 2020 13:58:50 -0600
|
||||
Subject: [PATCH] ext/XS-APItest/t/utf8_warn_base.pl: Fix a couple tests
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
These had invalid values, which didn't show up execpt on EBCDIC
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
ext/XS-APItest/t/utf8_warn_base.pl | 2 --
|
||||
1 file changed, 2 deletions(-)
|
||||
|
||||
diff --git a/ext/XS-APItest/t/utf8_warn_base.pl b/ext/XS-APItest/t/utf8_warn_base.pl
|
||||
index d86871cd0f..a0f732282e 100644
|
||||
--- a/ext/XS-APItest/t/utf8_warn_base.pl
|
||||
+++ b/ext/XS-APItest/t/utf8_warn_base.pl
|
||||
@@ -486,7 +486,6 @@ my @tests;
|
||||
: I8_to_native(
|
||||
"\xff\xa7\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf"),
|
||||
0x7FFFFFFFFFFFFFFF,
|
||||
- (isASCII) ? 1 : 2,
|
||||
],
|
||||
[ "first 64 bit code point",
|
||||
(isASCII)
|
||||
@@ -525,7 +524,6 @@ my @tests;
|
||||
I8_to_native(
|
||||
"\xff\xa0\xa0\xa0\xa0\xa0\xa1\xa0\xa0\xa0\xa0\xa0\xa0\xa0"),
|
||||
0x800000000,
|
||||
- 40000000
|
||||
],
|
||||
[ "requires at least 32 bits",
|
||||
I8_to_native(
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,193 +0,0 @@
|
|||
From b334474a337421c6643b872388245fb2c11bf995 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Mon, 30 Mar 2020 16:32:46 +1100
|
||||
Subject: [PATCH] fix C<i $obj> where $obj is a lexical
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
the DB::eval function depends on the special behaviour of eval ""
|
||||
within the DB package, which evaluates the string within the context
|
||||
of the first non-DB sub or eval scope, working up the call stack.
|
||||
|
||||
The debugger refactor moved handling for the 'i' command from the
|
||||
DB package to the DB::Obj package, so the eval in DB::eval was
|
||||
working in the context of the DB::Obj::cmd_i function, not in the
|
||||
calling scope.
|
||||
|
||||
Fixed by moving the handling for the i command back to DB.
|
||||
|
||||
Fixes #17661.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
MANIFEST | 1 +
|
||||
lib/perl5db.pl | 65 +++++++++++++++++++++---------------------
|
||||
lib/perl5db.t | 20 +++++++++++++
|
||||
lib/perl5db/t/gh-17661 | 14 +++++++++
|
||||
4 files changed, 68 insertions(+), 32 deletions(-)
|
||||
create mode 100644 lib/perl5db/t/gh-17661
|
||||
|
||||
diff --git a/MANIFEST b/MANIFEST
|
||||
index 8c71995174..96af3618bd 100644
|
||||
--- a/MANIFEST
|
||||
+++ b/MANIFEST
|
||||
@@ -4808,6 +4808,7 @@ lib/perl5db/t/eval-line-bug Tests for the Perl debugger
|
||||
lib/perl5db/t/fact Tests for the Perl debugger
|
||||
lib/perl5db/t/filename-line-breakpoint Tests for the Perl debugger
|
||||
lib/perl5db/t/gh-17660 Tests for the Perl debugger
|
||||
+lib/perl5db/t/gh-17661 Tests for the Perl debugger
|
||||
lib/perl5db/t/load-modules Tests for the Perl debugger
|
||||
lib/perl5db/t/lsub-n Test script used by perl5db.t
|
||||
lib/perl5db/t/lvalue-bug Tests for the Perl debugger
|
||||
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
|
||||
index 96e56d559f..b647d24fb8 100644
|
||||
--- a/lib/perl5db.pl
|
||||
+++ b/lib/perl5db.pl
|
||||
@@ -2512,6 +2512,37 @@ EOP
|
||||
return;
|
||||
}
|
||||
|
||||
+=head3 C<_DB__handle_i_command> - inheritance display
|
||||
+
|
||||
+Display the (nested) parentage of the module or object given.
|
||||
+
|
||||
+=cut
|
||||
+
|
||||
+sub _DB__handle_i_command {
|
||||
+ my $self = shift;
|
||||
+
|
||||
+ my $line = $self->cmd_args;
|
||||
+ require mro;
|
||||
+ foreach my $isa ( split( /\s+/, $line ) ) {
|
||||
+ $evalarg = "$isa";
|
||||
+ # The &-call is here to ascertain the mutability of @_.
|
||||
+ ($isa) = &DB::eval;
|
||||
+ no strict 'refs';
|
||||
+ print join(
|
||||
+ ', ',
|
||||
+ map {
|
||||
+ "$_"
|
||||
+ . (
|
||||
+ defined( ${"$_\::VERSION"} )
|
||||
+ ? ' ' . ${"$_\::VERSION"}
|
||||
+ : undef )
|
||||
+ } @{mro::get_linear_isa(ref($isa) || $isa)}
|
||||
+ );
|
||||
+ print "\n";
|
||||
+ }
|
||||
+ next CMD;
|
||||
+}
|
||||
+
|
||||
# 't' is type.
|
||||
# 'm' is method.
|
||||
# 'v' is the value (i.e: method name or subroutine ref).
|
||||
@@ -2531,6 +2562,7 @@ BEGIN
|
||||
'W' => { t => 'm', v => '_handle_W_command', },
|
||||
'c' => { t => 's', v => \&_DB__handle_c_command, },
|
||||
'f' => { t => 's', v => \&_DB__handle_f_command, },
|
||||
+ 'i' => { t => 's', v => \&_DB__handle_i_command, },
|
||||
'm' => { t => 's', v => \&_DB__handle_m_command, },
|
||||
'n' => { t => 'm', v => '_handle_n_command', },
|
||||
'p' => { t => 'm', v => '_handle_p_command', },
|
||||
@@ -2551,7 +2583,7 @@ BEGIN
|
||||
{ t => 's', v => \&_DB__handle_restart_and_rerun_commands, },
|
||||
} qw(R rerun)),
|
||||
(map { $_ => {t => 'm', v => '_handle_cmd_wrapper_commands' }, }
|
||||
- qw(a A b B e E h i l L M o O v w W)),
|
||||
+ qw(a A b B e E h l L M o O v w W)),
|
||||
);
|
||||
};
|
||||
|
||||
@@ -5468,37 +5500,6 @@ sub cmd_h {
|
||||
}
|
||||
} ## end sub cmd_h
|
||||
|
||||
-=head3 C<cmd_i> - inheritance display
|
||||
-
|
||||
-Display the (nested) parentage of the module or object given.
|
||||
-
|
||||
-=cut
|
||||
-
|
||||
-sub cmd_i {
|
||||
- my $cmd = shift;
|
||||
- my $line = shift;
|
||||
-
|
||||
- require mro;
|
||||
-
|
||||
- foreach my $isa ( split( /\s+/, $line ) ) {
|
||||
- $evalarg = $isa;
|
||||
- # The &-call is here to ascertain the mutability of @_.
|
||||
- ($isa) = &DB::eval;
|
||||
- no strict 'refs';
|
||||
- print join(
|
||||
- ', ',
|
||||
- map {
|
||||
- "$_"
|
||||
- . (
|
||||
- defined( ${"$_\::VERSION"} )
|
||||
- ? ' ' . ${"$_\::VERSION"}
|
||||
- : undef )
|
||||
- } @{mro::get_linear_isa(ref($isa) || $isa)}
|
||||
- );
|
||||
- print "\n";
|
||||
- }
|
||||
-} ## end sub cmd_i
|
||||
-
|
||||
=head3 C<cmd_l> - list lines (command)
|
||||
|
||||
Most of the command is taken up with transforming all the different line
|
||||
diff --git a/lib/perl5db.t b/lib/perl5db.t
|
||||
index 913a301d98..ffa659a215 100644
|
||||
--- a/lib/perl5db.t
|
||||
+++ b/lib/perl5db.t
|
||||
@@ -2946,6 +2946,26 @@ SKIP:
|
||||
);
|
||||
}
|
||||
|
||||
+{
|
||||
+ # gh #17661
|
||||
+ my $wrapper = DebugWrap->new(
|
||||
+ {
|
||||
+ cmds =>
|
||||
+ [
|
||||
+ 'c',
|
||||
+ 'i $obj',
|
||||
+ 'q',
|
||||
+ ],
|
||||
+ prog => '../lib/perl5db/t/gh-17661',
|
||||
+ }
|
||||
+ );
|
||||
+
|
||||
+ $wrapper->output_like(
|
||||
+ qr/C5, C1, C2, C3, C4/,
|
||||
+ q/check for reasonable result/,
|
||||
+ );
|
||||
+}
|
||||
+
|
||||
SKIP:
|
||||
{
|
||||
$Config{usethreads}
|
||||
diff --git a/lib/perl5db/t/gh-17661 b/lib/perl5db/t/gh-17661
|
||||
new file mode 100644
|
||||
index 0000000000..0d85977b35
|
||||
--- /dev/null
|
||||
+++ b/lib/perl5db/t/gh-17661
|
||||
@@ -0,0 +1,14 @@
|
||||
+use v5.10.0;
|
||||
+
|
||||
+{ package C1; sub c1 { } our @ISA = qw(C2) }
|
||||
+{ package C2; sub c2 { } our @ISA = qw(C3) }
|
||||
+{ package C3; sub c3 { } our @ISA = qw( ) }
|
||||
+{ package C4; sub c4 { } our @ISA = qw( ) }
|
||||
+{ package C5; sub c5 { } our @ISA = qw(C1 C4) }
|
||||
+
|
||||
+my $obj = bless {}, 'C5';
|
||||
+$main::global = bless {}, 'C5';
|
||||
+
|
||||
+$DB::single = 1;
|
||||
+
|
||||
+say "Done.";
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,71 +0,0 @@
|
|||
From 282d9dfeb4cea3c2d0335ba78faa3a9db931f1ec Mon Sep 17 00:00:00 2001
|
||||
From: David Mitchell <davem@iabyn.com>
|
||||
Date: Tue, 11 Aug 2020 13:58:51 +0100
|
||||
Subject: [PATCH] list assign in list context: honour LHS undef
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
GH #16685
|
||||
|
||||
In
|
||||
|
||||
@a = ($x, undef, undef) = (1))
|
||||
|
||||
@a should have 3 elements. v5.25.6-79-gb09ed995ad broke this and was
|
||||
returning one element.
|
||||
|
||||
The fix is simple: that previous commit made it so that elements were
|
||||
pushed back onto the stack only if they weren't immortal, so
|
||||
&PL_sv_undef was getting skipped. Make it so they always are.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp_hot.c | 2 +-
|
||||
t/op/aassign.t | 10 +++++++++-
|
||||
2 files changed, 10 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/pp_hot.c b/pp_hot.c
|
||||
index e9f1ffe7a4..3564dd7e12 100644
|
||||
--- a/pp_hot.c
|
||||
+++ b/pp_hot.c
|
||||
@@ -2743,8 +2743,8 @@ PP(pp_aassign)
|
||||
if (!SvIMMORTAL(lsv)) {
|
||||
sv_set_undef(lsv);
|
||||
SvSETMAGIC(lsv);
|
||||
- *relem++ = lsv;
|
||||
}
|
||||
+ *relem++ = lsv;
|
||||
break;
|
||||
} /* switch */
|
||||
} /* while */
|
||||
diff --git a/t/op/aassign.t b/t/op/aassign.t
|
||||
index 9128f9fd98..aa1f2c722c 100644
|
||||
--- a/t/op/aassign.t
|
||||
+++ b/t/op/aassign.t
|
||||
@@ -595,7 +595,7 @@ SKIP: {
|
||||
}
|
||||
|
||||
{
|
||||
- # GH #17816
|
||||
+ # GH #16685
|
||||
# don't use the "1-arg on LHS can't be common" optimisation
|
||||
# when there are undef's there
|
||||
my $x = 1;
|
||||
@@ -603,5 +603,13 @@ SKIP: {
|
||||
is("@a", "2 1", "GH #17816");
|
||||
}
|
||||
|
||||
+{
|
||||
+ # GH #17816
|
||||
+ # honour trailing undef's in list context
|
||||
+ my $x = 1;
|
||||
+ my @a = (($x, undef, undef) = (1));
|
||||
+ is(scalar @a, 3, "GH #17816");
|
||||
+}
|
||||
+
|
||||
|
||||
done_testing();
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,76 +0,0 @@
|
|||
From 5b354d2a8a6fea46c62048464c6722560cb1c907 Mon Sep 17 00:00:00 2001
|
||||
From: David Mitchell <davem@iabyn.com>
|
||||
Date: Tue, 11 Aug 2020 11:55:46 +0100
|
||||
Subject: [PATCH] list assign in list context was over-optimising
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
GH #17816
|
||||
|
||||
This code:
|
||||
|
||||
my $x = 1;
|
||||
print (($x, undef) = (2 => $x));
|
||||
|
||||
was printing "22" when it should have been printing "21".
|
||||
An optimisation skips the 'common values on both sides' test
|
||||
when the LHS of an assign only contains a single var; as the example
|
||||
above shows, this is not sufficient.
|
||||
|
||||
This was broken by v5.23.1-202-g808ce55782
|
||||
|
||||
This commit fixes it by counting undef's on the LHS towards the var
|
||||
count if they don't appear first.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
op.c | 10 +++++++---
|
||||
t/op/aassign.t | 10 ++++++++++
|
||||
2 files changed, 17 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/op.c b/op.c
|
||||
index 05f6d9d1a3..49aac853d4 100644
|
||||
--- a/op.c
|
||||
+++ b/op.c
|
||||
@@ -15679,11 +15679,15 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, int *scalars_p)
|
||||
goto do_next;
|
||||
|
||||
case OP_UNDEF:
|
||||
- /* undef counts as a scalar on the RHS:
|
||||
- * (undef, $x) = ...; # only 1 scalar on LHS: always safe
|
||||
+ /* undef on LHS following a var is significant, e.g.
|
||||
+ * my $x = 1;
|
||||
+ * @a = (($x, undef) = (2 => $x));
|
||||
+ * # @a shoul be (2,1) not (2,2)
|
||||
+ *
|
||||
+ * undef on RHS counts as a scalar:
|
||||
* ($x, $y) = (undef, $x); # 2 scalars on RHS: unsafe
|
||||
*/
|
||||
- if (rhs)
|
||||
+ if ((!rhs && *scalars_p) || rhs)
|
||||
(*scalars_p)++;
|
||||
flags = AAS_SAFE_SCALAR;
|
||||
break;
|
||||
diff --git a/t/op/aassign.t b/t/op/aassign.t
|
||||
index ed904adc62..9128f9fd98 100644
|
||||
--- a/t/op/aassign.t
|
||||
+++ b/t/op/aassign.t
|
||||
@@ -594,4 +594,14 @@ SKIP: {
|
||||
is ($fill, 2, "RT #130132 array 2");
|
||||
}
|
||||
|
||||
+{
|
||||
+ # GH #17816
|
||||
+ # don't use the "1-arg on LHS can't be common" optimisation
|
||||
+ # when there are undef's there
|
||||
+ my $x = 1;
|
||||
+ my @a = (($x, undef) = (2 => $x));
|
||||
+ is("@a", "2 1", "GH #17816");
|
||||
+}
|
||||
+
|
||||
+
|
||||
done_testing();
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,87 +0,0 @@
|
|||
From 89341f87f9fc65c4d7133e497bb04586e86b8052 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Tue, 12 May 2020 10:29:17 +1000
|
||||
Subject: [PATCH 1/2] make $fh->error report errors from both input and output
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
For character devices and sockets perl uses separate PerlIO objects
|
||||
for input and output so they can be buffered separately.
|
||||
|
||||
The IO::Handle::error() method only checked the input stream, so
|
||||
if a write error occurs error() would still returned false.
|
||||
|
||||
Change this so both the input and output streams are checked.
|
||||
|
||||
fixes #6799
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
dist/IO/IO.xs | 12 ++++++++----
|
||||
dist/IO/t/io_xs.t | 19 ++++++++++++++++++-
|
||||
2 files changed, 26 insertions(+), 5 deletions(-)
|
||||
|
||||
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
|
||||
index 68b7352c38..99d523d2c1 100644
|
||||
--- a/dist/IO/IO.xs
|
||||
+++ b/dist/IO/IO.xs
|
||||
@@ -389,13 +389,17 @@ ungetc(handle, c)
|
||||
|
||||
int
|
||||
ferror(handle)
|
||||
- InputStream handle
|
||||
+ SV * handle
|
||||
+ PREINIT:
|
||||
+ IO *io = sv_2io(handle);
|
||||
+ InputStream in = IoIFP(io);
|
||||
+ OutputStream out = IoOFP(io);
|
||||
CODE:
|
||||
- if (handle)
|
||||
+ if (in)
|
||||
#ifdef PerlIO
|
||||
- RETVAL = PerlIO_error(handle);
|
||||
+ RETVAL = PerlIO_error(in) || (in != out && PerlIO_error(out));
|
||||
#else
|
||||
- RETVAL = ferror(handle);
|
||||
+ RETVAL = ferror(in) || (in != out && ferror(out));
|
||||
#endif
|
||||
else {
|
||||
RETVAL = -1;
|
||||
diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t
|
||||
index 1e3c49a4a7..f890e92558 100644
|
||||
--- a/dist/IO/t/io_xs.t
|
||||
+++ b/dist/IO/t/io_xs.t
|
||||
@@ -11,7 +11,7 @@ BEGIN {
|
||||
}
|
||||
}
|
||||
|
||||
-use Test::More tests => 5;
|
||||
+use Test::More tests => 7;
|
||||
use IO::File;
|
||||
use IO::Seekable;
|
||||
|
||||
@@ -50,3 +50,20 @@ SKIP:
|
||||
ok($fh->sync, "sync to a read only handle")
|
||||
or diag "sync(): ", $!;
|
||||
}
|
||||
+
|
||||
+
|
||||
+SKIP: {
|
||||
+ # gh 6799
|
||||
+ #
|
||||
+ # This isn't really a Linux/BSD specific test, but /dev/full is (I
|
||||
+ # hope) reasonably well defined on these. Patches welcome if your platform
|
||||
+ # also supports it (or something like it)
|
||||
+ skip "no /dev/full or not a /dev/full platform", 2
|
||||
+ unless $^O =~ /^(linux|netbsd|freebsd)$/ && -c "/dev/full";
|
||||
+ open my $fh, ">", "/dev/full"
|
||||
+ or skip "Could not open /dev/full: $!", 2;
|
||||
+ $fh->print("a" x 1024);
|
||||
+ ok(!$fh->flush, "should fail to flush");
|
||||
+ ok($fh->error, "stream should be in error");
|
||||
+ close $fh; # silently ignore the error
|
||||
+}
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,72 +0,0 @@
|
|||
From 45f235c116d4deab95c576aff77fe46d609f8553 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Mon, 15 Apr 2019 15:23:32 +1000
|
||||
Subject: [PATCH] (perl #17844) don't update SvCUR until after we've done
|
||||
moving
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
SvCUR() before the SvGROW() calls could result in reading beyond the
|
||||
end of a buffer.
|
||||
|
||||
It wasn't a problem in the normal case, since sv_grow() just calls
|
||||
realloc() which has its own notion of how big the memory block is, but
|
||||
if the SV is SvOOK() sv_backoff() tries to move SvCUR()+1 bytes, which
|
||||
might be larger than the currently allocated size of the PV.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
doop.c | 2 +-
|
||||
t/op/bop.t | 11 ++++++++++-
|
||||
2 files changed, 11 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/doop.c b/doop.c
|
||||
index 88220092c3..c9c953212e 100644
|
||||
--- a/doop.c
|
||||
+++ b/doop.c
|
||||
@@ -1087,7 +1087,6 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
|
||||
lsave = lc;
|
||||
rsave = rc;
|
||||
|
||||
- SvCUR_set(sv, len);
|
||||
(void)SvPOK_only(sv);
|
||||
if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
|
||||
dc = SvPV_force_nomg_nolen(sv);
|
||||
@@ -1103,6 +1102,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
|
||||
sv_usepvn_flags(sv, dc, needlen, SV_HAS_TRAILING_NUL);
|
||||
dc = SvPVX(sv); /* sv_usepvn() calls Renew() */
|
||||
}
|
||||
+ SvCUR_set(sv, len);
|
||||
|
||||
if (len >= sizeof(long)*4 &&
|
||||
!(PTR2nat(dc) % sizeof(long)) &&
|
||||
diff --git a/t/op/bop.t b/t/op/bop.t
|
||||
index eecd90387f..07f057d0a9 100644
|
||||
--- a/t/op/bop.t
|
||||
+++ b/t/op/bop.t
|
||||
@@ -18,7 +18,7 @@ BEGIN {
|
||||
# If you find tests are failing, please try adding names to tests to track
|
||||
# down where the failure is, and supply your new names as a patch.
|
||||
# (Just-in-time test naming)
|
||||
-plan tests => 501;
|
||||
+plan tests => 502;
|
||||
|
||||
# numerics
|
||||
ok ((0xdead & 0xbeef) == 0x9ead);
|
||||
@@ -669,3 +669,12 @@ foreach my $op_info ([and => "&"], [or => "|"], [xor => "^"]) {
|
||||
like $@, $expected, $description;
|
||||
}
|
||||
}
|
||||
+
|
||||
+{
|
||||
+ # perl #17844 - only visible with valgrind/ASAN
|
||||
+ fresh_perl_is(<<'EOS',
|
||||
+formline X000n^\\0,\\0^\\0for\0,0..10
|
||||
+EOS
|
||||
+ '',
|
||||
+ {}, "[perl #17844] access beyond end of block");
|
||||
+}
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,58 +0,0 @@
|
|||
From 81169c06a76f62ff987ed990ac910c2ae08b3f91 Mon Sep 17 00:00:00 2001
|
||||
From: Karl Williamson <khw@cpan.org>
|
||||
Date: Tue, 10 Mar 2020 15:19:57 -0600
|
||||
Subject: [PATCH] reentr.c: Buffer sizes for asctime_r,ctime_r are small
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
The needed sizes of these are stated in the man pages, and are much
|
||||
smaller than were being allocated.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
reentr.c | 4 ++--
|
||||
regen/reentr.pl | 5 ++++-
|
||||
2 files changed, 6 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/reentr.c b/reentr.c
|
||||
index 8ddda7bfc0..8438c8f90f 100644
|
||||
--- a/reentr.c
|
||||
+++ b/reentr.c
|
||||
@@ -52,14 +52,14 @@ Perl_reentrant_size(pTHX) {
|
||||
# define REENTRANTUSUALSIZE 4096 /* Make something up. */
|
||||
|
||||
# ifdef HAS_ASCTIME_R
|
||||
- PL_reentrant_buffer->_asctime_size = REENTRANTSMALLSIZE;
|
||||
+ PL_reentrant_buffer->_asctime_size = 26;
|
||||
# endif /* HAS_ASCTIME_R */
|
||||
|
||||
# ifdef HAS_CRYPT_R
|
||||
# endif /* HAS_CRYPT_R */
|
||||
|
||||
# ifdef HAS_CTIME_R
|
||||
- PL_reentrant_buffer->_ctime_size = REENTRANTSMALLSIZE;
|
||||
+ PL_reentrant_buffer->_ctime_size = 26;
|
||||
# endif /* HAS_CTIME_R */
|
||||
|
||||
# ifdef HAS_GETGRNAM_R
|
||||
diff --git a/regen/reentr.pl b/regen/reentr.pl
|
||||
index f5788c7ad9..94721e9dec 100644
|
||||
--- a/regen/reentr.pl
|
||||
+++ b/regen/reentr.pl
|
||||
@@ -495,8 +495,11 @@ for my $func (@seenf) {
|
||||
char* _${func}_buffer;
|
||||
size_t _${func}_size;
|
||||
EOF
|
||||
+ my $size = ($func =~ /^(asctime|ctime)$/)
|
||||
+ ? 26
|
||||
+ : "REENTRANTSMALLSIZE";
|
||||
push @size, <<EOF;
|
||||
- PL_reentrant_buffer->_${func}_size = REENTRANTSMALLSIZE;
|
||||
+ PL_reentrant_buffer->_${func}_size = $size;
|
||||
EOF
|
||||
pushinitfree $func;
|
||||
pushssif $endif;
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,46 +0,0 @@
|
|||
From 981fbfc16220a15e72457d8ece4e014988746946 Mon Sep 17 00:00:00 2001
|
||||
From: Karl Williamson <khw@cpan.org>
|
||||
Date: Thu, 12 Mar 2020 12:48:47 -0600
|
||||
Subject: [PATCH] reentr.c: Prevent infinite looping
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
This is an easy, though paranoid hedge to prevent something that should
|
||||
never happen from causing an infinite loop if it were to happen.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
reentr.c | 2 +-
|
||||
regen/reentr.pl | 2 +-
|
||||
2 files changed, 2 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/reentr.c b/reentr.c
|
||||
index 8438c8f90f..2429aa2f5d 100644
|
||||
--- a/reentr.c
|
||||
+++ b/reentr.c
|
||||
@@ -36,7 +36,7 @@
|
||||
|
||||
#define RenewDouble(data_pointer, size_pointer, type) \
|
||||
STMT_START { \
|
||||
- const size_t size = *(size_pointer) * 2; \
|
||||
+ const size_t size = MAX(*(size_pointer), 1) * 2; \
|
||||
Renew((data_pointer), (size), type); \
|
||||
*(size_pointer) = size; \
|
||||
} STMT_END
|
||||
diff --git a/regen/reentr.pl b/regen/reentr.pl
|
||||
index 94721e9dec..ba2e1c8fa6 100644
|
||||
--- a/regen/reentr.pl
|
||||
+++ b/regen/reentr.pl
|
||||
@@ -818,7 +818,7 @@ print $c <<"EOF";
|
||||
|
||||
#define RenewDouble(data_pointer, size_pointer, type) \\
|
||||
STMT_START { \\
|
||||
- const size_t size = *(size_pointer) * 2; \\
|
||||
+ const size_t size = MAX(*(size_pointer), 1) * 2; \\
|
||||
Renew((data_pointer), (size), type); \\
|
||||
*(size_pointer) = size; \\
|
||||
} STMT_END
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
From 530e9296a21b673d7e4c2b42f18d0d52d00f35c4 Mon Sep 17 00:00:00 2001
|
||||
From: Karl Williamson <khw@cpan.org>
|
||||
Date: Sun, 28 Jun 2020 12:03:54 -0600
|
||||
Subject: [PATCH] sv.h: Wanted UOK, but said IOK
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
I don't know the consequences of this bug
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
sv.h | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/sv.h b/sv.h
|
||||
index 2f6431a826..3721b2fb1b 100644
|
||||
--- a/sv.h
|
||||
+++ b/sv.h
|
||||
@@ -1711,7 +1711,7 @@ Like C<sv_catsv> but doesn't process magic.
|
||||
#define SvNV(sv) (SvNOK_nog(sv) ? SvNVX(sv) : sv_2nv(sv))
|
||||
|
||||
#define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0))
|
||||
-#define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
|
||||
+#define SvUV_nomg(sv) (SvUOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
|
||||
#define SvNV_nomg(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv_flags(sv, 0))
|
||||
|
||||
/* ----*/
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,88 +0,0 @@
|
|||
From 90f66c42e4513ae5d907805fbf28b9967a90d6c5 Mon Sep 17 00:00:00 2001
|
||||
From: John Lightsey <john@04755.net>
|
||||
Date: Fri, 28 Aug 2020 23:39:18 -0500
|
||||
Subject: [PATCH] Heap buffer overflow in regex bracket group whitespace
|
||||
handling
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
The code for skipping whitespace in regex bracket character groups
|
||||
was walking past the end of the regex in some cases.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regcomp.c | 16 ++++++++--------
|
||||
1 file changed, 8 insertions(+), 8 deletions(-)
|
||||
|
||||
diff --git a/regcomp.c b/regcomp.c
|
||||
index db82c77b00..64488994fa 100644
|
||||
--- a/regcomp.c
|
||||
+++ b/regcomp.c
|
||||
@@ -17228,10 +17228,10 @@ S_add_multi_match(pTHX_ AV* multi_char_matches, SV* multi_string, const STRLEN c
|
||||
*
|
||||
* There is a line below that uses the same white space criteria but is outside
|
||||
* this macro. Both here and there must use the same definition */
|
||||
-#define SKIP_BRACKETED_WHITE_SPACE(do_skip, p) \
|
||||
+#define SKIP_BRACKETED_WHITE_SPACE(do_skip, p, stop_p) \
|
||||
STMT_START { \
|
||||
if (do_skip) { \
|
||||
- while (isBLANK_A(UCHARAT(p))) \
|
||||
+ while (p < stop_p && isBLANK_A(UCHARAT(p))) \
|
||||
{ \
|
||||
p++; \
|
||||
} \
|
||||
@@ -17406,7 +17406,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
|
||||
initial_listsv_len = SvCUR(listsv);
|
||||
SvTEMP_off(listsv); /* Grr, TEMPs and mortals are conflated. */
|
||||
|
||||
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
|
||||
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
|
||||
|
||||
assert(RExC_parse <= RExC_end);
|
||||
|
||||
@@ -17415,7 +17415,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
|
||||
invert = TRUE;
|
||||
allow_mutiple_chars = FALSE;
|
||||
MARK_NAUGHTY(1);
|
||||
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
|
||||
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
|
||||
}
|
||||
|
||||
/* Check that they didn't say [:posix:] instead of [[:posix:]] */
|
||||
@@ -17462,12 +17462,12 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
|
||||
output_posix_warnings(pRExC_state, posix_warnings);
|
||||
}
|
||||
|
||||
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
|
||||
+
|
||||
if (RExC_parse >= stop_ptr) {
|
||||
break;
|
||||
}
|
||||
|
||||
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
|
||||
-
|
||||
if (UCHARAT(RExC_parse) == ']') {
|
||||
break;
|
||||
}
|
||||
@@ -18156,7 +18156,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
|
||||
}
|
||||
} /* end of namedclass \blah */
|
||||
|
||||
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
|
||||
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
|
||||
|
||||
/* If 'range' is set, 'value' is the ending of a range--check its
|
||||
* validity. (If value isn't a single code point in the case of a
|
||||
@@ -18199,7 +18199,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
|
||||
char* next_char_ptr = RExC_parse + 1;
|
||||
|
||||
/* Get the next real char after the '-' */
|
||||
- SKIP_BRACKETED_WHITE_SPACE(skip_white, next_char_ptr);
|
||||
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, next_char_ptr, RExC_end);
|
||||
|
||||
/* If the '-' is at the end of the class (just before the ']',
|
||||
* it is a literal minus; otherwise it is a range */
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,55 +0,0 @@
|
|||
From 042abef72d40ab7ff39127e2afae6e34dfc66404 Mon Sep 17 00:00:00 2001
|
||||
From: Nicolas R <atoomic@cpan.org>
|
||||
Date: Fri, 14 Aug 2020 16:16:22 -0500
|
||||
Subject: [PATCH] die_unwind(): global destruction
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Fix #18063
|
||||
|
||||
During global destruction make sure we preserve
|
||||
the string by using mortalcopy.
|
||||
|
||||
This is an update on 8c86f0238ecb5f32c2e7fba36e3edfdb54069068
|
||||
change which avoided sv_mortalcopy in favor of sv_2mortal.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp_ctl.c | 6 +++++-
|
||||
t/op/die_unwind.t | 4 ++++
|
||||
2 files changed, 9 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/pp_ctl.c b/pp_ctl.c
|
||||
index b8cd869ee0..cc244d7ba7 100644
|
||||
--- a/pp_ctl.c
|
||||
+++ b/pp_ctl.c
|
||||
@@ -1716,7 +1716,11 @@ Perl_die_unwind(pTHX_ SV *msv)
|
||||
* when unlocalising a tied var). So we do a dance with
|
||||
* mortalising and SAVEFREEing.
|
||||
*/
|
||||
- sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
|
||||
+ if (PL_phase == PERL_PHASE_DESTRUCT) {
|
||||
+ exceptsv = sv_mortalcopy(exceptsv);
|
||||
+ } else {
|
||||
+ exceptsv = sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
|
||||
+ }
|
||||
|
||||
/*
|
||||
* Historically, perl used to set ERRSV ($@) early in the die
|
||||
diff --git a/t/op/die_unwind.t b/t/op/die_unwind.t
|
||||
index eee1ce534b..4b83ee6fac 100644
|
||||
--- a/t/op/die_unwind.t
|
||||
+++ b/t/op/die_unwind.t
|
||||
@@ -69,4 +69,8 @@ is($uerr, "t3\n");
|
||||
is($val, undef, "undefined return value from 'eval' block with 'die'");
|
||||
is($err, "t3\n");
|
||||
|
||||
+fresh_perl_like(<<'EOS', qr/Custom Message During Global Destruction/, { switches => ['-w'], stderr => 1 } );
|
||||
+package Foo; sub DESTROY { die "Custom Message During Global Destruction" }; package main; our $wut = bless [], "Foo"
|
||||
+EOS
|
||||
+
|
||||
done_testing();
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,77 +0,0 @@
|
|||
From 390fe0c0d09aadc66f644e9eee4aa1245221188c Mon Sep 17 00:00:00 2001
|
||||
From: David Mitchell <davem@iabyn.com>
|
||||
Date: Tue, 25 Aug 2020 13:15:25 +0100
|
||||
Subject: [PATCH] sort { return foo() } ...
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
GH #18081
|
||||
|
||||
A sub call via return in a sort block was called in void rather than
|
||||
scalar context, causing the comparison result to be discarded.
|
||||
|
||||
This because when a sort block is called it is not a real function
|
||||
call, even though a sort block can be returned from. Instead, a
|
||||
CXt_NULL is pushed on the context stack. Because this isn't a sub-ish
|
||||
context type (unlike CXt_SUB, CXt_EVAL etc) there is no 'caller sub'
|
||||
on the context stack to be found to retrieve the caller's context
|
||||
(i.e. cx->cx_gimme).
|
||||
|
||||
This commit fixes it by special-casing Perl_gimme_V().
|
||||
|
||||
Ideally at some future point, a new context type, CXt_SORT, should be
|
||||
added. This would be used instead of CXt_NULL when a sort BLOCK is
|
||||
called. Like other sub-ish context types, it would have an old_cxsubix
|
||||
field and PL_curstackinfo->si_cxsubix would point to it. This would
|
||||
eliminate needing special-case handling in places like Perl_gimme_V().
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
inline.h | 2 +-
|
||||
t/op/sort.t | 12 +++++++++++-
|
||||
2 files changed, 12 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/inline.h b/inline.h
|
||||
index a8240efb9c..6fbd5abfea 100644
|
||||
--- a/inline.h
|
||||
+++ b/inline.h
|
||||
@@ -2086,7 +2086,7 @@ Perl_gimme_V(pTHX)
|
||||
return gimme;
|
||||
cxix = PL_curstackinfo->si_cxsubix;
|
||||
if (cxix < 0)
|
||||
- return G_VOID;
|
||||
+ return PL_curstackinfo->si_type == PERLSI_SORT ? G_SCALAR: G_VOID;
|
||||
assert(cxstack[cxix].blk_gimme & G_WANT);
|
||||
return (cxstack[cxix].blk_gimme & G_WANT);
|
||||
}
|
||||
diff --git a/t/op/sort.t b/t/op/sort.t
|
||||
index f2e139dff0..8e387fb90d 100644
|
||||
--- a/t/op/sort.t
|
||||
+++ b/t/op/sort.t
|
||||
@@ -7,7 +7,7 @@ BEGIN {
|
||||
set_up_inc('../lib');
|
||||
}
|
||||
use warnings;
|
||||
-plan(tests => 203);
|
||||
+plan(tests => 204);
|
||||
use Tie::Array; # we need to test sorting tied arrays
|
||||
|
||||
# these shouldn't hang
|
||||
@@ -1202,3 +1202,13 @@ SKIP:
|
||||
$fillb = undef;
|
||||
is $act, "01[sortb]2[fillb]";
|
||||
}
|
||||
+
|
||||
+# GH #18081
|
||||
+# sub call via return in sort block was called in void rather than scalar
|
||||
+# context
|
||||
+
|
||||
+{
|
||||
+ sub sort18081 { $a + 1 <=> $b + 1 }
|
||||
+ my @a = sort { return &sort18081 } 6,1,2;
|
||||
+ is "@a", "1 2 6", "GH #18081";
|
||||
+}
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,77 +0,0 @@
|
|||
From bd5fa06648085e8c17efd55abeb6424aeeb1018e Mon Sep 17 00:00:00 2001
|
||||
From: Karl Williamson <khw@cpan.org>
|
||||
Date: Tue, 29 Sep 2020 00:48:19 -0600
|
||||
Subject: [PATCH] Remove Perl_av_top_index
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
I created this in 87306e0674dfe3af29804b4641347cd5ac9b0521, thinking it
|
||||
was needed to preserve backward compatibility if someone were using this
|
||||
instead of the macro. But it turned out that there never was such a
|
||||
function, it was inlined, and the name was S_av_top_index, so there is
|
||||
no reason to create a new function that no one has ever been able to
|
||||
call. So just remove it, and let all accesses go through the macro
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
av.c | 10 ----------
|
||||
embed.fnc | 2 +-
|
||||
proto.h | 7 +++----
|
||||
3 files changed, 4 insertions(+), 15 deletions(-)
|
||||
|
||||
diff --git a/av.c b/av.c
|
||||
index ada09cde9a..ad2429f90d 100644
|
||||
--- a/av.c
|
||||
+++ b/av.c
|
||||
@@ -1095,16 +1095,6 @@ Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
|
||||
return sv;
|
||||
}
|
||||
|
||||
-SSize_t
|
||||
-Perl_av_top_index(pTHX_ AV *av)
|
||||
-{
|
||||
- PERL_ARGS_ASSERT_AV_TOP_INDEX;
|
||||
- assert(SvTYPE(av) == SVt_PVAV);
|
||||
-
|
||||
- return AvFILL(av);
|
||||
-}
|
||||
-
|
||||
-
|
||||
/*
|
||||
* ex: set ts=8 sts=4 sw=4 et:
|
||||
*/
|
||||
diff --git a/embed.fnc b/embed.fnc
|
||||
index a6b4d0350f..f5c5b29c2d 100644
|
||||
--- a/embed.fnc
|
||||
+++ b/embed.fnc
|
||||
@@ -637,7 +637,7 @@ Apd |void |av_push |NN AV *av|NN SV *val
|
||||
EXp |void |av_reify |NN AV *av
|
||||
ApdR |SV* |av_shift |NN AV *av
|
||||
Apd |SV** |av_store |NN AV *av|SSize_t key|NULLOK SV *val
|
||||
-AMdRp |SSize_t|av_top_index |NN AV *av
|
||||
+AmdR |SSize_t|av_top_index |NN AV *av
|
||||
AidRp |Size_t |av_count |NN AV *av
|
||||
AmdR |SSize_t|av_tindex |NN AV *av
|
||||
Apd |void |av_undef |NN AV *av
|
||||
diff --git a/proto.h b/proto.h
|
||||
index c4490fc46e..2da1a07761 100644
|
||||
--- a/proto.h
|
||||
+++ b/proto.h
|
||||
@@ -291,10 +291,9 @@ PERL_CALLCONV SV** Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val);
|
||||
__attribute__warn_unused_result__; */
|
||||
#define PERL_ARGS_ASSERT_AV_TINDEX
|
||||
|
||||
-PERL_CALLCONV SSize_t Perl_av_top_index(pTHX_ AV *av)
|
||||
- __attribute__warn_unused_result__;
|
||||
-#define PERL_ARGS_ASSERT_AV_TOP_INDEX \
|
||||
- assert(av)
|
||||
+/* PERL_CALLCONV SSize_t av_top_index(pTHX_ AV *av)
|
||||
+ __attribute__warn_unused_result__; */
|
||||
+#define PERL_ARGS_ASSERT_AV_TOP_INDEX
|
||||
|
||||
PERL_CALLCONV void Perl_av_undef(pTHX_ AV *av);
|
||||
#define PERL_ARGS_ASSERT_AV_UNDEF \
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,56 +0,0 @@
|
|||
From f4cd5e29bc15621f2ab8fc5d7de0e68e62d43999 Mon Sep 17 00:00:00 2001
|
||||
From: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Tue, 15 Sep 2020 14:02:54 +0100
|
||||
Subject: [PATCH] [gh18096] assume worst-case for GOSUBs we don't analyse
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
During study_chunk, under various conditions we avoid recursing into
|
||||
a GOSUB. But we must avoid giving the enclosing scope the idea that
|
||||
this GOSUB would match only an empty string, since that could trigger
|
||||
wrong optimizations (eg CURLYX => CURLYM in the ticket).
|
||||
|
||||
So we mark the construct as infinite, as in the code branch where we
|
||||
_do_ recurse into it.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regcomp.c | 7 ++++++-
|
||||
t/re/re_tests | 2 ++
|
||||
2 files changed, 8 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/regcomp.c b/regcomp.c
|
||||
index 124ea5b90b..fae3f8079d 100644
|
||||
--- a/regcomp.c
|
||||
+++ b/regcomp.c
|
||||
@@ -5212,7 +5212,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
* might result in a minlen of 1 and not of 4,
|
||||
* but this doesn't make us mismatch, just try a bit
|
||||
* harder than we should.
|
||||
- * */
|
||||
+ *
|
||||
+ * However we must assume this GOSUB is infinite, to
|
||||
+ * avoid wrongly applying other optimizations in the
|
||||
+ * enclosing scope - see GH 18096, for example.
|
||||
+ */
|
||||
+ is_inf = is_inf_internal = 1;
|
||||
scan= regnext(scan);
|
||||
continue;
|
||||
}
|
||||
diff --git a/t/re/re_tests b/t/re/re_tests
|
||||
index 554a7004a2..ab5a0d8012 100644
|
||||
--- a/t/re/re_tests
|
||||
+++ b/t/re/re_tests
|
||||
@@ -2023,6 +2023,8 @@ AB\s+\x{100} AB \x{100}X y - -
|
||||
/(?iaax:A? \K +)/ African_Feh c - \\K + is forbidden - matches null string many times in regex
|
||||
/(?iaa:A?\K+)/ African_Feh c - \\K+ is forbidden - matches null string many times in regex
|
||||
/(?iaa:A?\K*)/ African_Feh c - \\K* is forbidden - matches null string many times in regex
|
||||
+^((\w|<(\s)*(?1)(?3)*>)(?:(?3)*\+(?3)*(?2))*)(?3)*\+ a + b + <c + d> y $1 a + b # [GH #18096]
|
||||
+^((\w|<(\s)*(?1)(?3)*>)(?:(?3)*\+(?3)*(?2))*)(?3)*\+ a + <b> + c y $1 a + <b> # [GH #18096]
|
||||
# Keep these lines at the end of the file
|
||||
# pat string y/n/etc expr expected-expr skip-reason comment
|
||||
# vim: softtabstop=0 noexpandtab
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
From fa353c3d2833fc326233e0eb583753b4d7887a63 Mon Sep 17 00:00:00 2001
|
||||
From: Karl Williamson <khw@cpan.org>
|
||||
Date: Sun, 4 Oct 2020 11:07:19 -0600
|
||||
Subject: [PATCH] mro.xs: Fix compiler warning
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Fixes GH #18155
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
ext/mro/mro.xs | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/ext/mro/mro.xs b/ext/mro/mro.xs
|
||||
index f21216af6e..8ce5844904 100644
|
||||
--- a/ext/mro/mro.xs
|
||||
+++ b/ext/mro/mro.xs
|
||||
@@ -253,7 +253,7 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
|
||||
hierarchy is not C3-incompatible */
|
||||
if(!winner) {
|
||||
SV *errmsg;
|
||||
- I32 i;
|
||||
+ Size_t i;
|
||||
|
||||
errmsg = newSVpvf(
|
||||
"Inconsistent hierarchy during C3 merge of class '%" HEKf "':\n\t"
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,32 +0,0 @@
|
|||
From 5777cf812c2812ea45eeb45e48979bab544d71af Mon Sep 17 00:00:00 2001
|
||||
From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com>
|
||||
Date: Thu, 8 Oct 2020 19:02:10 +0900
|
||||
Subject: [PATCH] sv.c: Added missing braces in Perl_sv_inc_nomg().
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
sv.c | 3 ++-
|
||||
1 file changed, 2 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/sv.c b/sv.c
|
||||
index 82248e3b1f..57fd65a5b8 100644
|
||||
--- a/sv.c
|
||||
+++ b/sv.c
|
||||
@@ -8944,9 +8944,10 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv)
|
||||
if (SvIsUV(sv)) {
|
||||
if (SvUVX(sv) == UV_MAX)
|
||||
sv_setnv(sv, UV_MAX_P1);
|
||||
- else
|
||||
+ else {
|
||||
(void)SvIOK_only_UV(sv);
|
||||
SvUV_set(sv, SvUVX(sv) + 1);
|
||||
+ }
|
||||
} else {
|
||||
if (SvIVX(sv) == IV_MAX)
|
||||
sv_setuv(sv, (UV)IV_MAX + 1);
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,36 +0,0 @@
|
|||
From e17dadf36f7b4348e59076240c880d0c78b33fa9 Mon Sep 17 00:00:00 2001
|
||||
From: Karl Williamson <khw@cpan.org>
|
||||
Date: Tue, 22 Sep 2020 08:47:52 -0600
|
||||
Subject: [PATCH] sv.h: sv_collxfrm didn't work properly
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
It is supposed to be a wrapper for sv_collxfrm_flags, but it was just
|
||||
calling sv_cmp_flags instead. The consequences are none except under
|
||||
'use locale' in which case you always got the C locale. I did not add
|
||||
tests, because it is really a pain to write portable locale tests, and
|
||||
this doesn't seem to be much used. In core the '_flags' form was always
|
||||
used.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
sv.h | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/sv.h b/sv.h
|
||||
index 19ce718ac3..44414b35a9 100644
|
||||
--- a/sv.h
|
||||
+++ b/sv.h
|
||||
@@ -2045,7 +2045,7 @@ Like C<sv_catsv> but doesn't process magic.
|
||||
#define sv_eq(sv1, sv2) sv_eq_flags(sv1, sv2, SV_GMAGIC)
|
||||
#define sv_cmp(sv1, sv2) sv_cmp_flags(sv1, sv2, SV_GMAGIC)
|
||||
#define sv_cmp_locale(sv1, sv2) sv_cmp_locale_flags(sv1, sv2, SV_GMAGIC)
|
||||
-#define sv_collxfrm(sv, nxp) sv_cmp_flags(sv, nxp, SV_GMAGIC)
|
||||
+#define sv_collxfrm(sv, nxp) sv_collxfrm_flags(sv, nxp, SV_GMAGIC)
|
||||
#define sv_2bool(sv) sv_2bool_flags(sv, SV_GMAGIC)
|
||||
#define sv_2bool_nomg(sv) sv_2bool_flags(sv, 0)
|
||||
#define sv_insert(bigstr, offset, len, little, littlelen) \
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,76 +0,0 @@
|
|||
From e050064b67c501e9fdc7bc3f513ba2b8b9e795f8 Mon Sep 17 00:00:00 2001
|
||||
From: David Mitchell <davem@iabyn.com>
|
||||
Date: Fri, 30 Oct 2020 20:50:58 +0000
|
||||
Subject: [PATCH] Perl_custom_op_get_field(): remove undef behaviour
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Thus function has a couple a switches with
|
||||
|
||||
default:
|
||||
NOT_REACHED; /* NOTREACHED */
|
||||
|
||||
but clang is complaining that the value returned by the function is
|
||||
undefined if those default branches are taken, since the 'any' variable
|
||||
doesn't get set in that path.
|
||||
|
||||
Replace the NOTREACHED with a croak("panic: ..."). It's possible (albeit
|
||||
not intended) for Perl_custom_op_get_field() to be called with a 'field'
|
||||
arg which triggers the default case. So if this ever happens, make it
|
||||
clear that something has gone wrong, rather than just silently
|
||||
continuing on non-debugging builds.
|
||||
|
||||
In any case, this shuts up clang.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
op.c | 14 ++++++--------
|
||||
1 file changed, 6 insertions(+), 8 deletions(-)
|
||||
|
||||
diff --git a/op.c b/op.c
|
||||
index c30c6b7c8f..2933e2ed7d 100644
|
||||
--- a/op.c
|
||||
+++ b/op.c
|
||||
@@ -18100,6 +18100,7 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
|
||||
else
|
||||
xop = INT2PTR(XOP *, SvIV(HeVAL(he)));
|
||||
}
|
||||
+
|
||||
{
|
||||
XOPRETANY any;
|
||||
if(field == XOPe_xop_ptr) {
|
||||
@@ -18121,7 +18122,10 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
|
||||
any.xop_peep = xop->xop_peep;
|
||||
break;
|
||||
default:
|
||||
- NOT_REACHED; /* NOTREACHED */
|
||||
+ field_panic:
|
||||
+ Perl_croak(aTHX_
|
||||
+ "panic: custom_op_get_field(): invalid field %d\n",
|
||||
+ (int)field);
|
||||
break;
|
||||
}
|
||||
} else {
|
||||
@@ -18139,17 +18143,11 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
|
||||
any.xop_peep = XOPd_xop_peep;
|
||||
break;
|
||||
default:
|
||||
- NOT_REACHED; /* NOTREACHED */
|
||||
+ goto field_panic;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
- /* On some platforms (HP-UX, IA64) gcc emits a warning for this function:
|
||||
- * op.c: In function 'Perl_custom_op_get_field':
|
||||
- * op.c:...: warning: 'any.xop_name' may be used uninitialized in this function [-Wmaybe-uninitialized]
|
||||
- * This is because on those platforms (with -DEBUGGING) NOT_REACHED
|
||||
- * expands to assert(0), which expands to ((0) ? (void)0 :
|
||||
- * __assert(...)), and gcc doesn't know that __assert can never return. */
|
||||
return any;
|
||||
}
|
||||
}
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,57 +0,0 @@
|
|||
From f877e124a20d4f94c82c36e6b7a99b4e9663e204 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Tue, 10 Nov 2020 15:50:27 +1100
|
||||
Subject: [PATCH] fetch magic on the first stacked filetest, not the last
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
fixes #18293
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp_sys.c | 2 +-
|
||||
t/op/filetest.t | 10 +++++++++-
|
||||
2 files changed, 10 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/pp_sys.c b/pp_sys.c
|
||||
index 66c5d9aade..5c9f768eaf 100644
|
||||
--- a/pp_sys.c
|
||||
+++ b/pp_sys.c
|
||||
@@ -3067,7 +3067,7 @@ S_try_amagic_ftest(pTHX_ char chr) {
|
||||
SV *const arg = *PL_stack_sp;
|
||||
|
||||
assert(chr != '?');
|
||||
- if (!(PL_op->op_private & OPpFT_STACKING)) SvGETMAGIC(arg);
|
||||
+ if (!(PL_op->op_private & OPpFT_STACKED)) SvGETMAGIC(arg);
|
||||
|
||||
if (SvAMAGIC(arg))
|
||||
{
|
||||
diff --git a/t/op/filetest.t b/t/op/filetest.t
|
||||
index fe9724c59a..7c471c050c 100644
|
||||
--- a/t/op/filetest.t
|
||||
+++ b/t/op/filetest.t
|
||||
@@ -9,7 +9,7 @@ BEGIN {
|
||||
set_up_inc(qw '../lib ../cpan/Perl-OSType/lib');
|
||||
}
|
||||
|
||||
-plan(tests => 57 + 27*14);
|
||||
+plan(tests => 58 + 27*14);
|
||||
|
||||
if ($^O =~ /MSWin32|cygwin|msys/ && !is_miniperl) {
|
||||
require Win32; # for IsAdminUser()
|
||||
@@ -385,3 +385,11 @@ SKIP: {
|
||||
ok(!-f "TEST\0-", '-f on name with \0');
|
||||
ok(!-r "TEST\0-", '-r on name with \0');
|
||||
}
|
||||
+
|
||||
+{
|
||||
+ # github #18293
|
||||
+ "" =~ /(.*)/;
|
||||
+ my $x = $1; # call magic on $1, setting the pv to ""
|
||||
+ "test.pl" =~ /(.*)/;
|
||||
+ ok(-f -r $1, "stacked handles on a name with magic");
|
||||
+}
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,54 +0,0 @@
|
|||
From ab307de390c3459badcc89b3d77542b5b871b2e8 Mon Sep 17 00:00:00 2001
|
||||
From: Richard Leach <richardleach@users.noreply.github.com>
|
||||
Date: Tue, 20 Oct 2020 18:16:38 +0100
|
||||
Subject: [PATCH 2/2] pp_split: add TonyC's stack-not-refcounted-suggestion and
|
||||
tests
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp.c | 5 ++++-
|
||||
t/op/split.t | 5 +++++
|
||||
2 files changed, 9 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/pp.c b/pp.c
|
||||
index ce16c56e63..5b5e163011 100644
|
||||
--- a/pp.c
|
||||
+++ b/pp.c
|
||||
@@ -6034,6 +6034,9 @@ PP(pp_split)
|
||||
oldsave = PL_savestack_ix;
|
||||
}
|
||||
|
||||
+ /* Some defence against stack-not-refcounted bugs */
|
||||
+ (void)sv_2mortal(SvREFCNT_inc_simple_NN(ary));
|
||||
+
|
||||
if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) {
|
||||
PUSHMARK(SP);
|
||||
XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg));
|
||||
@@ -6356,7 +6359,7 @@ PP(pp_split)
|
||||
}
|
||||
|
||||
PUTBACK;
|
||||
- LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */
|
||||
+ LEAVE_SCOPE(oldsave);
|
||||
SPAGAIN;
|
||||
if (realarray) {
|
||||
if (!mg) {
|
||||
diff --git a/t/op/split.t b/t/op/split.t
|
||||
index 1d78a45bde..7a321645ac 100644
|
||||
--- a/t/op/split.t
|
||||
+++ b/t/op/split.t
|
||||
@@ -703,3 +703,8 @@ fresh_perl_is('my @ary; @ary = split(/\w(?{ @ary[1000] = 1 })/, "abc");',
|
||||
fresh_perl_is('my @ary; @ary = split(/\w(?{ undef @ary })/, "abc");',
|
||||
'',{},'(@ary = split ...) survives an (undef @ary)');
|
||||
|
||||
+# check the (@ary = split) optimisation survives stack-not-refcounted bugs
|
||||
+fresh_perl_is('our @ary; @ary = split(/\w(?{ *ary = 0 })/, "abc");',
|
||||
+ '',{},'(@ary = split ...) survives @ary destruction via typeglob');
|
||||
+fresh_perl_is('my $ary = []; @$ary = split(/\w(?{ $ary = [] })/, "abc");',
|
||||
+ '',{},'(@ary = split ...) survives @ary destruction via reassignment');
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,71 +0,0 @@
|
|||
From b52b6c4029b51818442d64c6104d26e12e140f09 Mon Sep 17 00:00:00 2001
|
||||
From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com>
|
||||
Date: Thu, 5 Nov 2020 22:06:16 +0900
|
||||
Subject: [PATCH] t/op/inc.t, t/op/hexfp.t, t/op/sprintf2.t: Add missing d_
|
||||
prefixes for Config variable names.
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
t/op/hexfp.t | 2 +-
|
||||
t/op/inc.t | 4 ++--
|
||||
t/op/sprintf2.t | 4 ++--
|
||||
3 files changed, 5 insertions(+), 5 deletions(-)
|
||||
|
||||
diff --git a/t/op/hexfp.t b/t/op/hexfp.t
|
||||
index b0c85cfdc6..5fb80d3d74 100644
|
||||
--- a/t/op/hexfp.t
|
||||
+++ b/t/op/hexfp.t
|
||||
@@ -246,7 +246,7 @@ SKIP: {
|
||||
skip("non-80-bit-long-double", 4)
|
||||
unless ($Config{uselongdouble} &&
|
||||
($Config{nvsize} == 16 || $Config{nvsize} == 12) &&
|
||||
- ($Config{long_double_style_ieee_extended}));
|
||||
+ ($Config{d_long_double_style_ieee_extended}));
|
||||
is(0x1p-1074, 4.94065645841246544e-324);
|
||||
is(0x1p-1075, 2.47032822920623272e-324, '[perl #128919]');
|
||||
is(0x1p-1076, 1.23516411460311636e-324);
|
||||
diff --git a/t/op/inc.t b/t/op/inc.t
|
||||
index 0bb8b85b13..3d5cc024d3 100644
|
||||
--- a/t/op/inc.t
|
||||
+++ b/t/op/inc.t
|
||||
@@ -188,10 +188,10 @@ cmp_ok($a, '==', 2147483647, "postdecrement properly downgrades from double");
|
||||
|
||||
SKIP: {
|
||||
if ($Config{uselongdouble} &&
|
||||
- ($Config{long_double_style_ieee_doubledouble})) {
|
||||
+ ($Config{d_long_double_style_ieee_doubledouble})) {
|
||||
skip "the double-double format is weird", 1;
|
||||
}
|
||||
- unless ($Config{double_style_ieee}) {
|
||||
+ unless ($Config{d_double_style_ieee}) {
|
||||
skip "the doublekind $Config{doublekind} is not IEEE", 1;
|
||||
}
|
||||
|
||||
diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
|
||||
index bbc12ccd0a..38a550c281 100644
|
||||
--- a/t/op/sprintf2.t
|
||||
+++ b/t/op/sprintf2.t
|
||||
@@ -701,7 +701,7 @@ SKIP: {
|
||||
skip("uselongdouble=" . ($Config{uselongdouble} ? 'define' : 'undef')
|
||||
. " longdblkind=$Config{longdblkind} os=$^O", 6)
|
||||
unless ($Config{uselongdouble} &&
|
||||
- ($Config{long_double_style_ieee_doubledouble})
|
||||
+ ($Config{d_long_double_style_ieee_doubledouble})
|
||||
# Gating on 'linux' (ppc) here is due to the differing
|
||||
# double-double implementations: other (also big-endian)
|
||||
# double-double platforms (e.g. AIX on ppc or IRIX on mips)
|
||||
@@ -892,7 +892,7 @@ SKIP: {
|
||||
skip("non-80-bit-long-double", 17)
|
||||
unless ($Config{uselongdouble} &&
|
||||
($Config{nvsize} == 16 || $Config{nvsize} == 12) &&
|
||||
- ($Config{long_double_style_ieee_extended}));
|
||||
+ ($Config{d_long_double_style_ieee_extended}));
|
||||
|
||||
{
|
||||
# The last normal for this format.
|
||||
--
|
||||
2.25.4
|
||||
|
|
@ -1,11 +1,7 @@
|
|||
From f793042f2bac2ace9a5c0030b47b41c4db561a5b Mon Sep 17 00:00:00 2001
|
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
||||
Date: Fri, 6 Jun 2014 14:31:59 +0200
|
||||
From 8067179e65a28d91f00df7d36778229a07514471 Mon Sep 17 00:00:00 2001
|
||||
From: Jitka Plesnikova <jplesnik@redhat.com>
|
||||
Date: Thu, 29 Apr 2021 12:21:18 +0200
|
||||
Subject: [PATCH] Destroy {GDBM,NDBM,ODBM,SDBM}_File objects only from original
|
||||
thread context
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
This patch fixes a crash when destroing a hash tied to a *_File
|
||||
database after spawning a thread:
|
||||
|
@ -20,17 +16,17 @@ This crashed or paniced depending on how perl was configured.
|
|||
|
||||
Closes RT#61912.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
Updated original ppisar's patch for perl 5.18.2
|
||||
---
|
||||
ext/GDBM_File/GDBM_File.xs | 16 ++++++++++------
|
||||
ext/GDBM_File/GDBM_File.xs | 20 ++++++++++++--------
|
||||
ext/NDBM_File/NDBM_File.xs | 16 ++++++++++------
|
||||
ext/ODBM_File/ODBM_File.xs | 18 +++++++++++-------
|
||||
ext/SDBM_File/SDBM_File.xs | 4 +++-
|
||||
t/lib/dbmt_common.pl | 35 +++++++++++++++++++++++++++++++++++
|
||||
5 files changed, 69 insertions(+), 20 deletions(-)
|
||||
5 files changed, 71 insertions(+), 22 deletions(-)
|
||||
|
||||
diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
|
||||
index 33e08e2..7160f54 100644
|
||||
index cd0bb6f..0c395ac 100644
|
||||
--- a/ext/GDBM_File/GDBM_File.xs
|
||||
+++ b/ext/GDBM_File/GDBM_File.xs
|
||||
@@ -13,6 +13,7 @@
|
||||
|
@ -41,7 +37,7 @@ index 33e08e2..7160f54 100644
|
|||
GDBM_FILE dbp ;
|
||||
SV * filter[4];
|
||||
int filtering ;
|
||||
@@ -98,6 +99,7 @@ gdbm_TIEHASH(dbtype, name, read_write, m
|
||||
@@ -276,6 +277,7 @@ gdbm_TIEHASH(dbtype, name, read_write, mode)
|
||||
}
|
||||
if (dbp) {
|
||||
RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type));
|
||||
|
@ -49,29 +45,34 @@ index 33e08e2..7160f54 100644
|
|||
RETVAL->dbp = dbp;
|
||||
} else {
|
||||
RETVAL = NULL;
|
||||
@@ -118,12 +120,14 @@ gdbm_DESTROY(db)
|
||||
PREINIT:
|
||||
@@ -289,15 +291,17 @@ gdbm_DESTROY(db)
|
||||
PREINIT:
|
||||
int i = store_value;
|
||||
CODE:
|
||||
- gdbm_close(db);
|
||||
CODE:
|
||||
- if (gdbm_file_close(db)) {
|
||||
- croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno),
|
||||
- strerror(errno));
|
||||
+ if (db && db->owner == aTHX) {
|
||||
+ if (gdbm_file_close(db)) {
|
||||
+ croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno),
|
||||
+ strerror(errno));
|
||||
+ }
|
||||
+ do {
|
||||
+ if (db->filter[i])
|
||||
+ SvREFCNT_dec(db->filter[i]);
|
||||
+ } while (i-- > 0);
|
||||
+ safefree(db);
|
||||
}
|
||||
- do {
|
||||
- if (db->filter[i])
|
||||
- SvREFCNT_dec(db->filter[i]);
|
||||
- } while (i-- > 0);
|
||||
- safefree(db);
|
||||
+ if (db && db->owner == aTHX) {
|
||||
+ gdbm_close(db);
|
||||
+ do {
|
||||
+ if (db->filter[i])
|
||||
+ SvREFCNT_dec(db->filter[i]);
|
||||
+ } while (i-- > 0);
|
||||
+ safefree(db);
|
||||
+ }
|
||||
|
||||
#define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key)
|
||||
datum_value
|
||||
void
|
||||
gdbm_UNTIE(db, count)
|
||||
diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs
|
||||
index 52e60fc..af223e5 100644
|
||||
index eed671a..651fe0f 100644
|
||||
--- a/ext/NDBM_File/NDBM_File.xs
|
||||
+++ b/ext/NDBM_File/NDBM_File.xs
|
||||
@@ -33,6 +33,7 @@ END_EXTERN_C
|
||||
|
@ -103,7 +104,7 @@ index 52e60fc..af223e5 100644
|
|||
+ if (db && db->owner == aTHX) {
|
||||
+ dbm_close(db->dbp);
|
||||
+ do {
|
||||
+ if (db->filter[i])
|
||||
+ if (db->filter[i])
|
||||
+ SvREFCNT_dec(db->filter[i]);
|
||||
+ } while (i-- > 0);
|
||||
+ safefree(db);
|
||||
|
@ -112,7 +113,7 @@ index 52e60fc..af223e5 100644
|
|||
#define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key)
|
||||
datum_value
|
||||
diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
|
||||
index d1ece7f..f7e00a0 100644
|
||||
index 38e6dbf..4b15a42 100644
|
||||
--- a/ext/ODBM_File/ODBM_File.xs
|
||||
+++ b/ext/ODBM_File/ODBM_File.xs
|
||||
@@ -49,6 +49,7 @@ datum nextkey(datum key);
|
||||
|
@ -146,7 +147,7 @@ index d1ece7f..f7e00a0 100644
|
|||
+ dbmrefcnt--;
|
||||
+ dbmclose();
|
||||
+ do {
|
||||
+ if (db->filter[i])
|
||||
+ if (db->filter[i])
|
||||
+ SvREFCNT_dec(db->filter[i]);
|
||||
+ } while (i-- > 0);
|
||||
+ safefree(db);
|
||||
|
@ -155,7 +156,7 @@ index d1ece7f..f7e00a0 100644
|
|||
datum_value
|
||||
odbm_FETCH(db, key)
|
||||
diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs
|
||||
index 291e41b..0bdae9a 100644
|
||||
index 0df2855..0e2bd58 100644
|
||||
--- a/ext/SDBM_File/SDBM_File.xs
|
||||
+++ b/ext/SDBM_File/SDBM_File.xs
|
||||
@@ -10,6 +10,7 @@
|
||||
|
@ -166,7 +167,7 @@ index 291e41b..0bdae9a 100644
|
|||
DBM * dbp ;
|
||||
SV * filter[4];
|
||||
int filtering ;
|
||||
@@ -51,6 +52,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
|
||||
@@ -51,6 +52,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)
|
||||
}
|
||||
if (dbp) {
|
||||
RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
|
||||
|
@ -184,7 +185,7 @@ index 291e41b..0bdae9a 100644
|
|||
sdbm_close(db->dbp);
|
||||
do {
|
||||
diff --git a/t/lib/dbmt_common.pl b/t/lib/dbmt_common.pl
|
||||
index 5d4098c..a0a4d52 100644
|
||||
index 60c66ae..a7f81fe 100644
|
||||
--- a/t/lib/dbmt_common.pl
|
||||
+++ b/t/lib/dbmt_common.pl
|
||||
@@ -510,5 +510,40 @@ unlink <Op_dbmx*>, $Dfile;
|
||||
|
@ -229,5 +230,5 @@ index 5d4098c..a0a4d52 100644
|
|||
done_testing();
|
||||
1;
|
||||
--
|
||||
1.9.3
|
||||
2.26.3
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
From 6d9d949fb4962e32636aee48a948081d8936d318 Mon Sep 17 00:00:00 2001
|
||||
From: Jitka Plesnikova <jplesnik@redhat.com>
|
||||
Date: Wed, 11 Jan 2023 09:12:18 +0100
|
||||
Subject: [PATCH] Add definition of OPTIMIZE to .ph files
|
||||
|
||||
The fortify.h header includes a test to ensure that -O is used when
|
||||
compiling with _FORTIFY_SOURCE, and the header looks for OPTIMIZE, which
|
||||
is set by the compiler whenever -O is used. Perl translates this test
|
||||
to the .ph file, but nothing ever sets OPTIMIZE. This causes a warning
|
||||
for anything that uses features.ph.
|
||||
|
||||
_FORTIFY_SOURCE is defined in /usr/lib64/perl5/_h2ph_pre.ph which is
|
||||
generated by h2ph. It uses value of @Config{'ccsymbols', 'cppsymbols',
|
||||
'cppccsymbols'} which does not contain definition for OPTIMIZE.
|
||||
|
||||
The patch updated h2ph to add OPTIMIZE if -O is used.
|
||||
---
|
||||
utils/h2ph.PL | 5 +++++
|
||||
1 file changed, 5 insertions(+)
|
||||
|
||||
diff --git a/utils/h2ph.PL b/utils/h2ph.PL
|
||||
index afa53c2..3950d11 100644
|
||||
--- a/utils/h2ph.PL
|
||||
+++ b/utils/h2ph.PL
|
||||
@@ -865,6 +865,11 @@ sub _extract_cc_defines
|
||||
my $allsymbols = join " ",
|
||||
@Config{'ccsymbols', 'cppsymbols', 'cppccsymbols'};
|
||||
|
||||
+ # If optimizing -O2 is used, add the definition
|
||||
+ if ($Config{'ccflags'} =~ /(?:\s+|^)-O([\d]+)(?:\s+|$)/) {
|
||||
+ $allsymbols .= " __OPTIMIZE__=$1";
|
||||
+ }
|
||||
+
|
||||
# Split compiler pre-definitions into 'key=value' pairs:
|
||||
while ($allsymbols =~ /([^\s]+)=((\\\s|[^\s])+)/g) {
|
||||
$define{$1} = $2;
|
||||
--
|
||||
2.39.0
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
diff -up perl-5.38.0/locale.c.orig perl-5.38.0/locale.c
|
||||
--- perl-5.38.0/locale.c.orig 2023-09-25 13:41:37.090493602 +0200
|
||||
+++ perl-5.38.0/locale.c 2023-09-25 13:42:07.636750287 +0200
|
||||
@@ -5280,11 +5280,6 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
|
||||
DEBUG_Lv(PerlIO_printf(Perl_debug_log, "created C object %p\n",
|
||||
PL_C_locale_obj));
|
||||
|
||||
- /* Switch to using the POSIX 2008 interface now. This would happen below
|
||||
- * anyway, but deferring it can lead to leaks of memory that would also get
|
||||
- * malloc'd in the interim */
|
||||
- uselocale(PL_C_locale_obj);
|
||||
-
|
||||
# ifdef USE_LOCALE_NUMERIC
|
||||
|
||||
PL_underlying_numeric_obj = duplocale(PL_C_locale_obj);
|
2
sources
2
sources
|
@ -1 +1 @@
|
|||
SHA512 (perl-5.32.0.tar.xz) = 1540247415893bbd94dfeede7b4fba6052688dc0bf27ced817f448246fcdc6e9a6486abc34577dec5b00bf02ed607b2d24ccd4977c3b3c51e8e6edfc0b81c760
|
||||
SHA512 (perl-5.38.0.tar.xz) = 71beff7f6daa22a967972f5805daf2d4ff837a17e5ab808780f815d5914a67acf4f2e92acac0f2d8b24bdde4ceec0c2f7cb3029b5eadeeb30191f757e1bf0f9d
|
||||
|
|
Loading…
Reference in New Issue