In perl.git, the branch maint-5.14 has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/7154d6bffea2ceba994e7dc8dd7b4ff9e5107f66?hp=77a8ff4394f95bd10958c5598eb91a42846b90a1>
- Log -----------------------------------------------------------------
commit 7154d6bffea2ceba994e7dc8dd7b4ff9e5107f66
Author: Dominic Hargreaves <d...@earth.li>
Date: Sat Sep 8 18:09:33 2012 +0100
Bump versions of Digest and IPC::Open3
M cpan/Digest/Digest.pm
M ext/IPC-Open3/lib/IPC/Open3.pm
commit b206490f77db92d9b8770882aca59a24f742a957
Author: Dominic Hargreaves <d...@earth.li>
Date: Fri Sep 7 23:02:54 2012 +0100
Update perldelta for all queued maint-5.14 changes
M pod/perldelta.pod
commit 21fda8acd781016029f4703450f5ba20e7bc66a9
Author: Salvador Fandino <sfand...@yahoo.com>
Date: Wed Jul 27 09:20:29 2011 -0700
IPC::Open3::open3(..., '-') broken
IPC::Open3::open3($in, $out, $err, '-') is broken in 5.14.1
Because the old "return 0" used to return to user code now is wrapped
inside and eval block.
This patch solves the problem.
M ext/IPC-Open3/lib/IPC/Open3.pm
commit e58f7f23d940a35655fb047a754e573c0d80cc51
Author: Steve Hay <steve.m....@googlemail.com>
Date: Mon Aug 20 11:36:53 2012 +0100
Add 5.17.3 to perlhist
M pod/perlhist.pod
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 3 +
cpan/Digest/Digest.pm | 8 +-
cpan/Digest/t/security.t | 14 +++
ext/IPC-Open3/lib/IPC/Open3.pm | 7 +-
.../gnukfreebsd.pl => ext/NDBM_File/hints/gnu.pl | 0
.../gnukfreebsd.pl => ext/ODBM_File/hints/gnu.pl | 0
ext/POSIX/t/sysconf.t | 2 +-
hints/gnu.sh | 27 +++++-
lib/locale.t | 2 +-
op.c | 5 +-
pod/perldelta.pod | 113 ++++++++++++++++++++
pod/perlhist.pod | 2 +
pp_sys.c | 2 +-
regcomp.c | 51 ++++++----
regexec.c | 5 +-
t/op/taint.t | 22 ++++-
t/re/pat.t | 9 ++-
t/re/re_tests | 10 ++
utils/h2ph.PL | 12 +--
19 files changed, 251 insertions(+), 43 deletions(-)
create mode 100644 cpan/Digest/t/security.t
copy dist/Storable/hints/gnukfreebsd.pl => ext/NDBM_File/hints/gnu.pl (100%)
copy dist/Storable/hints/gnukfreebsd.pl => ext/ODBM_File/hints/gnu.pl (100%)
diff --git a/MANIFEST b/MANIFEST
index ed67d45..c834b79 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -759,6 +759,7 @@ cpan/Digest-SHA/typemap Typemap for
Digest::SHA
cpan/Digest/t/base.t See if Digest extensions work
cpan/Digest/t/digest.t See if Digest extensions work
cpan/Digest/t/file.t See if Digest extensions work
+cpan/Digest/t/security.t See if Digest extensions work
cpan/Encode/AUTHORS List of authors
cpan/Encode/bin/enc2xs Encode module generator
cpan/Encode/bin/piconv iconv by perl
@@ -3461,6 +3462,7 @@ ext/NDBM_File/hints/dec_osf.pl Hint for NDBM_File for
named architecture
ext/NDBM_File/hints/dynixptx.pl Hint for NDBM_File for named
architecture
ext/NDBM_File/hints/gnukfreebsd.pl Hint for NDBM_File for named
architecture
ext/NDBM_File/hints/gnuknetbsd.pl Hint for NDBM_File for named
architecture
+ext/NDBM_File/hints/gnu.pl Hint for NDBM_File for named architecture
ext/NDBM_File/hints/linux.pl Hint for NDBM_File for named architecture
ext/NDBM_File/hints/sco.pl Hint for NDBM_File for named architecture
ext/NDBM_File/hints/solaris.pl Hint for NDBM_File for named architecture
@@ -3474,6 +3476,7 @@ ext/ODBM_File/hints/cygwin.pl Hint for ODBM_File for
named architecture
ext/ODBM_File/hints/dec_osf.pl Hint for ODBM_File for named architecture
ext/ODBM_File/hints/gnukfreebsd.pl Hint for NDBM_File for named
architecture
ext/ODBM_File/hints/gnuknetbsd.pl Hint for NDBM_File for named
architecture
+ext/ODBM_File/hints/gnu.pl Hint for ODBM_File for named architecture
ext/ODBM_File/hints/hpux.pl Hint for ODBM_File for named architecture
ext/ODBM_File/hints/linux.pl Hint for NDBM_File for named architecture
ext/ODBM_File/hints/sco.pl Hint for ODBM_File for named architecture
diff --git a/cpan/Digest/Digest.pm b/cpan/Digest/Digest.pm
index 384dfc8..c04a1f5 100644
--- a/cpan/Digest/Digest.pm
+++ b/cpan/Digest/Digest.pm
@@ -3,7 +3,7 @@ package Digest;
use strict;
use vars qw($VERSION %MMAP $AUTOLOAD);
-$VERSION = "1.16";
+$VERSION = "1.16_01";
%MMAP = (
"SHA-1" => [["Digest::SHA", 1], "Digest::SHA1", ["Digest::SHA2", 1]],
@@ -24,7 +24,7 @@ sub new
shift; # class ignored
my $algorithm = shift;
my $impl = $MMAP{$algorithm} || do {
- $algorithm =~ s/\W+//;
+ $algorithm =~ s/\W+//g;
"Digest::$algorithm";
};
$impl = [$impl] unless ref($impl);
@@ -35,7 +35,9 @@ sub new
($class, @args) = @$class if ref($class);
no strict 'refs';
unless (exists ${"$class\::"}{"VERSION"}) {
- eval "require $class";
+ my $pm_file = $class . ".pm";
+ $pm_file =~ s{::}{/}g;
+ eval { require $pm_file };
if ($@) {
$err ||= $@;
next;
diff --git a/cpan/Digest/t/security.t b/cpan/Digest/t/security.t
new file mode 100644
index 0000000..5cba122
--- /dev/null
+++ b/cpan/Digest/t/security.t
@@ -0,0 +1,14 @@
+#!/usr/bin/env perl
+
+# Digest->new() had an exploitable eval
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+use Digest;
+
+$LOL::PWNED = 0;
+eval { Digest->new(q[MD;5;$LOL::PWNED = 42]) };
+is $LOL::PWNED, 0;
diff --git a/ext/IPC-Open3/lib/IPC/Open3.pm b/ext/IPC-Open3/lib/IPC/Open3.pm
index 7015d27..aeee9d4 100644
--- a/ext/IPC-Open3/lib/IPC/Open3.pm
+++ b/ext/IPC-Open3/lib/IPC/Open3.pm
@@ -9,7 +9,7 @@ require Exporter;
use Carp;
use Symbol qw(gensym qualify);
-$VERSION = 1.09;
+$VERSION = 1.09_01;
@ISA = qw(Exporter);
@EXPORT = qw(open3);
@@ -284,11 +284,14 @@ sub _open3 {
} else {
xopen \*STDERR, ">&STDOUT" if fileno(STDERR) !=
fileno(STDOUT);
}
- return 0 if ($cmd[0] eq '-');
+ return 1 if ($cmd[0] eq '-');
exec @cmd or do {
local($")=(" ");
croak "$Me: exec of @cmd failed";
};
+ } and do {
+ close $stat_w;
+ return 0;
};
my $bang = 0+$!;
diff --git a/dist/Storable/hints/gnukfreebsd.pl b/ext/NDBM_File/hints/gnu.pl
similarity index 100%
copy from dist/Storable/hints/gnukfreebsd.pl
copy to ext/NDBM_File/hints/gnu.pl
diff --git a/dist/Storable/hints/gnukfreebsd.pl b/ext/ODBM_File/hints/gnu.pl
similarity index 100%
copy from dist/Storable/hints/gnukfreebsd.pl
copy to ext/ODBM_File/hints/gnu.pl
diff --git a/ext/POSIX/t/sysconf.t b/ext/POSIX/t/sysconf.t
index 2dc9762..4a03217 100644
--- a/ext/POSIX/t/sysconf.t
+++ b/ext/POSIX/t/sysconf.t
@@ -130,7 +130,7 @@ SKIP: {
or skip("could not create fifo $fifo ($!)", 2 * 3 * @path_consts_fifo);
SKIP: {
- my $fd = POSIX::open($fifo, O_RDWR)
+ my $fd = POSIX::open($fifo, O_RDONLY | O_NONBLOCK)
or skip("could not open $fifo ($!)", 3 * @path_consts_fifo);
for my $constant (@path_consts_fifo) {
diff --git a/hints/gnu.sh b/hints/gnu.sh
index 2cfce54..4233371 100644
--- a/hints/gnu.sh
+++ b/hints/gnu.sh
@@ -8,10 +8,22 @@ set `echo X "$libswanted "| sed -e 's/ nsl / /' -e 's/ c /
pthread /'`
shift
libswanted="$*"
+# Debian 4.0 puts ndbm in the -lgdbm_compat library.
+libswanted="$libswanted gdbm_compat"
+
case "$optimize" in
'') optimize='-O2' ;;
esac
+case "$plibpth" in
+'') plibpth=`gcc -print-search-dirs | grep libraries |
+ cut -f2- -d= | tr ':' $trnl | grep -v 'gcc' | sed -e 's:/$::'`
+ set X $plibpth # Collapse all entries on one line
+ shift
+ plibpth="$*"
+ ;;
+esac
+
# Flags needed to produce shared libraries.
lddlflags='-shared'
@@ -19,7 +31,20 @@ lddlflags='-shared'
ccdlflags='-Wl,-E'
# Debian bug #258618
-ccflags='-D_GNU_SOURCE'
+ccflags="-D_GNU_SOURCE $ccflags"
+
+cat > UU/uselargefiles.cbu <<'EOCBU'
+# This script UU/uselargefiles.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use large files.
+case "$uselargefiles" in
+''|$define|true|[yY]*)
+# Keep this in the left margin.
+ccflags_uselargefiles="-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64"
+
+ ccflags="$ccflags $ccflags_uselargefiles"
+ ;;
+esac
+EOCBU
# The following routines are only available as stubs in GNU libc.
# XXX remove this once metaconf detects the GNU libc stubs.
diff --git a/lib/locale.t b/lib/locale.t
index a66810b..629d810 100644
--- a/lib/locale.t
+++ b/lib/locale.t
@@ -460,7 +460,7 @@ if ($^O eq 'darwin') {
if ($v >= 8 and $v < 10) {
debug "# Skipping eu_ES, be_BY locales -- buggy in Darwin\n";
@Locale = grep ! m/^(eu_ES(?:\..*)?|be_BY\.CP1131)$/, @Locale;
- } elsif ($v < 12) {
+ } elsif ($v < 13) {
debug "# Skipping be_BY locales -- buggy in Darwin\n";
@Locale = grep ! m/^be_BY\.CP1131$/, @Locale;
}
diff --git a/op.c b/op.c
index e21b9a4..973df13 100644
--- a/op.c
+++ b/op.c
@@ -7780,8 +7780,11 @@ Perl_ck_index(pTHX_ OP *o)
OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
if (kid)
kid = kid->op_sibling; /* get past "big" */
- if (kid && kid->op_type == OP_CONST)
+ if (kid && kid->op_type == OP_CONST) {
+ const bool save_taint = PL_tainted;
fbm_compile(((SVOP*)kid)->op_sv, 0);
+ PL_tainted = save_taint;
+ }
}
return ck_fun(o);
}
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index cdb8c83..009c4aa 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -36,6 +36,17 @@ L</Selected Bug Fixes> section.
[ List each security issue as a =head2 entry ]
+=head2 C<Digest> unsafe use of eval (CVE-2011-3597)
+
+The C<Digest->new()> function did not properly sanitize input before
+using it in an eval() call, which could lead to the injection of arbitrary
+Perl code.
+
+In order to exploit this flaw, the attacker would need to be able to set
+the algorithm name used, or be able to execute arbitrary Perl code already.
+
+This problem has been fixed.
+
=head1 Incompatible Changes
XXX For a release on a stable branch, this section aspires to be:
@@ -98,6 +109,22 @@ XXX
XXX
+=item *
+
+L<PerlIO::scalar> was updated to fix a bug in which opening a filehandle to
+a glob copy caused assertion failures (under debugging) or hangs or other
+erratic behaviour without debugging.
+
+=item *
+
+L<ODBM_File> and L<NDBM_File> were updated to allow building on GNU/Hurd.
+
+=item *
+
+L<IPC::Open3> has been updated to fix a regression introduced in perl
+5.12, which broke C<IPC::Open3::open3($in, $out, $err, '-')>.
+[perl #95748]
+
=back
=head2 Removed Modules and Pragmata
@@ -115,6 +142,8 @@ XXX
XXX Changes to files in F<pod/> go here. Consider grouping entries by
file and be sure to link to the appropriate page, e.g. L<perlfunc>.
+PerlCheat was updated to 5.14.
+
=head2 New Documentation
XXX Changes which create B<new> files in F<pod/> go here.
@@ -206,8 +235,17 @@ L</Platform Support> section, instead.
=item *
+h2ph was updated to search correctly gcc include directories on platforms
+such as Debian with multi-architecture support.
+
+=item *
+
XXX
+=item *
+
+In Configure, the test for procselfexe was refactored into a loop.
+
=back
=head1 Testing
@@ -271,6 +309,38 @@ L</Modules and Pragmata> section.
=over 4
+=item FreeBSD
+
+The FreeBSD hints file was corrected to be compatible with FreeBSD 10.0.
+
+=item Solaris and NetBSD
+
+Configure was updated for "procselfexe" support on Solaris and NetBSD
+
+=item HP-UX
+
+README.hpux was updated to note the existence of a broken header in
+HP-UX 11.00.
+
+=item Linux
+
+libutil is no longer used when compiling on Linux platforms, which avoids
+warnings being emitted.
+
+The system gcc (rather than any other gcc which might be in the compiling
+user's path) is now used when searching for libraries such as C<-lm>.
+
+=item Mac OS X
+
+The locale tests were updated to reflect the behaviour of locales in
+Mountain Lion.
+
+=item GNU/Hurd
+
+Various build and test fixes were included for GNU/Hurd.
+
+LFS support was enabled in GNU/Hurd.
+
=item XXX-some-platform
XXX
@@ -307,6 +377,49 @@ L</Modules and Pragmata>.
XXX
+=item *
+
+A regression has been fixed that was introduced in 5.14, in C</i>
+regular expression matching, in which a match improperly fails if the
+pattern is in UTF-8, the target string is not, and a Latin-1 character
+precedes a character in the string that should match the pattern. [perl
+#101710]
+
+=item *
+
+In case-insensitive regular expression pattern matching, no longer on
+UTF-8 encoded strings does the scan for the start of match only look at
+the first possible position. This caused matches such as
+C<"f\x{FB00}" =~ /ff/i> to fail.
+
+=item *
+
+The sitecustomize was made relocatableinc aware, so that
+-Dusesitecustomize and -Duserelocatableinc may be used together.
+
+=item *
+
+The smartmatch operator (C<~~>) was changed so that the right-hand side
+takes precedence during operations when used as C<Any ~~ Object>.
+
+=item *
+
+A bug has been fixed in the tainting support, in which an C<index()>
+operation on a tainted constant would cause all other contants to become
+tainted. [perl #64804]
+
+=item *
+
+A regression has been fixed that was introduced in perl 5.12, whereby
+tainting errors were not correctly propagated through C<die()>.
+[perl #111654]
+
+=item *
+
+A regression has been fixed that was introduced in perl 5.14, in which
+C</[[:lower:]]/i> and C</[[:upper:]]/i> no longer matched the opposite case.
+[perl #101970]
+
=back
=head1 Known Problems
diff --git a/pod/perlhist.pod b/pod/perlhist.pod
index c45087b..fc74286 100644
--- a/pod/perlhist.pod
+++ b/pod/perlhist.pod
@@ -481,10 +481,12 @@ the strings?).
Ricardo 5.16.0-RC2 2012-May-15
Ricardo 5.16.0 2012-May-20 The 5.16 maintenance track
+ Ricardo 5.16.1 2012-Aug-08
Zefram 5.17.0 2012-May-26 The 5.17 development track
Jesse L 5.17.1 2012-Jun-20
TonyC 5.17.2 2012-Jul-20
+ Steve 5.17.3 2012-Aug-20
=head2 SELECTED RELEASE SIZES
diff --git a/pp_sys.c b/pp_sys.c
index 3c42133..fbf1124 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -497,7 +497,7 @@ PP(pp_die)
}
}
}
- else if (SvPOK(ERRSV) && SvCUR(ERRSV)) {
+ else if (SvPV_const(ERRSV, len), len) {
exsv = sv_mortalcopy(ERRSV);
sv_catpvs(exsv, "\t...propagated");
}
diff --git a/regcomp.c b/regcomp.c
index c1c2c3b..b186c8d 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -9199,7 +9199,7 @@ S_checkposixcc(pTHX_ RExC_state_t *pRExC_state)
}
}
-/* No locale test, and always Unicode semantics */
+/* No locale test, and always Unicode semantics, no ignore-case differences */
#define _C_C_T_NOLOC_(NAME,TEST,WORD)
\
ANYOF_##NAME:
\
for (value = 0; value < 256; value++) \
@@ -9219,8 +9219,11 @@ case ANYOF_N##NAME:
\
/* Like the above, but there are differences if we are in uni-8-bit or not, so
* there are two tests passed in, to use depending on that. There aren't any
* cases where the label is different from the name, so no need for that
- * parameter */
-#define _C_C_T_(NAME, TEST_8, TEST_7, WORD)
\
+ * parameter.
+ * Sets 'what' to WORD which is the property name for non-bitmap code points;
+ * But, uses FOLD_WORD instead if /i has been selected, to allow a different
+ * property name */
+#define _C_C_T_(NAME, TEST_8, TEST_7, WORD, FOLD_WORD)
\
ANYOF_##NAME:
\
if (LOC) ANYOF_CLASS_SET(ret, ANYOF_##NAME);
\
else if (UNI_SEMANTICS) {
\
@@ -9237,7 +9240,12 @@ ANYOF_##NAME:
\
}
\
}
\
yesno = '+';
\
- what = WORD;
\
+ if (FOLD) {
\
+ what = FOLD_WORD;
\
+ }
\
+ else {
\
+ what = WORD;
\
+ }
\
break;
\
case ANYOF_N##NAME:
\
if (LOC) ANYOF_CLASS_SET(ret, ANYOF_N##NAME);
\
@@ -9269,7 +9277,12 @@ case ANYOF_N##NAME:
\
} \
}
\
yesno = '!';
\
- what = WORD;
\
+ if (FOLD) {
\
+ what = FOLD_WORD;
\
+ }
\
+ else {
\
+ what = WORD;
\
+ }
\
break
STATIC U8
@@ -9827,20 +9840,20 @@ parseit:
* --jhi */
switch ((I32)namedclass) {
- case _C_C_T_(ALNUMC, isALNUMC_L1, isALNUMC, "XPosixAlnum");
- case _C_C_T_(ALPHA, isALPHA_L1, isALPHA, "XPosixAlpha");
- case _C_C_T_(BLANK, isBLANK_L1, isBLANK, "XPosixBlank");
- case _C_C_T_(CNTRL, isCNTRL_L1, isCNTRL, "XPosixCntrl");
- case _C_C_T_(GRAPH, isGRAPH_L1, isGRAPH, "XPosixGraph");
- case _C_C_T_(LOWER, isLOWER_L1, isLOWER, "XPosixLower");
- case _C_C_T_(PRINT, isPRINT_L1, isPRINT, "XPosixPrint");
- case _C_C_T_(PSXSPC, isPSXSPC_L1, isPSXSPC, "XPosixSpace");
- case _C_C_T_(PUNCT, isPUNCT_L1, isPUNCT, "XPosixPunct");
- case _C_C_T_(UPPER, isUPPER_L1, isUPPER, "XPosixUpper");
+ case _C_C_T_(ALNUMC, isALNUMC_L1, isALNUMC, "XPosixAlnum",
"XPosixAlnum");
+ case _C_C_T_(ALPHA, isALPHA_L1, isALPHA, "XPosixAlpha",
"XPosixAlpha");
+ case _C_C_T_(BLANK, isBLANK_L1, isBLANK, "XPosixBlank",
"XPosixBlank");
+ case _C_C_T_(CNTRL, isCNTRL_L1, isCNTRL, "XPosixCntrl",
"XPosixCntrl");
+ case _C_C_T_(GRAPH, isGRAPH_L1, isGRAPH, "XPosixGraph",
"XPosixGraph");
+ case _C_C_T_(LOWER, isLOWER_L1, isLOWER, "XPosixLower",
"__XPosixLower_i");
+ case _C_C_T_(PRINT, isPRINT_L1, isPRINT, "XPosixPrint",
"XPosixPrint");
+ case _C_C_T_(PSXSPC, isPSXSPC_L1, isPSXSPC, "XPosixSpace",
"XPosixSpace");
+ case _C_C_T_(PUNCT, isPUNCT_L1, isPUNCT, "XPosixPunct",
"XPosixPunct");
+ case _C_C_T_(UPPER, isUPPER_L1, isUPPER, "XPosixUpper",
"__XPosixUpper_i");
/* \s, \w match all unicode if utf8. */
- case _C_C_T_(SPACE, isSPACE_L1, isSPACE, "SpacePerl");
- case _C_C_T_(ALNUM, isWORDCHAR_L1, isALNUM, "Word");
- case _C_C_T_(XDIGIT, isXDIGIT_L1, isXDIGIT, "XPosixXDigit");
+ case _C_C_T_(SPACE, isSPACE_L1, isSPACE, "SpacePerl",
"SpacePerl");
+ case _C_C_T_(ALNUM, isWORDCHAR_L1, isALNUM, "Word", "Word");
+ case _C_C_T_(XDIGIT, isXDIGIT_L1, isXDIGIT, "XPosixXDigit",
"XPosixXDigit");
case _C_C_T_NOLOC_(VERTWS, is_VERTWS_latin1(&value),
"VertSpace");
case _C_C_T_NOLOC_(HORIZWS, is_HORIZWS_latin1(&value),
"HorizSpace");
case ANYOF_ASCII:
@@ -9906,7 +9919,7 @@ parseit:
}
if (what && ! (AT_LEAST_ASCII_RESTRICTED)) {
/* Strings such as "+utf8::isWord\n" */
- Perl_sv_catpvf(aTHX_ listsv, "%cutf8::Is%s\n", yesno, what);
+ Perl_sv_catpvf(aTHX_ listsv, "%cutf8::%s\n", yesno, what);
}
continue;
diff --git a/regexec.c b/regexec.c
index 0dc093f..021ab8e 100644
--- a/regexec.c
+++ b/regexec.c
@@ -1507,7 +1507,8 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c,
char *s,
? utf8_length((U8 *) pat_string, (U8 *) pat_end)
: ln;
- e = HOP3c(strend, -((I32)lnc), s);
+ /* Set the end position to the final character available */
+ e = HOP3c(strend, -1, s);
if (!reginfo && e < s) {
e = s; /* Due to minlen logic of intuit() */
@@ -1521,7 +1522,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c,
char *s,
{
goto got_it;
}
- s += UTF8SKIP(s);
+ s += (utf8_target) ? UTF8SKIP(s) : 1;
}
break;
case BOUNDL:
diff --git a/t/op/taint.t b/t/op/taint.t
index 9df6fee..3a2b5d9 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ BEGIN {
use strict;
use Config;
-plan tests => 774;
+plan tests => 779;
$| = 1;
@@ -2144,6 +2144,26 @@ end
is_tainted $dest, "ucfirst(tainted) taints its return value";
}
+
+# tainted constants and index()
+# RT 64804; http://bugs.debian.org/291450
+{
+ ok(tainted $old_env_path, "initial taintedness");
+ BEGIN { no strict 'refs'; my $v = $old_env_path; *{"::C"} = sub () { $v };
}
+ ok(tainted C, "constant is tainted properly");
+ ok(!tainted "", "tainting not broken yet");
+ index(undef, C);
+ ok(!tainted "", "tainting still works after index() of the constant");
+}
+
+{ # 111654
+ eval {
+ eval { die "Test\n".substr($ENV{PATH}, 0, 0); };
+ die;
+ };
+ like($@, qr/^Test\n\t\.\.\.propagated at /, "error should be propagated");
+}
+
# This may bomb out with the alarm signal so keep it last
SKIP: {
skip "No alarm()" unless $Config{d_alarm};
diff --git a/t/re/pat.t b/t/re/pat.t
index 4ef9663..4eb05c6 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -21,7 +21,7 @@ BEGIN {
require './test.pl';
}
-plan tests => 451; # Update this when adding/deleting tests.
+plan tests => 452; # Update this when adding/deleting tests.
run_tests() unless caller;
@@ -1167,6 +1167,13 @@ sub run_tests {
is($got,$want,'RT #84294: check that "ab" =~ /((\w+)(?{ push @got, $2
})){2}/ leaves @got in the correct state');
}
+
+ { # [perl #101710]
+ my $pat = "b";
+ utf8::upgrade($pat);
+ like("\xffb", qr/$pat/i, "/i: utf8 pattern, non-utf8 string,
latin1-char preceding matching char in string");
+ }
+
} # End of sub run_tests
1;
diff --git a/t/re/re_tests b/t/re/re_tests
index 35a7220..144cf1e 100644
--- a/t/re/re_tests
+++ b/t/re/re_tests
@@ -1522,4 +1522,14 @@ abc\N{def - c - \\N{NAME} must
be resolved by the lexer
# See [perl #89750]. This makes sure that the simple fold gets generated
# in that case, to DF.
/[^\x{1E9E}]/i \x{DF} n - -
+
+/ff/i \x{FB00}\x{FB01} y $& \x{FB00}
+/ff/i \x{FB01}\x{FB00} y $& \x{FB00}
+/fi/i \x{FB01}\x{FB00} y $& \x{FB01}
+/fi/i \x{FB00}\x{FB01} y $& \x{FB01}
+
+# [perl #101970]
+/[[:lower:]]/i \x{100} y $& \x{100}
+/[[:upper:]]/i \x{101} y $& \x{101}
+
# vim: softtabstop=0 noexpandtab
diff --git a/utils/h2ph.PL b/utils/h2ph.PL
index 87f3c7d..4545d6d 100644
--- a/utils/h2ph.PL
+++ b/utils/h2ph.PL
@@ -761,16 +761,8 @@ sub queue_includes_from
# non-GCC?) C compilers, but gcc uses additional include directories.
sub inc_dirs
{
- my $from_gcc = `LC_ALL=C $Config{cc} -v 2>&1`;
- if( !( $from_gcc =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s ) )
- { # gcc-4+ :
- $from_gcc = `LC_ALL=C $Config{cc} -print-search-dirs 2>&1`;
- if ( !($from_gcc =~
s/^install:\s*([^\s]+[^\s\/])([\s\/]*).*$/$1\/include/s) )
- {
- $from_gcc = '';
- };
- };
- length($from_gcc) ? ($from_gcc, $from_gcc . "-fixed", $Config{usrinc}) :
($Config{usrinc});
+ my $from_gcc = `LC_ALL=C $Config{cc} -v -E - < /dev/null 2>&1 | awk
'/^#include/, /^End of search list/' | grep '^ '`;
+ length($from_gcc) ? (split(' ', $from_gcc), $Config{usrinc}) :
($Config{usrinc});
}
--
Perl5 Master Repository
