Compare commits
17 Commits
master
...
openEuler-
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
11bd58d459 | ||
|
|
e4c7fa2ddb | ||
|
|
d8a6d9a4f1 | ||
|
|
1e526b337a | ||
|
|
d39156b214 | ||
|
|
942fd40843 | ||
|
|
c982477ca1 | ||
|
|
b629c4aae4 | ||
|
|
9558a16086 | ||
|
|
28590a488d | ||
|
|
c0fe0c501c | ||
|
|
2031042620 | ||
|
|
462cdd9cbb | ||
|
|
0a00666458 | ||
|
|
32b6f2d797 | ||
|
|
010bdd6d54 | ||
|
|
0a5b95149c |
@ -1,10 +0,0 @@
|
||||
--- a/regcomp.c 2018-05-21 20:29:23.000000000 +0800
|
||||
+++ b/regcomp-change.c 2019-04-11 09:51:08.493000000 +0800
|
||||
@@ -15591,7 +15591,6 @@ redo_curchar:
|
||||
if (UCHARAT(RExC_parse) != ')')
|
||||
vFAIL("Expecting close paren for wrapper for nested extended charclass");
|
||||
|
||||
- RExC_parse++;
|
||||
RExC_flags = save_flags;
|
||||
goto handle_operand;
|
||||
}
|
||||
@ -1,11 +0,0 @@
|
||||
--- a/t/re/reg_mesg.t 2018-05-21 20:29:23.000000000 +0800
|
||||
+++ b/t/re/reg_mesg-change.t 2019-04-11 09:54:59.622000000 +0800
|
||||
@@ -122,6 +122,8 @@ my $tab_hex = sprintf "%02X", ord("\t");
|
||||
#
|
||||
# The first set are those that should be fatal errors.
|
||||
|
||||
+my $bug133423 = "(?[(?^:(?[\\\x00]))\\]\x00|2[^^]\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80])R.\\670";
|
||||
+
|
||||
my @death =
|
||||
(
|
||||
'/[[=foo=]]/' => 'POSIX syntax [= =] is reserved for future extensions {#} m/[[=foo=]{#}]/',
|
||||
@ -1,10 +0,0 @@
|
||||
--- a/t/re/reg_mesg-change.t 2019-04-11 10:07:36.626000000 +0800
|
||||
+++ b/t/re/reg_mesg.t 2019-04-11 10:08:20.032000000 +0800
|
||||
@@ -309,6 +309,7 @@ my @death =
|
||||
'/\A{/' => 'Unescaped left brace in regex is illegal here {#} m/\A{{#}/',
|
||||
'/(?<=/' => 'Sequence (?... not terminated {#} m/(?<={#}/', # [perl #128170]
|
||||
'/\p{vertical tab}/' => 'Can\'t find Unicode property definition "vertical tab" {#} m/\\p{vertical tab}{#}/', # [perl #132055]
|
||||
+ "/$bug133423/" => "Operand with no preceding operator {#} m/(?[(?^:(?[\\\0]))\\{#}]\0|2[^^]\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80])R.\\670/",
|
||||
|
||||
);
|
||||
|
||||
@ -1,93 +0,0 @@
|
||||
From 7da8e27b9d7d2be4e770d074405ddb9941e6c8b7 Mon Sep 17 00:00:00 2001
|
||||
From: Karl Williamson <khw@cpan.org>
|
||||
Date: Thu, 16 Aug 2018 16:14:01 -0600
|
||||
Subject: [PATCH] Fix script run bug '1' followed by Thai digit
|
||||
|
||||
This does not have a ticket, but was pointed out in
|
||||
http://nntp.perl.org/group/perl.perl5.porters/251870
|
||||
|
||||
The logic for deciding if it was needed to check if a character is a
|
||||
digit was flawed.
|
||||
---
|
||||
regexec.c | 46 +++++++++++++++++++++++++++++++---------------
|
||||
t/re/script_run.t | 5 +++++
|
||||
2 files changed, 36 insertions(+), 15 deletions(-)
|
||||
|
||||
diff --git a/regexec.c b/regexec.c
|
||||
index 6f39670c4a..c927abc611 100644
|
||||
--- a/regexec.c
|
||||
+++ b/regexec.c
|
||||
@@ -10626,23 +10626,39 @@ Perl_isSCRIPT_RUN(pTHX_ const U8 * s, const U8 * send, const bool utf8_target)
|
||||
scripts_match:
|
||||
|
||||
/* Here, the script of the character is compatible with that of the
|
||||
- * run. Either they match exactly, or one or both can be any of
|
||||
- * several scripts, and the intersection is not empty. If the
|
||||
- * character is not a decimal digit, we are done with it. Otherwise,
|
||||
- * it could still fail if it is from a different set of 10 than seen
|
||||
- * already (or we may not have seen any, and we need to set the
|
||||
- * sequence). If we have determined a single script and that script
|
||||
- * only has one set of digits (almost all scripts are like that), then
|
||||
- * this isn't a problem, as any digit must come from the same sequence.
|
||||
- * The only scripts that have multiple sequences have been constructed
|
||||
- * to be 0 in 'script_zeros[]'.
|
||||
+ * run. That means that in most cases, it continues the script run.
|
||||
+ * Either it and the run match exactly, or one or both can be in any of
|
||||
+ * several scripts, and the intersection is not empty. But if the
|
||||
+ * character is a decimal digit, we need further handling. If we
|
||||
+ * haven't seen a digit before, it would establish what set of 10 all
|
||||
+ * must come from; and if we have established a set, we need to check
|
||||
+ * that this is in it.
|
||||
*
|
||||
- * Here we check if it is a digit. */
|
||||
+ * But there are cases we can rule out without having to look up if
|
||||
+ * this is a digit:
|
||||
+ * a. All instances of [0-9] have been dealt with earlier.
|
||||
+ * b. The next digit encoded by Unicode is 1600 code points further
|
||||
+ * on, so if the code point in this loop iteration is less than
|
||||
+ * that, it isn't a digit.
|
||||
+ * c. Most scripts that have digits have a single set of 10. If
|
||||
+ * we've encountered a digit in such a script, 'zero_of_run' is
|
||||
+ * set to the code point (call it z) whose numeric value is 0.
|
||||
+ * If the code point in this loop iteration is in the range
|
||||
+ * z..z+9, it is in the script's set of 10, and we've actually
|
||||
+ * handled it earlier in this function and won't reach this
|
||||
+ * point. But, code points in that script that aren't in that
|
||||
+ * range can't be digits, so we don't have to look any such up.
|
||||
+ * We can tell if this script is such a one by looking at
|
||||
+ * 'script_zeros[]' for it. It is non-zero iff it has a single
|
||||
+ * set of digits. This rule doesn't apply if we haven't narrowed
|
||||
+ * down the possible scripts to a single one yet. Nor if the
|
||||
+ * zero of the run is '0', as that also hasn't narrowed things
|
||||
+ * down completely */
|
||||
if ( cp >= FIRST_NON_ASCII_DECIMAL_DIGIT
|
||||
- && ( ( zero_of_run == 0
|
||||
- || ( ( script_of_char >= 0
|
||||
- && script_zeros[script_of_char] == 0)
|
||||
- || intersection))))
|
||||
+ && ( intersection
|
||||
+ || script_of_char < 0 /* Also implies an intersection */
|
||||
+ || zero_of_run == '0'
|
||||
+ || script_zeros[script_of_char] == 0))
|
||||
{
|
||||
SSize_t range_zero_index;
|
||||
range_zero_index = _invlist_search(decimals_invlist, cp);
|
||||
diff --git a/t/re/script_run.t b/t/re/script_run.t
|
||||
index ca234d9d4e..10c71034c4 100644
|
||||
--- a/t/re/script_run.t
|
||||
+++ b/t/re/script_run.t
|
||||
@@ -84,6 +84,11 @@ foreach my $type ('script_run', 'sr', 'atomic_script_run', 'asr') {
|
||||
|
||||
# From UTS 39
|
||||
like("写真だけの結婚式", $script_run, "Mixed Hiragana and Han");
|
||||
+
|
||||
+ unlike "\N{THAI DIGIT FIVE}1", $script_run, "Thai digit followed by '1'";
|
||||
+ unlike "1\N{THAI DIGIT FIVE}", $script_run, "'1' followed by Thai digit ";
|
||||
+ unlike "\N{BENGALI DIGIT ZERO}\N{CHAKMA DIGIT SEVEN}", $script_run,
|
||||
+ "Two digits in same extended script but from different sets of 10";
|
||||
}
|
||||
|
||||
# Until fixed, this was skipping the '['
|
||||
--
|
||||
2.19.1
|
||||
|
||||
@ -1,175 +0,0 @@
|
||||
From 34716e2a6ee2af96078d62b065b7785c001194be Mon Sep 17 00:00:00 2001
|
||||
From: David Mitchell <davem@iabyn.com>
|
||||
Date: Fri, 29 Jun 2018 13:37:03 +0100
|
||||
Subject: [PATCH] Perl_my_setenv(); handle integer wrap
|
||||
|
||||
RT #133204
|
||||
|
||||
Wean this function off int/I32 and onto UV/Size_t.
|
||||
Also, replace all malloc-ish calls with a wrapper that does
|
||||
overflow checks,
|
||||
|
||||
In particular, it was doing (nlen + vlen + 2) which could wrap when
|
||||
the combined length of the environment variable name and value
|
||||
exceeded around 0x7fffffff.
|
||||
|
||||
The wrapper check function is probably overkill, but belt and braces...
|
||||
|
||||
NB this function has several variant parts, #ifdef'ed by platform
|
||||
type; I have blindly changed the parts that aren't compiled under linux.
|
||||
---
|
||||
util.c | 76 ++++++++++++++++++++++++++++++++++++++++------------------
|
||||
1 file changed, 53 insertions(+), 23 deletions(-)
|
||||
|
||||
diff --git a/util.c b/util.c
|
||||
index 7282dd9cfe..c5c7becc0f 100644
|
||||
--- a/util.c
|
||||
+++ b/util.c
|
||||
@@ -2061,8 +2061,40 @@ Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits,
|
||||
*(s+(nlen+1+vlen)) = '\0'
|
||||
|
||||
#ifdef USE_ENVIRON_ARRAY
|
||||
- /* VMS' my_setenv() is in vms.c */
|
||||
+
|
||||
+/* small wrapper for use by Perl_my_setenv that mallocs, or reallocs if
|
||||
+ * 'current' is non-null, with up to three sizes that are added together.
|
||||
+ * It handles integer overflow.
|
||||
+ */
|
||||
+static char *
|
||||
+S_env_alloc(void *current, Size_t l1, Size_t l2, Size_t l3, Size_t size)
|
||||
+{
|
||||
+ void *p;
|
||||
+ Size_t sl, l = l1 + l2;
|
||||
+
|
||||
+ if (l < l2)
|
||||
+ goto panic;
|
||||
+ l += l3;
|
||||
+ if (l < l3)
|
||||
+ goto panic;
|
||||
+ sl = l * size;
|
||||
+ if (sl < l)
|
||||
+ goto panic;
|
||||
+
|
||||
+ p = current
|
||||
+ ? safesysrealloc(current, sl)
|
||||
+ : safesysmalloc(sl);
|
||||
+ if (p)
|
||||
+ return (char*)p;
|
||||
+
|
||||
+ panic:
|
||||
+ croak_memory_wrap();
|
||||
+}
|
||||
+
|
||||
+
|
||||
+/* VMS' my_setenv() is in vms.c */
|
||||
#if !defined(WIN32) && !defined(NETWARE)
|
||||
+
|
||||
void
|
||||
Perl_my_setenv(pTHX_ const char *nam, const char *val)
|
||||
{
|
||||
@@ -2078,28 +2110,27 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
|
||||
#ifndef PERL_USE_SAFE_PUTENV
|
||||
if (!PL_use_safe_putenv) {
|
||||
/* most putenv()s leak, so we manipulate environ directly */
|
||||
- I32 i;
|
||||
- const I32 len = strlen(nam);
|
||||
- int nlen, vlen;
|
||||
+ UV i;
|
||||
+ Size_t vlen, nlen = strlen(nam);
|
||||
|
||||
/* where does it go? */
|
||||
for (i = 0; environ[i]; i++) {
|
||||
- if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
|
||||
+ if (strnEQ(environ[i], nam, nlen) && environ[i][nlen] == '=')
|
||||
break;
|
||||
}
|
||||
|
||||
if (environ == PL_origenviron) { /* need we copy environment? */
|
||||
- I32 j;
|
||||
- I32 max;
|
||||
+ UV j, max;
|
||||
char **tmpenv;
|
||||
|
||||
max = i;
|
||||
while (environ[max])
|
||||
max++;
|
||||
- tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*));
|
||||
+ /* XXX shouldn't that be max+1 rather than max+2 ??? - DAPM */
|
||||
+ tmpenv = (char**)S_env_alloc(NULL, max, 2, 0, sizeof(char*));
|
||||
for (j=0; j<max; j++) { /* copy environment */
|
||||
- const int len = strlen(environ[j]);
|
||||
- tmpenv[j] = (char*)safesysmalloc((len+1)*sizeof(char));
|
||||
+ const Size_t len = strlen(environ[j]);
|
||||
+ tmpenv[j] = S_env_alloc(NULL, len, 1, 0, 1);
|
||||
Copy(environ[j], tmpenv[j], len+1, char);
|
||||
}
|
||||
tmpenv[max] = NULL;
|
||||
@@ -2118,15 +2149,15 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
|
||||
#endif
|
||||
}
|
||||
if (!environ[i]) { /* does not exist yet */
|
||||
- environ = (char**)safesysrealloc(environ, (i+2) * sizeof(char*));
|
||||
+ environ = (char**)S_env_alloc(environ, i, 2, 0, sizeof(char*));
|
||||
environ[i+1] = NULL; /* make sure it's null terminated */
|
||||
}
|
||||
else
|
||||
safesysfree(environ[i]);
|
||||
- nlen = strlen(nam);
|
||||
+
|
||||
vlen = strlen(val);
|
||||
|
||||
- environ[i] = (char*)safesysmalloc((nlen+vlen+2) * sizeof(char));
|
||||
+ environ[i] = S_env_alloc(NULL, nlen, vlen, 2, 1);
|
||||
/* all that work just for this */
|
||||
my_setenv_format(environ[i], nam, nlen, val, vlen);
|
||||
} else {
|
||||
@@ -2150,22 +2181,21 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
|
||||
if (environ) /* old glibc can crash with null environ */
|
||||
(void)unsetenv(nam);
|
||||
} else {
|
||||
- const int nlen = strlen(nam);
|
||||
- const int vlen = strlen(val);
|
||||
- char * const new_env =
|
||||
- (char*)safesysmalloc((nlen + vlen + 2) * sizeof(char));
|
||||
+ const Size_t nlen = strlen(nam);
|
||||
+ const Size_t vlen = strlen(val);
|
||||
+ char * const new_env = S_env_alloc(NULL, nlen, vlen, 2, 1);
|
||||
my_setenv_format(new_env, nam, nlen, val, vlen);
|
||||
(void)putenv(new_env);
|
||||
}
|
||||
# else /* ! HAS_UNSETENV */
|
||||
char *new_env;
|
||||
- const int nlen = strlen(nam);
|
||||
- int vlen;
|
||||
+ const Size_t nlen = strlen(nam);
|
||||
+ Size_t vlen;
|
||||
if (!val) {
|
||||
val = "";
|
||||
}
|
||||
vlen = strlen(val);
|
||||
- new_env = (char*)safesysmalloc((nlen + vlen + 2) * sizeof(char));
|
||||
+ new_env = S_env_alloc(NULL, nlen, vlen, 2, 1);
|
||||
/* all that work just for this */
|
||||
my_setenv_format(new_env, nam, nlen, val, vlen);
|
||||
(void)putenv(new_env);
|
||||
@@ -2187,14 +2217,14 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
|
||||
{
|
||||
dVAR;
|
||||
char *envstr;
|
||||
- const int nlen = strlen(nam);
|
||||
- int vlen;
|
||||
+ const Size_t nlen = strlen(nam);
|
||||
+ Size_t vlen;
|
||||
|
||||
if (!val) {
|
||||
val = "";
|
||||
}
|
||||
vlen = strlen(val);
|
||||
- Newx(envstr, nlen+vlen+2, char);
|
||||
+ envstr = S_env_alloc(NULL, nlen, vlen, 2, 1);
|
||||
my_setenv_format(envstr, nam, nlen, val, vlen);
|
||||
(void)PerlEnv_putenv(envstr);
|
||||
Safefree(envstr);
|
||||
--
|
||||
2.19.1
|
||||
|
||||
40
backport-aarch64-ilp32-support.patch
Normal file
40
backport-aarch64-ilp32-support.patch
Normal file
@ -0,0 +1,40 @@
|
||||
From 55a0aab68d5ce90ce8bb7442ba61639c49e50c1d Mon Sep 17 00:00:00 2001
|
||||
From: root <root@localhost.localdomain>
|
||||
Date: Mon, 21 Sep 2020 09:45:33 +0800
|
||||
Subject: [PATCH] aarch64 ilp32 support
|
||||
https://build.opensuse.org/package/view_file/devel:ARM:Factory:Contrib:ILP32/perl/aarch64-ilp32.patch?expand=1
|
||||
---
|
||||
hints/linux.sh | 17 +++++++++++++++++
|
||||
1 file changed, 17 insertions(+)
|
||||
|
||||
diff --git a/hints/linux.sh b/hints/linux.sh
|
||||
index 3f38ea0..19dd165 100644
|
||||
--- a/hints/linux.sh
|
||||
+++ b/hints/linux.sh
|
||||
@@ -298,6 +298,23 @@ sparc*)
|
||||
;;
|
||||
esac
|
||||
|
||||
+case $archname in
|
||||
+ arch64-linux)
|
||||
+ cat >try.c <<'EOM'
|
||||
+#include <stdlib.h>
|
||||
+main() {
|
||||
+int ilp32 = 0;
|
||||
+#ifdef __ILP32__
|
||||
+ilp32 = 1;
|
||||
+#endif
|
||||
+exit(!ilp32);
|
||||
+EOM
|
||||
+if ${cc:-gcc} $ccflags $ldflags try.c >/dev/null 2>&1 && $run ./a.out; then
|
||||
+ archname=aarch64-ilp32-linux
|
||||
+fi
|
||||
+ ;;
|
||||
+esac
|
||||
+
|
||||
# SuSE8.2 has /usr/lib/libndbm* which are ld scripts rather than
|
||||
# true libraries. The scripts cause binding against static
|
||||
# version of -lgdbm which is a bad idea. So if we have 'nm'
|
||||
--
|
||||
2.23.0
|
||||
|
||||
@ -0,0 +1,65 @@
|
||||
From 9644657c4 10326749fd321d9c24944ec25afad2f Mon Sep 17 00:00:00 2001
|
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
||||
Date: Thu, 20 Jun 2013 15:22:53 +0200
|
||||
Subject: [PATCH] Install libperl.so to shrpdir on Linux
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Reason:Install libperl.so to shrpdir on Linux
|
||||
Conflict:NA
|
||||
Reference:https://src.fedoraproject.org/rpms/perl/blob/master/f/perl-5.22.0-Install-libperl.so-to-shrpdir-on-Linux.patch
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
Configure | 7 ++++---
|
||||
Makefile.SH | 2 +-
|
||||
2 files changed, 5 insertions(+), 4 deletions(-)
|
||||
|
||||
diff --git a/Configure b/Configure
|
||||
index 2f30261..825496e 100755
|
||||
--- a/Configure
|
||||
+++ b/Configure
|
||||
@@ -8762,7 +8762,9 @@ esac
|
||||
|
||||
# Detect old use of shrpdir via undocumented Configure -Dshrpdir
|
||||
case "$shrpdir" in
|
||||
-'') ;;
|
||||
+'')
|
||||
+shrpdir=$archlibexp/CORE
|
||||
+;;
|
||||
*) $cat >&4 <<EOM
|
||||
WARNING: Use of the shrpdir variable for the installation location of
|
||||
the shared $libperl is not supported. It was never documented and
|
||||
@@ -8792,7 +8794,6 @@ esac
|
||||
# Add $xxx to ccdlflags.
|
||||
# If we can't figure out a command-line option, use $shrpenv to
|
||||
# set env LD_RUN_PATH. The main perl makefile uses this.
|
||||
-shrpdir=$archlibexp/CORE
|
||||
xxx=''
|
||||
tmp_shrpenv=''
|
||||
if "$useshrplib"; then
|
||||
@@ -8807,7 +8808,7 @@ if "$useshrplib"; then
|
||||
xxx="-Wl,-R$shrpdir"
|
||||
;;
|
||||
bsdos|linux|irix*|dec_osf|gnu*|haiku)
|
||||
- xxx="-Wl,-rpath,$shrpdir"
|
||||
+ # We want standard path
|
||||
;;
|
||||
hpux*)
|
||||
# hpux doesn't like the default, either.
|
||||
diff --git a/Makefile.SH b/Makefile.SH
|
||||
index 7733a32..a481183 100755
|
||||
--- a/Makefile.SH
|
||||
+++ b/Makefile.SH
|
||||
@@ -288,7 +288,7 @@ ranlib = $ranlib
|
||||
# installman commandline.
|
||||
bin = $installbin
|
||||
scriptdir = $scriptdir
|
||||
-shrpdir = $archlibexp/CORE
|
||||
+shrpdir = $shrpdir
|
||||
privlib = $installprivlib
|
||||
man1dir = $man1dir
|
||||
man1ext = $man1ext
|
||||
--
|
||||
1.8.1.4
|
||||
@ -1,54 +1,60 @@
|
||||
From fe7ae3db489775f409b9284c5e81ce91ab8578da Mon Sep 17 00:00:00 2001
|
||||
From fa2f0dd5a7767223df10149d3f16d7ed7013e16f Mon Sep 17 00:00:00 2001
|
||||
From: Torsten Veller <tove@gentoo.org>
|
||||
Date: Mon, 30 Dec 2019 15:10:30 +0800
|
||||
Subject: [PATCH] create libperl soname
|
||||
Date: Sat, 14 Apr 2012 13:49:18 +0200
|
||||
Subject: Set libperl soname
|
||||
|
||||
See details: https://bugs.gentoo.org/286840
|
||||
Bug-Gentoo: https://bugs.gentoo.org/286840
|
||||
|
||||
Patch-Name: gentoo/create_libperl_soname.diff
|
||||
---
|
||||
Makefile.SH | 8 +++++++-
|
||||
1 file changed, 7 insertions(+), 1 deletion(-)
|
||||
Makefile.SH | 9 +++++++--
|
||||
1 file changed, 7 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/Makefile.SH b/Makefile.SH
|
||||
index 123903d..e73f0ec 100755
|
||||
index 3f1851d..ac2903b 100755
|
||||
--- a/Makefile.SH
|
||||
+++ b/Makefile.SH
|
||||
@@ -68,7 +68,7 @@ true)
|
||||
${api_revision}.${api_version}.${api_subversion} \
|
||||
-current_version \
|
||||
${revision}.${patchlevel}.${subversion} \
|
||||
- -install_name \$(shrpdir)/\$@"
|
||||
+ -install_name \$(shrpdir)/libperl.${revision}.${patchlevel}.dylib"
|
||||
@@ -70,11 +70,11 @@ true)
|
||||
${revision}.${patchlevel}.${subversion}"
|
||||
case "$osvers" in
|
||||
1[5-9]*|[2-9]*)
|
||||
- shrpldflags="$shrpldflags -install_name `pwd`/\$@ -Xlinker -headerpad_max_install_names"
|
||||
+ shrpldflags="$shrpldflags -install_name `pwd`/libperl.${revision}.${patchlevel}.dylib -Xlinker -headerpad_max_install_names"
|
||||
exeldflags="-Xlinker -headerpad_max_install_names"
|
||||
;;
|
||||
*)
|
||||
- shrpldflags="$shrpldflags -install_name \$(shrpdir)/\$@"
|
||||
+ shrpldflags="$shrpldflags -install_name \$(shrpdir)/libperl.${revision}.${patchlevel}.dylib"
|
||||
;;
|
||||
esac
|
||||
;;
|
||||
cygwin*)
|
||||
shrpldflags="$shrpldflags -Wl,--out-implib=libperl.dll.a -Wl,--image-base,0x52000000"
|
||||
@@ -76,13 +76,16 @@ true)
|
||||
@@ -84,13 +84,15 @@ true)
|
||||
;;
|
||||
sunos*)
|
||||
linklibperl="-lperl"
|
||||
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||
;;
|
||||
netbsd*|freebsd[234]*|openbsd*|dragonfly*|bitrig*)
|
||||
linklibperl="-L. -lperl"
|
||||
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||
;;
|
||||
interix*)
|
||||
linklibperl="-L. -lperl"
|
||||
shrpldflags="$shrpldflags -Wl,--image-base,0x57000000"
|
||||
+ shrpldflags="$shrpldflags -Wl,--image-base,0x57000000 -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||
- shrpldflags="$shrpldflags -Wl,--image-base,0x57000000"
|
||||
+ shrpldflags="$shrpldflags -Wl,--image-base,0x57000000 -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||
;;
|
||||
aix*)
|
||||
case "$cc" in
|
||||
@@ -120,6 +123,9 @@ true)
|
||||
@@ -128,6 +130,9 @@ true)
|
||||
linklibperl='libperl.x'
|
||||
DPERL_EXTERNAL_GLOB=''
|
||||
;;
|
||||
+ linux*)
|
||||
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||
+ ;;
|
||||
+ linux*)
|
||||
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||
+ ;;
|
||||
esac
|
||||
case "$ldlibpthname" in
|
||||
'') ;;
|
||||
--
|
||||
1.8.3.1
|
||||
2.23.0
|
||||
|
||||
|
||||
@ -1,56 +0,0 @@
|
||||
From 12cad9bd99725bba72029e2651b2b7f0cab2e0b0 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Mon, 20 Aug 2018 16:31:45 +1000
|
||||
Subject: [PATCH] (perl #132655) nul terminate result of unpack "u" of invalid
|
||||
data
|
||||
|
||||
In the given test case, Perl_atof2() would run off the end of the PV,
|
||||
producing an error from ASAN.
|
||||
---
|
||||
pp_pack.c | 5 ++++-
|
||||
t/op/pack.t | 9 ++++++++-
|
||||
2 files changed, 12 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/pp_pack.c b/pp_pack.c
|
||||
index 5e9cc64301..f8be9d48ae 100644
|
||||
--- a/pp_pack.c
|
||||
+++ b/pp_pack.c
|
||||
@@ -1727,7 +1727,10 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
|
||||
if (!checksum) {
|
||||
const STRLEN l = (STRLEN) (strend - s) * 3 / 4;
|
||||
sv = sv_2mortal(newSV(l));
|
||||
- if (l) SvPOK_on(sv);
|
||||
+ if (l) {
|
||||
+ SvPOK_on(sv);
|
||||
+ *SvEND(sv) = '\0';
|
||||
+ }
|
||||
}
|
||||
|
||||
/* Note that all legal uuencoded strings are ASCII printables, so
|
||||
diff --git a/t/op/pack.t b/t/op/pack.t
|
||||
index cf0e286509..bb9f865091 100644
|
||||
--- a/t/op/pack.t
|
||||
+++ b/t/op/pack.t
|
||||
@@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' :
|
||||
my $no_signedness = $] > 5.009 ? '' :
|
||||
"Signed/unsigned pack modifiers not available on this perl";
|
||||
|
||||
-plan tests => 14717;
|
||||
+plan tests => 14718;
|
||||
|
||||
use strict;
|
||||
use warnings qw(FATAL all);
|
||||
@@ -2081,3 +2081,10 @@ SKIP:
|
||||
fresh_perl_like('pack "c10f1073741824"', qr/Out of memory during pack/, { stderr => 1 },
|
||||
"integer overflow calculating allocation (multiply)");
|
||||
}
|
||||
+
|
||||
+{
|
||||
+ # [perl #132655] heap-buffer-overflow READ of size 11
|
||||
+ # only expect failure under ASAN (and maybe valgrind)
|
||||
+ fresh_perl_is('0.0 + unpack("u", "ab")', "", { stderr => 1 },
|
||||
+ "ensure unpack u of invalid data nul terminates result");
|
||||
+}
|
||||
--
|
||||
2.19.1
|
||||
|
||||
@ -1,97 +0,0 @@
|
||||
From 3d5e9c119db6b727684fe75dfcfe5831c4351bec Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Mon, 2 Jul 2018 10:43:19 +1000
|
||||
Subject: [PATCH] (perl #133314) always close the directory handle on clean up
|
||||
|
||||
Previously the directory handle was only closed if the rest of the
|
||||
magic free clean up is done, but in most success cases that code
|
||||
doesn't run, leaking the directory handle.
|
||||
|
||||
So always close the directory if our AV is available.
|
||||
---
|
||||
doio.c | 56 +++++++++++++++++++++++++++++++-------------------------
|
||||
1 file changed, 31 insertions(+), 25 deletions(-)
|
||||
|
||||
diff --git a/doio.c b/doio.c
|
||||
index 4b8923f77c..16daf9fd11 100644
|
||||
--- a/doio.c
|
||||
+++ b/doio.c
|
||||
@@ -1163,44 +1163,50 @@ S_argvout_free(pTHX_ SV *io, MAGIC *mg) {
|
||||
|
||||
/* mg_obj can be NULL if a thread is created with the handle open, in which
|
||||
case we leave any clean up to the parent thread */
|
||||
- if (mg->mg_obj && IoIFP(io)) {
|
||||
- SV **pid_psv;
|
||||
+ if (mg->mg_obj) {
|
||||
#ifdef ARGV_USE_ATFUNCTIONS
|
||||
SV **dir_psv;
|
||||
DIR *dir;
|
||||
+
|
||||
+ dir_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_DIRP, FALSE);
|
||||
+ assert(dir_psv && *dir_psv && SvIOK(*dir_psv));
|
||||
+ dir = INT2PTR(DIR *, SvIV(*dir_psv));
|
||||
#endif
|
||||
- PerlIO *iop = IoIFP(io);
|
||||
+ if (IoIFP(io)) {
|
||||
+ SV **pid_psv;
|
||||
+ PerlIO *iop = IoIFP(io);
|
||||
|
||||
- assert(SvTYPE(mg->mg_obj) == SVt_PVAV);
|
||||
+ assert(SvTYPE(mg->mg_obj) == SVt_PVAV);
|
||||
|
||||
- pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE);
|
||||
+ pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE);
|
||||
|
||||
- assert(pid_psv && *pid_psv);
|
||||
+ assert(pid_psv && *pid_psv);
|
||||
|
||||
- if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) {
|
||||
- /* if we get here the file hasn't been closed explicitly by the
|
||||
- user and hadn't been closed implicitly by nextargv(), so
|
||||
- abandon the edit */
|
||||
- SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
|
||||
- const char *temp_pv = SvPVX(*temp_psv);
|
||||
+ if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) {
|
||||
+ /* if we get here the file hasn't been closed explicitly by the
|
||||
+ user and hadn't been closed implicitly by nextargv(), so
|
||||
+ abandon the edit */
|
||||
+ SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
|
||||
+ const char *temp_pv = SvPVX(*temp_psv);
|
||||
|
||||
- assert(temp_psv && *temp_psv && SvPOK(*temp_psv));
|
||||
- (void)PerlIO_close(iop);
|
||||
- IoIFP(io) = IoOFP(io) = NULL;
|
||||
+ assert(temp_psv && *temp_psv && SvPOK(*temp_psv));
|
||||
+ (void)PerlIO_close(iop);
|
||||
+ IoIFP(io) = IoOFP(io) = NULL;
|
||||
#ifdef ARGV_USE_ATFUNCTIONS
|
||||
- dir_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_DIRP, FALSE);
|
||||
- assert(dir_psv && *dir_psv && SvIOK(*dir_psv));
|
||||
- dir = INT2PTR(DIR *, SvIV(*dir_psv));
|
||||
- if (dir) {
|
||||
- if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 &&
|
||||
- NotSupported(errno))
|
||||
- (void)UNLINK(temp_pv);
|
||||
- closedir(dir);
|
||||
- }
|
||||
+ if (dir) {
|
||||
+ if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 &&
|
||||
+ NotSupported(errno))
|
||||
+ (void)UNLINK(temp_pv);
|
||||
+ }
|
||||
#else
|
||||
- (void)UNLINK(temp_pv);
|
||||
+ (void)UNLINK(temp_pv);
|
||||
#endif
|
||||
+ }
|
||||
}
|
||||
+#ifdef ARGV_USE_ATFUNCTIONS
|
||||
+ if (dir)
|
||||
+ closedir(dir);
|
||||
+#endif
|
||||
}
|
||||
|
||||
return 0;
|
||||
--
|
||||
2.19.1
|
||||
|
||||
Binary file not shown.
95
perl.spec
95
perl.spec
@ -17,8 +17,8 @@
|
||||
Name: perl
|
||||
License: (GPL+ or Artistic) and (GPLv2+ or Artistic) and MIT and UCD and Public Domain and BSD
|
||||
Epoch: 4
|
||||
Version: 5.28.0
|
||||
Release: 434
|
||||
Version: 5.28.3
|
||||
Release: 7
|
||||
Summary: A highly capable, feature-rich programming language
|
||||
Url: https://www.perl.org/
|
||||
Source0: https://www.cpan.org/src/5.0/%{name}-%{version}.tar.xz
|
||||
@ -33,49 +33,42 @@ Patch5: create-libperl-soname.patch
|
||||
Patch8: perl-5.18.2-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch
|
||||
# PATCH-FIX-OPENEULER--RT#133295
|
||||
Patch12: delete-ext-GDBM_File-t-fatal.t.patch
|
||||
# PATCH-FIX-UPSTREAM--RT#133204, upstream 5.29.0
|
||||
Patch13: Perl_my_setenv-handle-integer-wrap.patch
|
||||
# PATCH-FIX-UPSTREAM-- upstream 5.29.0
|
||||
Patch14: regexec.c-Call-macro-with-correct-args.patch
|
||||
# PATCH-FIX-UPSTREAM-- upstream 5.29.0
|
||||
Patch15: perl.h-Add-parens-around-macro-arguments.patch
|
||||
# PATCH-FIX-UPSTREAM--RT#133368, upstream 5.29.0
|
||||
Patch16: treat-when-index-1-as-a-boolean-expression.patch
|
||||
# PATCH-FIX-UPSTREAM-- upstream 5.29.0
|
||||
Patch17: locale.c-Fix-conditional-compilation.patch
|
||||
# PATCH-FIX-UPSTREAM--RT#133314, upstream 5.29.1
|
||||
Patch18: perl-133314-test-for-handle-leaks-from-in-place-edit.patch
|
||||
Patch19: perl-133314-always-close-the-directory-handle-on-cle.patch
|
||||
# PATCH-FIX-UPSTREAM--Fix buffer overrun, upstream 5.29.1
|
||||
Patch20: utf8.c-Make-safer-a-deprecated-function.patch
|
||||
# PATCH-FIX-UPSTREAM--Fix time race, upstream 5.29.1
|
||||
Patch21: Time-HiRes-t-itimer.t-avoid-race-condition.patch
|
||||
# PATCH-FIX-UPSTREAM-- upstream 5.29.1
|
||||
Patch22: Fix-script-run-bug-1-followed-by-Thai-digit.patch
|
||||
# PATCH-FIX-UPSTREAM-- upstream 5.29.1
|
||||
Patch23: Update-Time-Piece-to-CPAN-version-1.33.patch
|
||||
# PATCH-FIX-UPSTREAM-- RT#133441, upstream 5.29.2
|
||||
Patch24: multiconcat-mutator-not-seen-in-lex.patch
|
||||
# PATCH-FIX-UPSTREAM-- RT#132683, upstream 5.29.2
|
||||
Patch25: perl-132683-don-t-try-to-convert-PL_sv_placeholder-i.patch
|
||||
# PATCH-FIX-UPSTREAM-- RT#132655, upstream 5.29.2
|
||||
Patch26: perl-132655-nul-terminate-result-of-unpack-u-of-inva.patch
|
||||
# PATCH-FIX-OPENEULER
|
||||
# In 2020, a year of 70 starts to mean 2070. So cpan/Time-Local/t/Local.t test
|
||||
Patch27: Fix-time-local-tests-in-2020.patch
|
||||
Patch28: backport-perl-5.22.0-Install-libperl.so-to-shrpdir-on-Linux.patch
|
||||
|
||||
Patch6000: CVE-2018-18312-1.patch
|
||||
Patch6001: CVE-2018-18312-2.patch
|
||||
Patch6002: CVE-2018-18312-3.patch
|
||||
|
||||
%ifarch aarch64_ilp32
|
||||
Patch29: backport-aarch64-ilp32-support.patch
|
||||
%endif
|
||||
|
||||
BuildRequires: gcc bash findutils coreutils make tar procps bzip2-devel gdbm-devel
|
||||
BuildRequires: zlib-devel systemtap-sdt-devel perl-interpreter perl-generators gdb
|
||||
|
||||
Requires: perl-libs = %{epoch}:%{version}-%{release}
|
||||
Requires: perl(:MODULE_COMPAT_5.28.0) perl-version perl-threads perl-threads-shared perl-parent
|
||||
Requires: perl-devel = %{epoch}:%{version}-%{release} system-rpm-config
|
||||
Requires: system-rpm-config
|
||||
Requires: perl-Unicode-Collate perl-Unicode-Normalize perl-Time-Local perl-Time-HiRes
|
||||
Requires: perl-Thread-Queue perl-Text-Tabs+Wrap perl-Test-Simple perl-Test-Harness perl-devel
|
||||
Requires: perl-Thread-Queue perl-Text-Tabs+Wrap perl-Test-Simple perl-Test-Harness
|
||||
Requires: perl-Text-Balanced perl-Text-ParseWords perl-Term-ANSIColor perl-Term-Cap
|
||||
Requires: perl-Socket perl-podlators perl-Scalar-List-Utils perl-perlfaq perl-constant
|
||||
Requires: perl-Digest-SHA perl-Digest perl-Digest-MD5 perl-Devel-PPPort perl-Carp perl-Env
|
||||
@ -85,7 +78,7 @@ Requires: perl-File-Fetch perl-File-Path perl-File-Temp perl-Filter-Simple
|
||||
Requires: perl-IO-Compress perl-IO-Socket-IP perl-autodie perl-bignum perl-B-Debug perl-encoding
|
||||
Requires: perl-Exporter perl-experimental perl-Compress-Raw-Bzip2 perl-Compress-Raw-Zlib perl-HTTP-Tiny
|
||||
Requires: perl-Locale-Codes perl-Locale-Maketext perl-Math-BigInt perl-Math-BigInt-FastCalc perl-Math-BigRat
|
||||
Requires: perl-Archive-Tar perl-Config-Perl-V perl-Data-Dumper perl-DB_File perl-Getopt-Long perl-libnet
|
||||
Requires: perl-Archive-Tar perl-Config-Perl-V perl-Data-Dumper perl-Getopt-Long perl-libnet
|
||||
Requires: perl-IPC-Cmd perl-IPC-SysV perl-JSON-PP perl-MIME-Base64 perl-Params-Check perl-Storable
|
||||
Requires: perl-Pod-Checker perl-Pod-Escapes perl-Pod-Parser perl-Pod-Perldoc perl-Pod-Simple perl-Pod-Usage
|
||||
Requires: perl-Module-CoreList perl-Module-CoreList-tools perl-Module-Load perl-Module-Load-Conditional
|
||||
@ -94,9 +87,9 @@ Requires: perl-Module-Metadata perl-Sys-Syslog perl-PerlIO-via-QuotedPrint
|
||||
Provides: perl-Attribute-Handlers perl-interpreter perl(bytes_heavy.pl) perl(dumpvar.pl) perl(perl5db.pl)
|
||||
Provides: perl-ExtUtils-Embed perl-ExtUtils-Miniperl perl-IO perl-IO-Zlib perl-Locale-Maketext-Simple perl-Math-Complex
|
||||
Provides: perl-Module-Loaded perl-Net-Ping perl-Pod-Html perl-SelfLoader perl-Test perl-Time-Piece perl-libnetcfg perl-open perl-utils
|
||||
Provides: perl-Errno perl-macros perl-Memoize
|
||||
Provides: perl-Errno perl-Memoize
|
||||
|
||||
Obsoletes: perl-Attribute-Handlers perl-interpreter perl-macros perl-Errno perl-ExtUtils-Embed perl-Net-Ping
|
||||
Obsoletes: perl-Attribute-Handlers perl-interpreter perl-Errno perl-ExtUtils-Embed perl-Net-Ping
|
||||
Obsoletes: perl-ExtUtils-Miniperl perl-IO perl-IO-Zlib perl-Locale-Maketext-Simple perl-Math-Complex perl-Memoize perl-Module-Loaded
|
||||
Obsoletes: perl-Pod-Html perl-SelfLoader perl-Test perl-Time-Piece perl-libnetcfg perl-open perl-utils
|
||||
|
||||
@ -109,7 +102,8 @@ prototyping and large scale development projects.
|
||||
%package libs
|
||||
Summary: The libraries for the perl
|
||||
License: (GPL+ or Artistic) and HSRL and MIT and UCD
|
||||
Provides: perl(:MODULE_COMPAT_5.28.0) perl(:VERSION) = 5.28.0
|
||||
Provides: perl(:MODULE_COMPAT_5.28.0) perl(:VERSION) = 5.28.3
|
||||
Provides: perl(:MODULE_COMPAT_5.28.3)
|
||||
Provides: perl(:WITH_64BIT) perl(:WITH_ITHREADS) perl(:WITH_THREADS)
|
||||
Provides: perl(:WITH_LARGEFILES) perl(:WITH_PERLIO) perl(unicore::Name)
|
||||
Provides: perl(utf8_heavy.pl)
|
||||
@ -152,13 +146,19 @@ sed -i '/\(bzip2\|zlib\)-src/d' MANIFEST
|
||||
-Dldflags="$RPM_LD_FLAGS" -Dccdlflags="-Wl,--enable-new-dtags $RPM_LD_FLAGS" \
|
||||
-Dlddlflags="-shared $RPM_LD_FLAGS" -Dshrpdir="%{_libdir}" \
|
||||
-DDEBUGGING=-g -Dversion=%{version} -Dmyhostname=localhost \
|
||||
-Dperladmin=root@localhost -Dcc='%{__cc}' -Dprefix=%{_prefix} \
|
||||
-Dperladmin=root@localhost -Dcc=gcc -Dprefix=%{_prefix} \
|
||||
-Dvendorprefix=%{_prefix} -Dsiteprefix=%{_prefix}/local \
|
||||
-Dsitelib="%{_prefix}/local/share/perl5" -Dprivlib="%{perl_datadir}" \
|
||||
-Dsitearch="%{_prefix}/local/%{_lib}/perl5" \
|
||||
-Dvendorlib="%{perl_vendor_datadir}" -Darchlib="%{perl_libdir}" \
|
||||
-Dvendorarch="%{perl_vendor_libdir}" -Darchname="%{_arch}-%{_os}-thread-multi" \
|
||||
%ifarch i686
|
||||
-Dlibpth="/usr/local/lib /lib %{_prefix}/lib" \
|
||||
%elifarch aarch64_ilp32
|
||||
-Dlibpth="/usr/local/libilp32 /libilp32 %{_prefix}/libilp32" \
|
||||
%else
|
||||
-Dlibpth="/usr/local/lib64 /lib64 %{_prefix}/lib64" \
|
||||
%endif
|
||||
-Duseshrplib -Dusethreads -Duseithreads -Ui_ndbm -Di_gdbm \
|
||||
-Dusedtrace='/usr/bin/dtrace' -Ubincompat5005 -Dusesitecustomize \
|
||||
-Duselargefiles -Dd_semctl_semun -Di_db -Duse64bitint \
|
||||
@ -167,6 +167,9 @@ sed -i '/\(bzip2\|zlib\)-src/d' MANIFEST
|
||||
-Dd_gethostent_r_proto -Ud_endhostent_r_proto -Ud_sethostent_r_proto \
|
||||
-Ud_endprotoent_r_proto -Ud_setprotoent_r_proto \
|
||||
-Ud_endservent_r_proto -Ud_setservent_r_proto \
|
||||
%ifarch aarch64_ilp32
|
||||
-Duse64bitint \
|
||||
%endif
|
||||
|
||||
BUILD_BZIP2=0
|
||||
BZIP2_LIB=%{_libdir}
|
||||
@ -208,7 +211,6 @@ ln -s ../../../bin/xsubpp %{buildroot}%{perl_datadir}/ExtUtils/
|
||||
|
||||
rm %{buildroot}%{perl_libdir}/.packlist
|
||||
|
||||
# bug #973713
|
||||
rm %{buildroot}/%{perl_libdir}/File/Spec/VMS.pm
|
||||
rm %{buildroot}%{_mandir}/man3/File::Spec::VMS.3*
|
||||
|
||||
@ -511,6 +513,55 @@ make test_harness
|
||||
%{_mandir}/man3/*
|
||||
|
||||
%changelog
|
||||
* Thu Aug 5 2021 yuanxin<yuanxin24@huawei.com> - 4:5.28.3-7
|
||||
- Type:bugfix
|
||||
- ID:NA
|
||||
- SUG:NA
|
||||
- DESC:remove other release-related information
|
||||
|
||||
* Thu Mar 30 2021 shenyangyang<shenyangyang4@huawei.com> - 4:5.28.3-6
|
||||
- Type:bugfix
|
||||
- ID:NA
|
||||
- SUG:NA
|
||||
- DESC:Rebuild for openEuler-rpm-config moving /usr/lib/rpm/openEuler/xxxx
|
||||
to /usr/lib/xxxx
|
||||
|
||||
* Tue Jan 12 2021 tianwei <tianwei12@huawei.com> - 4:5.28.3-5
|
||||
- Type:enhancement
|
||||
- ID:NA
|
||||
- SUG:NA
|
||||
- DESC:support for i686 and remove perl-devel from perl
|
||||
|
||||
* Fri Jan 8 2021 tianwei <tianwei12@huawei.com> - 4:5.28.3-4
|
||||
- Type:enhancement
|
||||
- ID:NA
|
||||
- SUG:NA
|
||||
- DESC:remove perl-DB_File
|
||||
|
||||
* Fri Oct 9 2020 shenyangyang <shenyangyang4@huawei.com> - 4:5.28.3-3
|
||||
- Type:enhancement
|
||||
- ID:NA
|
||||
- SUG:NA
|
||||
- DESC:add provides MODULE_COMPAT 5.28.3
|
||||
|
||||
* Wed Sep 30 2020 Shen Yangyang <shenyangyang4@huawei.com> - 4:5.28.3-2
|
||||
- Type:enhancement
|
||||
- ID:NA
|
||||
- SUG:NA
|
||||
- DESC:delete provide of perl-macros that actually provided by openEuler-rpm-config
|
||||
|
||||
* Thu Aug 13 2020 openEuler Buildteam <buildteam@openeuler.org> - 4:5.28.3-1
|
||||
- Type:enhancement
|
||||
- ID:NA
|
||||
- SUG:NA
|
||||
- DESC:update version to 5.28.3
|
||||
|
||||
* Mon Aug 3 2020 wenzhanli<wenzhanli2@huawei.com> - 4:5.28.0-435
|
||||
- Type:bugfix
|
||||
- ID:NA
|
||||
- SUG:NA
|
||||
- DESC:CVE-2020-10543 CVE-2020-10878 CVE-12723
|
||||
|
||||
* Sat Mar 21 2020 openEuler Buildteam <buildteam@openeuler.org> - 4:5.28.0-434
|
||||
- Type:NA
|
||||
- ID:NA
|
||||
|
||||
@ -1,4 +0,0 @@
|
||||
version_control: github
|
||||
src_repo: Perl/perl5
|
||||
tag_prefix: ^v
|
||||
seperator: .
|
||||
@ -1,98 +0,0 @@
|
||||
From 6b877bbd2c071b3e0659fab552a74dc2ff7e08fb Mon Sep 17 00:00:00 2001
|
||||
From: David Mitchell <davem@iabyn.com>
|
||||
Date: Sat, 14 Jul 2018 10:47:04 +0100
|
||||
Subject: [PATCH] treat when(index() > -1) as a boolean expression
|
||||
|
||||
RT #133368
|
||||
|
||||
when(X) is normally compiled as when($_ ~~ X) *except* when X appears to
|
||||
be a boolean expression, in which case it's used directly.
|
||||
|
||||
5.28.0 introduced an optimisation whereby comparisons involving index
|
||||
like
|
||||
|
||||
index(...) != -1
|
||||
|
||||
eliminated the comparison, and pp_index() returned a boolean value
|
||||
directly. This defeated the 'look for a boolean op' mechanism, and so
|
||||
|
||||
when(index(...) != -1)
|
||||
|
||||
and similar were being incorrectly compiled as
|
||||
|
||||
when($_ ~~ (index(...) != -1))
|
||||
---
|
||||
op.c | 8 +++++++-
|
||||
t/op/switch.t | 23 ++++++++++++++++++++++-
|
||||
2 files changed, 29 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/op.c b/op.c
|
||||
index a05a1319d4..ddeb484b64 100644
|
||||
--- a/op.c
|
||||
+++ b/op.c
|
||||
@@ -9072,6 +9072,13 @@ S_looks_like_bool(pTHX_ const OP *o)
|
||||
case OP_FLOP:
|
||||
|
||||
return TRUE;
|
||||
+
|
||||
+ case OP_INDEX:
|
||||
+ case OP_RINDEX:
|
||||
+ /* optimised-away (index() != -1) or similar comparison */
|
||||
+ if (o->op_private & OPpTRUEBOOL)
|
||||
+ return TRUE;
|
||||
+ return FALSE;
|
||||
|
||||
case OP_CONST:
|
||||
/* Detect comparisons that have been optimized away */
|
||||
@@ -9081,7 +9088,6 @@ S_looks_like_bool(pTHX_ const OP *o)
|
||||
return TRUE;
|
||||
else
|
||||
return FALSE;
|
||||
-
|
||||
/* FALLTHROUGH */
|
||||
default:
|
||||
return FALSE;
|
||||
diff --git a/t/op/switch.t b/t/op/switch.t
|
||||
index e5385df0b4..6ff69e0bce 100644
|
||||
--- a/t/op/switch.t
|
||||
+++ b/t/op/switch.t
|
||||
@@ -10,7 +10,7 @@ use strict;
|
||||
use warnings;
|
||||
no warnings 'experimental::smartmatch';
|
||||
|
||||
-plan tests => 195;
|
||||
+plan tests => 197;
|
||||
|
||||
# The behaviour of the feature pragma should be tested by lib/feature.t
|
||||
# using the tests in t/lib/feature/*. This file tests the behaviour of
|
||||
@@ -1358,6 +1358,27 @@ given("xyz") {
|
||||
"scalar value of false when";
|
||||
}
|
||||
|
||||
+# RT #133368
|
||||
+# index() and rindex() comparisons such as '> -1' are optimised away. Make
|
||||
+# sure that they're still treated as a direct boolean expression rather
|
||||
+# than when(X) being implicitly converted to when($_ ~~ X)
|
||||
+
|
||||
+{
|
||||
+ my $s = "abc";
|
||||
+ my $ok = 0;
|
||||
+ given("xyz") {
|
||||
+ when (index($s, 'a') > -1) { $ok = 1; }
|
||||
+ }
|
||||
+ ok($ok, "RT #133368 index");
|
||||
+
|
||||
+ $ok = 0;
|
||||
+ given("xyz") {
|
||||
+ when (rindex($s, 'a') > -1) { $ok = 1; }
|
||||
+ }
|
||||
+ ok($ok, "RT #133368 rindex");
|
||||
+}
|
||||
+
|
||||
+
|
||||
# Okay, that'll do for now. The intricacies of the smartmatch
|
||||
# semantics are tested in t/op/smartmatch.t. Taintedness of
|
||||
# returned values is checked in t/op/taint.t.
|
||||
--
|
||||
2.19.1
|
||||
|
||||
Loading…
Reference in New Issue
Block a user