--- Begin Message ---
- To: submit@bugs.debian.org
- Subject: pre-approval: perl/5.14.2-15
- From: Niko Tyni <ntyni@debian.org>
- Date: Mon, 22 Oct 2012 21:45:21 +0300
- Message-id: <20121022184521.GA5024@madeleine.local.invalid>
Package: release.debian.org
Severity: normal
User: release.debian.org@packages.debian.org
Usertags: unblock
X-Debbugs-Cc: perl@packages.debian.org
Hi release team,
we've been working on a perl update for wheezy.
Upstream recently released 5.14.3, which is a bugfix only stable
update. We're assuming that importing this into wheezy is out of question
at this point, but please let us know if you'd be willing to entertain
that option. The upstream rules for stable updates are quite strict;
see the 'MAINTENANCE BRANCHES' section in perlpolicy(1) of the perl-doc
package for details.
In case upgrading to the full 5.14.3 is strictly out (as we suspect),
we're proposing six patches from it that should be backported to
wheezy. These are fixes for three regressions from squeeze (#690975,
#690976, and #690979), two other important bugs (#629363 and #691102)
and one documentation update (#691112).
Outside the 5.14.3 context, we're proposing fixes for one more squeeze
regression (#690571), a kfreebsd-only security hardening issue (#689713),
and a Debian-specific issue with CPAN defaults (#688842). We've deemed
the last one release critical so I guess it technically doesn't need
preapproval, but please have a look at that one too.
So, would you please ack/nack these patches, and/or let us know if you'd
be willing to explore the 'full 5.14.3' option in more detail?
( FWIW, the full diffstat of the upstream code between the version we're
proposing and a fully imported 5.14.3 is
44 files changed, 1555 insertions(+), 412 deletions(-)
and this includes ~500 lines of documentation changes and 662 lines for a
Module::CoreList update.)
Changes:
perl (5.14.2-15) UNRELEASED; urgency=low
.
* Fix CPAN::FirstTime defaults with nonexisting site dirs if a parent
is writable. (Closes: #688842)
* Don't overwrite $Config{lddlflags} or ccdlflags on GNU/kFreeBSD.
(Closes: #689713)
* Fix tainted smart matching. (Closes: #690571)
* Cherry-pick fixes from 5.14.3:
+ /i regexps match correctly with latin1 characters again (Closes: #690975)
+ /i regexps match beyond the start of the string with multi-char folds
again. (Closes: #690976)
+ /[[:lower:]]/i and /[[:upper:]]/i match the opposite cases again
(Closes: #690979)
+ <$fh> no longer hangs or eats memory on a glob copy (Closes: #629363)
+ enforce Any ~~ Object smartmatch precedence (Closes: #691102)
+ update perlcheat.pod to 5.14. (Closes: #691112)
The diffstat against 5.14.2-14 is
debian/changelog | 19 +
debian/patches/debian/cpan-missing-site-dirs.diff | 62 +++++
debian/patches/fixes/kfreebsd-overrides.diff | 48 ++++
debian/patches/fixes/perlcheat-update.diff | 148 ++++++++++++
debian/patches/fixes/reading-glob-copy-handle.diff | 84 +++++++
debian/patches/fixes/regexp-matching-fold.diff | 51 ++++
debian/patches/fixes/regexp-matching-opposite-case.diff | 132 +++++++++++
debian/patches/fixes/regexp-matching-starter.diff | 58 ++++
debian/patches/fixes/smartmatch-rhs-precedence.diff | 51 ++++
debian/patches/fixes/tainted-smartmatch.diff | 186 ++++++++++++++++
debian/patches/series | 9
11 files changed, 848 insertions(+)
and I'm attaching the full debdiff as well as the patches as separate
attachments for your convenience.
Many thanks for your work on the release!
--
Niko Tyni ntyni@debian.org
diff -Nru perl-5.14.2/debian/changelog perl-5.14.2/debian/changelog
--- perl-5.14.2/debian/changelog 2012-10-10 21:17:40.000000000 +0300
+++ perl-5.14.2/debian/changelog 2012-10-21 19:10:47.000000000 +0300
@@ -1,3 +1,22 @@
+perl (5.14.2-15) UNRELEASED; urgency=low
+
+ * Fix CPAN::FirstTime defaults with nonexisting site dirs if a parent
+ is writable. (Closes: #688842)
+ * Don't overwrite $Config{lddlflags} or ccdlflags on GNU/kFreeBSD.
+ (Closes: #689713)
+ * Fix tainted smart matching. (Closes: #690571)
+ * Cherry-pick fixes from 5.14.3:
+ + /i regexps match correctly with latin1 characters again (Closes: #690975)
+ + /i regexps match beyond the start of the string with multi-char folds
+ again. (Closes: #690976)
+ + /[[:lower:]]/i and /[[:upper:]]/i match the opposite cases again
+ (Closes: #690979)
+ + <$fh> no longer hangs or eats memory on a glob copy (Closes: #629363)
+ + enforce Any ~~ Object smartmatch precedence (Closes: #691102)
+ + update perlcheat.pod to 5.14. (Closes: #691112)
+
+ -- Niko Tyni <ntyni@debian.org> Tue, 16 Oct 2012 22:33:13 +0300
+
perl (5.14.2-14) unstable; urgency=high
* [SECURITY] CVE-2012-5195: fix a heap buffer overrun with
diff -Nru perl-5.14.2/debian/patches/debian/cpan-missing-site-dirs.diff perl-5.14.2/debian/patches/debian/cpan-missing-site-dirs.diff
--- perl-5.14.2/debian/patches/debian/cpan-missing-site-dirs.diff 1970-01-01 02:00:00.000000000 +0200
+++ perl-5.14.2/debian/patches/debian/cpan-missing-site-dirs.diff 2012-10-21 19:10:33.000000000 +0300
@@ -0,0 +1,62 @@
+From 0b575dfeee79f43c5e7779ee0c80010f0f2fe62b Mon Sep 17 00:00:00 2001
+From: Niko Tyni <ntyni@debian.org>
+Date: Tue, 16 Oct 2012 23:07:56 +0300
+Subject: Fix CPAN::FirstTime defaults with nonexisting site dirs if a parent
+ is writable
+
+The site directories do not exist on a typical Debian system. The build
+systems will create them when necessary, so there's no need for a prompt
+suggesting local::lib if the first existing parent directory is writable.
+
+Also, writability of the core directories is not interesting as we
+explicitly tell CPAN not to touch those with INSTALLDIRS=site.
+
+Bug-Debian: http://bugs.debian.org/688842
+Patch-Name: debian/cpan-missing-site-dirs.diff
+---
+ cpan/CPAN/lib/CPAN/FirstTime.pm | 31 +++++++++++++++++++++++++++----
+ 1 file changed, 27 insertions(+), 4 deletions(-)
+
+diff --git a/cpan/CPAN/lib/CPAN/FirstTime.pm b/cpan/CPAN/lib/CPAN/FirstTime.pm
+index c38c890..bca3c8f 100644
+--- a/cpan/CPAN/lib/CPAN/FirstTime.pm
++++ b/cpan/CPAN/lib/CPAN/FirstTime.pm
+@@ -2003,11 +2003,34 @@ sub _print_urllist {
+ };
+ }
+
++# Debian modification: return true if this directory
++# or the first existing one upwards is writable
++sub _can_write_to_this_or_parent {
++ my ($dir) = @_;
++ my @parts = File::Spec->splitdir($dir);
++ while (@parts) {
++ my $cur = File::Spec->catdir(@parts);
++ return 1 if -w $cur;
++ return 0 if -e _;
++ pop @parts;
++ }
++ return 0;
++}
++
++# Debian specific modification: the site directories don't necessarily
++# exist on the system, but the build systems create them when necessary,
++# so return true if the first existing directory upwards is writable
++#
++# Furthermore, on Debian, only test the site directories
++# (installsite*, expanded to /usr/local/{share,lib}/perl),
++# not the core ones
++# (install*lib, expanded to /usr/{share,lib}/perl).
++# We pass INSTALLDIRS=site by default to keep CPAN from touching
++# the core directories.
++
+ sub _can_write_to_libdirs {
+- return -w $Config{installprivlib}
+- && -w $Config{installarchlib}
+- && -w $Config{installsitelib}
+- && -w $Config{installsitearch}
++ return _can_write_to_this_or_parent($Config{installsitelib})
++ && _can_write_to_this_or_parent($Config{installsitearch})
+ }
+
+ sub _using_installbase {
diff -Nru perl-5.14.2/debian/patches/fixes/kfreebsd-overrides.diff perl-5.14.2/debian/patches/fixes/kfreebsd-overrides.diff
--- perl-5.14.2/debian/patches/fixes/kfreebsd-overrides.diff 1970-01-01 02:00:00.000000000 +0200
+++ perl-5.14.2/debian/patches/fixes/kfreebsd-overrides.diff 2012-10-21 19:10:33.000000000 +0300
@@ -0,0 +1,48 @@
+From 51233d46ac437fd272fcf3db0dc79e3700954a41 Mon Sep 17 00:00:00 2001
+From: Niko Tyni <ntyni@debian.org>
+Date: Wed, 17 Oct 2012 12:56:43 -0400
+Subject: Remove unnecessary overrides in gnukfreebsd and gnuknetbsd hints.
+
+hints/gnukfreebsd.sh and hints/gnuknetbsd.sh unconditionally
+override Configure's values for ccdlflags and lddlflags, even though
+the default Configure guesses should be correct for those systems.
+Configure was altered in commit fb2e1bc0638d5a5d7ac552a79a71a996a5d604cc
+(Perforce change 23909) to get the correct values, but later commit
+46c947e8b9def6de34ac831834a3c290ab266515 (Perforce change 24017) included
+these now-outdated hints file changes as part of importing a larger set
+of patches from Debian.
+
+This patch removes the unnecessary overrides. Thanks to Niko Tyni for
+digging up the history and supplying the hints/gnukfreebsd.sh patch.
+
+Origin: upstream, http://perl5.git.perl.org/perl.git/commit/7dc65651902f0390dfb92783b32c0b4976885475
+Bug: http://rt.perl.org/rt3/Ticket/Display.html?id=115324
+Bug-Debian: http://bugs.debian.org/689713
+Patch-Name: fixes/kfreebsd-overrides.diff
+---
+ hints/gnukfreebsd.sh | 3 ---
+ hints/gnuknetbsd.sh | 3 ---
+ 2 files changed, 6 deletions(-)
+
+diff --git a/hints/gnukfreebsd.sh b/hints/gnukfreebsd.sh
+index 1225f69..435afe7 100644
+--- a/hints/gnukfreebsd.sh
++++ b/hints/gnukfreebsd.sh
+@@ -5,6 +5,3 @@
+
+ . ./hints/linux.sh
+
+-# Configure sets these where $osname = linux
+-ccdlflags='-Wl,-E'
+-lddlflags='-shared'
+diff --git a/hints/gnuknetbsd.sh b/hints/gnuknetbsd.sh
+index 6ee1433..008547f 100644
+--- a/hints/gnuknetbsd.sh
++++ b/hints/gnuknetbsd.sh
+@@ -5,6 +5,3 @@
+
+ . ./hints/linux.sh
+
+-# Configure sets these where $osname = linux
+-ccdlflags='-Wl,-E'
+-lddlflags='-shared'
diff -Nru perl-5.14.2/debian/patches/fixes/perlcheat-update.diff perl-5.14.2/debian/patches/fixes/perlcheat-update.diff
--- perl-5.14.2/debian/patches/fixes/perlcheat-update.diff 1970-01-01 02:00:00.000000000 +0200
+++ perl-5.14.2/debian/patches/fixes/perlcheat-update.diff 2012-10-21 19:10:35.000000000 +0300
@@ -0,0 +1,148 @@
+From 41a55c909a7df9ee1d986a010351d23e19b39bba Mon Sep 17 00:00:00 2001
+From: "H.Merijn Brand" <h.m.brand@xs4all.nl>
+Date: Tue, 14 Jun 2011 20:12:01 +0200
+Subject: Update PerlCheat to 5.14
+
+Origin: upstream, http://perl5.git.perl.org/perl.git/commit/ab0ae0ad72e5601626d0b408edd884d7bd14d7dd
+Bug-Debian: http://bugs.debian.org/691112
+Patch-Name: fixes/perlcheat-update.diff
+
+See the discussion at
+ http://www.nntp.perl.org/group/perl.perl5.porters/2011/06/msg173391.html
+---
+ pod/perlcheat.pod | 118 +++++++++++++++++++++++++++--------------------------
+ 1 file changed, 60 insertions(+), 58 deletions(-)
+
+diff --git a/pod/perlcheat.pod b/pod/perlcheat.pod
+index d210fa0..deee2fe 100644
+--- a/pod/perlcheat.pod
++++ b/pod/perlcheat.pod
+@@ -10,68 +10,70 @@ already be overwhelming.
+
+ =head2 The sheet
+
+- CONTEXTS SIGILS ARRAYS HASHES
+- void $scalar whole: @array %hash
+- scalar @array slice: @array[0, 2] @hash{'a', 'b'}
+- list %hash element: $array[0] $hash{'a'}
+- &sub
+- *glob SCALAR VALUES
+- number, string, reference, glob, undef
++ CONTEXTS SIGILS ref ARRAYS HASHES
++ void $scalar SCALAR @array %hash
++ scalar @array ARRAY @array[0, 2] @hash{'a', 'b'}
++ list %hash HASH $array[0] $hash{'a'}
++ &sub CODE
++ *glob GLOB SCALAR VALUES
++ FORMAT number, string, ref, glob, undef
+ REFERENCES
+- \ references $$foo[1] aka $foo->[1]
+- $@%&* dereference $$foo{bar} aka $foo->{bar}
+- [] anon. arrayref ${$$foo[1]}[2] aka $foo->[1]->[2]
+- {} anon. hashref ${$$foo[1]}[2] aka $foo->[1][2]
+- \() list of refs
+- NUMBERS vs STRINGS LINKS
+- OPERATOR PRECEDENCE = = perl.plover.com
+- -> + . search.cpan.org
+- ++ -- == != eq ne cpan.org
+- ** < > <= >= lt gt le ge pm.org
+- ! ~ \ u+ u- <=> cmp tpj.com
+- =~ !~ perldoc.com
+- * / % x SYNTAX
+- + - . for (LIST) { }, for (a;b;c) { }
+- << >> while ( ) { }, until ( ) { }
+- named uops if ( ) { } elsif ( ) { } else { }
+- < > <= >= lt gt le ge unless ( ) { } elsif ( ) { } else { }
+- == != <=> eq ne cmp ~~ for equals foreach (ALWAYS)
++ \ reference $$foo[1] aka $foo->[1]
++ $@%&* dereference $$foo{bar} aka $foo->{bar}
++ [] anon. arrayref ${$$foo[1]}[2] aka $foo->[1]->[2]
++ {} anon. hashref ${$$foo[1]}[2] aka $foo->[1][2]
++ \() list of refs
++ NUMBERS vs STRINGS LINKS
++ OPERATOR PRECEDENCE = = perldoc.perl.org
++ -> + . search.cpan.org
++ ++ -- == != eq ne cpan.org
++ ** < > <= >= lt gt le ge pm.org
++ ! ~ \ u+ u- <=> cmp p3rl.org
++ =~ !~ perlmonks.org
++ * / % x SYNTAX
++ + - . foreach (LIST) { } for (a;b;c) { }
++ << >> while (e) { } until (e) { }
++ named uops if (e) { } elsif (e) { } else { }
++ < > <= >= lt gt le ge unless (e) { } elsif (e) { } else { }
++ == != <=> eq ne cmp ~~ given (e) { when (e) {} default {} }
+ &
+- | ^ REGEX METACHARS REGEX MODIFIERS
+- && ^ string begin /i case insens.
+- || // $ str. end (before \n) /m line based ^$
+- .. ... + one or more /s . includes \n
+- ?: * zero or more /x ign. wh.space
+- = += -= *= etc. ? zero or one /g global
+- , => {3,7} repeat in range /o cmpl pat. once
+- list ops () capture
+- not (?:) no capture REGEX CHARCLASSES
+- and [] character class . == [^\n]
+- or xor | alternation \s == whitespace
+- \b word boundary \w == word characters
+- \z string end \d == digits
+- DO \S, \W and \D negate
+- use strict; DON'T
+- use warnings; "$foo" LINKS
+- my $var; $$variable_name perl.com
+- open() or die $!; `$userinput` use.perl.org
+- use Modules; /$userinput/ perl.apache.org
+-
++ | ^ REGEX METACHARS REGEX MODIFIERS
++ && ^ string begin /i case insensitive
++ || // $ str end (bfr \n) /m line based ^$
++ .. ... + one or more /s . includes \n
++ ?: * zero or more /x ignore wh.space
++ = += -= *= etc ? zero or one /p preserve
++ , => {3,7} repeat in range /a ASCII /aa safe
++ list ops | alternation /l locale /d dual
++ not [] character class /u Unicode
++ and \b word boundary /e evaluate /ee rpts
++ or xor \z string end /g global
++ () capture /o compile pat once
++ DEBUG (?:p) no capture
++ -MO=Deparse (?#t) comment REGEX CHARCLASSES
++ -MO=Terse (?=p) ZW pos ahead . [^\n]
++ -D## (?!p) ZW neg ahead \s whitespace
++ -d:Trace (?<=p) ZW pos behind \K \w word chars
++ (?<!p) ZW neg behind \d digits
++ CONFIGURATION (?>p) no backtrack \pP named property
++ perl -V:ivsize (?|p|p)branch reset \h horiz.wh.space
++ (?&NM) cap to name \R linebreak
++ \S \W \D \H negate
+ FUNCTION RETURN LISTS
+ stat localtime caller SPECIAL VARIABLES
+- 0 dev 0 second 0 package $_ default variable
+- 1 ino 1 minute 1 filename $0 program name
+- 2 mode 2 hour 2 line $/ input separator
+- 3 nlink 3 day 3 subroutine $\ output separator
+- 4 uid 4 month-1 4 hasargs $| autoflush
+- 5 gid 5 year-1900 5 wantarray $! sys/libcall error
+- 6 rdev 6 weekday 6 evaltext $@ eval error
+- 7 size 7 yearday 7 is_require $$ process ID
+- 8 atime 8 is_dst 8 hints $. line number
+- 9 mtime 9 bitmask @ARGV command line args
+- 10 ctime just use @INC include paths
+- 11 blksz POSIX:: 3..9 only @_ subroutine args
+- 12 blcks strftime! with EXPR %ENV environment
++ 0 dev 0 second 0 package $_ default variable
++ 1 ino 1 minute 1 filename $0 program name
++ 2 mode 2 hour 2 line $/ input separator
++ 3 nlink 3 day 3 subroutine $\ output separator
++ 4 uid 4 month-1 4 hasargs $| autoflush
++ 5 gid 5 year-1900 5 wantarray $! sys/libcall error
++ 6 rdev 6 weekday 6 evaltext $@ eval error
++ 7 size 7 yearday 7 is_require $$ process ID
++ 8 atime 8 is_dst 8 hints $. line number
++ 9 mtime 9 bitmask @ARGV command line args
++ 10 ctime 10 hinthash @INC include paths
++ 11 blksz 3..10 only @_ subroutine args
++ 12 blcks with EXPR %ENV environment
+
+ =head1 ACKNOWLEDGEMENTS
+
diff -Nru perl-5.14.2/debian/patches/fixes/reading-glob-copy-handle.diff perl-5.14.2/debian/patches/fixes/reading-glob-copy-handle.diff
--- perl-5.14.2/debian/patches/fixes/reading-glob-copy-handle.diff 1970-01-01 02:00:00.000000000 +0200
+++ perl-5.14.2/debian/patches/fixes/reading-glob-copy-handle.diff 2012-10-21 19:10:33.000000000 +0300
@@ -0,0 +1,84 @@
+From 79336c812d09ba475bff661f849514b3876a73dd Mon Sep 17 00:00:00 2001
+From: Father Chrysostomos <sprout@cpan.org>
+Date: Sun, 5 Jun 2011 22:37:54 -0700
+Subject: <$fh> hangs on a glob copy
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Opening a file handle to \$glob causes assertion failures
+(under debugging) or hangs or other erratic behaviour without
+debugging. This might even crash in some cases.
+
+It never really worked properly, but it didn’t start hanging
+apparently until 5.12.2 and 5.14.0.
+
+Bug: http://rt.perl.org/rt3/Public/Bug/Display.html?id=92258
+Bug-Debian: http://bugs.debian.org/629363
+Origin: upstream, http://perl5.git.perl.org/perl.git/commit/fd1564b91b0e38f6c270a1bb7d144762ab1aea5c
+Patch-Name: fixes/reading-glob-copy-handle.diff
+---
+ ext/PerlIO-scalar/scalar.xs | 13 ++++++++++---
+ t/io/perlio.t | 8 +++++++-
+ 2 files changed, 17 insertions(+), 4 deletions(-)
+
+diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
+index de98738..e0f75ac 100644
+--- a/ext/PerlIO-scalar/scalar.xs
++++ b/ext/PerlIO-scalar/scalar.xs
+@@ -240,9 +240,13 @@ PerlIOScalar_get_cnt(pTHX_ PerlIO * f)
+ {
+ if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
+ PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
++ STRLEN len;
+ SvGETMAGIC(s->var);
+- if (SvCUR(s->var) > (STRLEN) s->posn)
+- return SvCUR(s->var) - (STRLEN)s->posn;
++ if (isGV_with_GP(s->var))
++ (void)SvPV(s->var,len);
++ else len = SvCUR(s->var);
++ if (len > (STRLEN) s->posn)
++ return len - (STRLEN)s->posn;
+ else
+ return 0;
+ }
+@@ -264,9 +268,12 @@ void
+ PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
+ {
+ PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
++ STRLEN len;
+ PERL_UNUSED_ARG(ptr);
+ SvGETMAGIC(s->var);
+- s->posn = SvCUR(s->var) - cnt;
++ if (isGV_with_GP(s->var)) (void)SvPV(s->var,len);
++ else len = SvCUR(s->var);
++ s->posn = len - cnt;
+ }
+
+ PerlIO *
+diff --git a/t/io/perlio.t b/t/io/perlio.t
+index 1a330f4..a65b0d3 100644
+--- a/t/io/perlio.t
++++ b/t/io/perlio.t
+@@ -6,7 +6,7 @@ BEGIN {
+ skip_all_without_perlio();
+ }
+
+-plan tests => 42;
++plan tests => 44;
+
+ use_ok('PerlIO');
+
+@@ -191,6 +191,12 @@ close ($perlio);
+ close ($no_perlio);
+ }
+
++{ # [perl #92258]
++ open my $fh, "<", \(my $f = *f);
++ is join("", <$fh>), '*main::f', 'reading from a glob copy';
++ is ref \$f, 'GLOB', 'the glob copy is unaffected';
++}
++
+ }
+
+
diff -Nru perl-5.14.2/debian/patches/fixes/regexp-matching-fold.diff perl-5.14.2/debian/patches/fixes/regexp-matching-fold.diff
--- perl-5.14.2/debian/patches/fixes/regexp-matching-fold.diff 1970-01-01 02:00:00.000000000 +0200
+++ perl-5.14.2/debian/patches/fixes/regexp-matching-fold.diff 2012-10-21 19:10:33.000000000 +0300
@@ -0,0 +1,51 @@
+From df7aadd27f9aa2fcd9467d1a2c6f02ddf97a84b9 Mon Sep 17 00:00:00 2001
+From: Karl Williamson <public@khwilliamson.com>
+Date: Thu, 13 Oct 2011 19:56:45 -0600
+Subject: regexec.c: Fix "\x{FB01}\x{FB00}" =~ /ff/i
+
+Only the first character of the string was being checked when scanning
+for the beginning position of the pattern match.
+
+This was so wrong, it looks like it has to be a regression. I
+experimented a little and did not find any. I believe (but am not
+certain) that a multi-char fold has to be involved. The the handling of
+these was so broken before 5.14 that there very well may not be a
+regression.
+
+Bug-Debian: http://bugs.debian.org/690976
+Origin: upstream, http://perl5.git.perl.org/perl.git/commit/399fb9c0594c29de7dc8815c6596bd6a67ddc9e6
+Patch-Name: fixes/regexp-matching-fold.diff
+---
+ regexec.c | 3 ++-
+ t/re/re_tests | 6 ++++++
+ 2 files changed, 8 insertions(+), 1 deletion(-)
+
+diff --git a/regexec.c b/regexec.c
+index 2354be1..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() */
+diff --git a/t/re/re_tests b/t/re/re_tests
+index 35a7220..ae12452 100644
+--- a/t/re/re_tests
++++ b/t/re/re_tests
+@@ -1522,4 +1522,10 @@ 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}
++
+ # vim: softtabstop=0 noexpandtab
diff -Nru perl-5.14.2/debian/patches/fixes/regexp-matching-opposite-case.diff perl-5.14.2/debian/patches/fixes/regexp-matching-opposite-case.diff
--- perl-5.14.2/debian/patches/fixes/regexp-matching-opposite-case.diff 1970-01-01 02:00:00.000000000 +0200
+++ perl-5.14.2/debian/patches/fixes/regexp-matching-opposite-case.diff 2012-10-21 19:10:33.000000000 +0300
@@ -0,0 +1,132 @@
+From 39d47b454e4e0498e35ba00a9d928d87348c8304 Mon Sep 17 00:00:00 2001
+From: Karl Williamson <public@khwilliamson.com>
+Date: Thu, 27 Oct 2011 09:39:11 -0600
+Subject: /[[:lower:]]/i matches upper case
+
+This bug is a regression in 5.14, in which /[[:lower:]]/i and
+/[[:upper:]]/i no longer matched the opposite case.
+
+The fix is to have these use a different table under /i matching, that
+includes the correct /i code points. These tables were already
+available, just unused.
+
+Bug: http://rt.perl.org/rt3/Public/Bug/Display.html?id=101970
+Bug-Debian: http://bugs.debian.org/690979
+Origin: upstream, http://perl5.git.perl.org/perl.git/commit/dc91d5ae29f578629526894098163d30c2d3a951
+Patch-Name: fixes/regexp-matching-opposite-case.diff
+---
+ regcomp.c | 51 ++++++++++++++++++++++++++++++++-------------------
+ t/re/re_tests | 4 ++++
+ 2 files changed, 36 insertions(+), 19 deletions(-)
+
+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/t/re/re_tests b/t/re/re_tests
+index ae12452..144cf1e 100644
+--- a/t/re/re_tests
++++ b/t/re/re_tests
+@@ -1528,4 +1528,8 @@ abc\N{def - c - \\N{NAME} must be resolved by the lexer
+ /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 -Nru perl-5.14.2/debian/patches/fixes/regexp-matching-starter.diff perl-5.14.2/debian/patches/fixes/regexp-matching-starter.diff
--- perl-5.14.2/debian/patches/fixes/regexp-matching-starter.diff 1970-01-01 02:00:00.000000000 +0200
+++ perl-5.14.2/debian/patches/fixes/regexp-matching-starter.diff 2012-10-21 19:10:33.000000000 +0300
@@ -0,0 +1,58 @@
+From 9dc7c3307242fe74116b62a2cc55a63544131a2d Mon Sep 17 00:00:00 2001
+From: Karl Williamson <public@khwilliamson.com>
+Date: Tue, 1 Nov 2011 17:57:15 -0600
+Subject: Regression with /i, latin1 chars.
+
+The root cause of this bug is that it was assuming that a string was in
+utf8 when it wasn't, and so was thinking that a byte was a starter byte
+that wasn't, so was skipping ahead based on that starter byte.
+
+Bug: http://rt.perl.org/rt3/Public/Bug/Display.html?id=101710
+Bug-Debian: http://bugs.debian.org/690975
+Origin: upstream, http://perl5.git.perl.org/perl.git/commit/6e634c54a0f90c8878c8086142fe3451f8970a9e
+Patch-Name: fixes/regexp-matching-starter.diff
+---
+ regexec.c | 2 +-
+ t/re/pat.t | 9 ++++++++-
+ 2 files changed, 9 insertions(+), 2 deletions(-)
+
+diff --git a/regexec.c b/regexec.c
+index 0dc093f..2354be1 100644
+--- a/regexec.c
++++ b/regexec.c
+@@ -1521,7 +1521,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/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 -Nru perl-5.14.2/debian/patches/fixes/smartmatch-rhs-precedence.diff perl-5.14.2/debian/patches/fixes/smartmatch-rhs-precedence.diff
--- perl-5.14.2/debian/patches/fixes/smartmatch-rhs-precedence.diff 1970-01-01 02:00:00.000000000 +0200
+++ perl-5.14.2/debian/patches/fixes/smartmatch-rhs-precedence.diff 2012-10-21 19:10:35.000000000 +0300
@@ -0,0 +1,51 @@
+From 0d0e8db75c2c00e8863043c3efeaedff4fd62aa4 Mon Sep 17 00:00:00 2001
+From: Leon Timmermans <fawaka@gmail.com>
+Date: Mon, 23 Jan 2012 02:01:00 +0100
+Subject: Enforce Any ~~ Object smartmatch precedence
+
+Origin: upstream, http://perl5.git.perl.org/perl.git/commit/011be0badf32a8d73f13b6565fbd8c398f8ab27e
+Bug-Debian: http://bugs.debian.org/691102
+Patch-Name: fixes/smartmatch-rhs-precedence.diff
+
+See the related discussion at
+ http://www.nntp.perl.org/group/perl.perl5.porters/2011/07/msg174260.html
+---
+ pp_ctl.c | 2 +-
+ t/op/smartmatch.t | 4 +---
+ 2 files changed, 2 insertions(+), 4 deletions(-)
+
+diff --git a/pp_ctl.c b/pp_ctl.c
+index 7c4651c..cbeeeee 100644
+--- a/pp_ctl.c
++++ b/pp_ctl.c
+@@ -4374,7 +4374,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
+ DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Object\n"));
+ DEBUG_M(Perl_deb(aTHX_ " attempting overload\n"));
+
+- tmpsv = amagic_call(d, e, smart_amg, 0);
++ tmpsv = amagic_call(d, e, smart_amg, AMGf_noleft);
+ if (tmpsv) {
+ SPAGAIN;
+ (void)POPs;
+diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t
+index da4840e..79c9847 100644
+--- a/t/op/smartmatch.t
++++ b/t/op/smartmatch.t
+@@ -73,7 +73,7 @@ my %keyandmore = map { $_ => 0 } @keyandmore;
+ my %fooormore = map { $_ => 0 } @fooormore;
+
+ # Load and run the tests
+-plan tests => 351;
++plan tests => 349;
+
+ while (<DATA>) {
+ SKIP: {
+@@ -223,8 +223,6 @@ __DATA__
+ @ "object" $str_obj
+ @ FALSE $str_obj
+ # Those will treat the $str_obj as a string because of fallback:
+-! $ov_obj $str_obj
+- $ov_obj_2 $str_obj
+
+ # object (overloaded or not) ~~ Any
+ $obj qr/NoOverload/
diff -Nru perl-5.14.2/debian/patches/fixes/tainted-smartmatch.diff perl-5.14.2/debian/patches/fixes/tainted-smartmatch.diff
--- perl-5.14.2/debian/patches/fixes/tainted-smartmatch.diff 1970-01-01 02:00:00.000000000 +0200
+++ perl-5.14.2/debian/patches/fixes/tainted-smartmatch.diff 2012-10-21 19:10:33.000000000 +0300
@@ -0,0 +1,186 @@
+From bbcc2ed685e887c153554b86f2bbbd53e7e9b06d Mon Sep 17 00:00:00 2001
+From: Father Chrysostomos <sprout@cpan.org>
+Date: Tue, 20 Sep 2011 08:55:09 -0700
+Subject: $tainted ~~ [...] failing
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+When smartmatch is about to start, to avoid calling get-magic (e.g.,
+FETCH methods) more than once, it copies any argument that has
+get-magic.
+
+Tainting uses get-magic to taint the expression. Calling mg_get(sv)
+on a tainted scalar causes PL_tainted to be set, causing any scalars
+modified by sv_setsv_flags to be tainted. That means that tainting
+magic gets copied from one scalar to another.
+
+So when smartmatch tries to copy the variable to avoid repeated calls
+to magic, it still copies taint magic to the new variable.
+
+For $scalar ~~ @array (or ~~ [...]), S_do_smartmatch calls itself
+recursively for each element of @array, with $scalar (on the suppos-
+edly non-magical copy of $scalar) on the left and the element on
+the right.
+
+In that recursive call, it again does the get-magic check and copies
+the argument. Since the copied of a tainted variable on the LHS is
+magical, it gets copied again. Since the first copy is a mortal
+(marked TEMP) with a refcount of one, the second copy steal its
+string buffer.
+
+The outer call to S_do_smartmatch then proceeds with the second ele-
+ment of @array, without realising that its copy of $scalar has lost
+its string buffer and is now undefined.
+
+So these produce incorrect results under -T (where $^X is ‘perl’):
+
+ $^X =~ ["whatever", undef] # matches
+ $^X =~ ["whatever", "perl"] # fails
+
+This problem did not start occurring until this commit:
+
+commit 8985fe98dcc5c0af2fadeac15dfbc13f553ee7fc
+Author: David Mitchell <davem@iabyn.com>
+Date: Thu Dec 30 10:32:44 2010 +0000
+
+ Better handling of magic methods freeing the SV
+
+mg_get used to increase the refcount unconditionally, pushing it on to
+the mortals stack. So the magical copy would have had a refcount of
+2, preventing its string buffer from being stolen. Now it has a ref-
+erence count of 1.
+
+This commit solves it by adding a new parameter to S_do_smartmatch
+telling it that the variable has already been copied and does not even
+need to be checked. The $scalar~~@array case sets that parameter for
+the recursive calls. That avoids the whole string-stealing problem
+*and* avoids extra unnecessary SVs.
+
+Bug: http://rt.perl.org/rt3/Public/Bug/Display.html?id=93590
+Bug-Debian: http://bugs.debian.org/690571
+Origin: upstream, http://perl5.git.perl.org/perl.git/commit/be88a5c3cc8efc0dbee86240eabf0050554fc717
+Patch-Name: fixes/tainted-smartmatch.diff
+
+(Backported to 5.14 by Niko Tyni.)
+---
+ embed.fnc | 3 ++-
+ embed.h | 2 +-
+ pp_ctl.c | 10 +++++-----
+ proto.h | 2 +-
+ t/op/taint.t | 7 ++++++-
+ 5 files changed, 15 insertions(+), 9 deletions(-)
+
+diff --git a/embed.fnc b/embed.fnc
+index bce167e..e508212 100644
+--- a/embed.fnc
++++ b/embed.fnc
+@@ -1739,7 +1739,8 @@ sR |I32 |run_user_filter|int idx|NN SV *buf_sv|int maxlen
+ sR |PMOP* |make_matcher |NN REGEXP* re
+ sR |bool |matcher_matches_sv|NN PMOP* matcher|NN SV* sv
+ s |void |destroy_matcher|NN PMOP* matcher
+-s |OP* |do_smartmatch |NULLOK HV* seen_this|NULLOK HV* seen_other
++s |OP* |do_smartmatch |NULLOK HV* seen_this \
++ |NULLOK HV* seen_other|const bool copied
+ #endif
+
+ #if defined(PERL_IN_PP_HOT_C)
+diff --git a/embed.h b/embed.h
+index 04b32d1..b2876f4 100644
+--- a/embed.h
++++ b/embed.h
+@@ -1382,7 +1382,7 @@
+ # if defined(PERL_IN_PP_CTL_C)
+ #define check_type_and_open(a) S_check_type_and_open(aTHX_ a)
+ #define destroy_matcher(a) S_destroy_matcher(aTHX_ a)
+-#define do_smartmatch(a,b) S_do_smartmatch(aTHX_ a,b)
++#define do_smartmatch(a,b,c) S_do_smartmatch(aTHX_ a,b,c)
+ #define docatch(a) S_docatch(aTHX_ a)
+ #define doeval(a,b,c,d) S_doeval(aTHX_ a,b,c,d)
+ #define dofindlabel(a,b,c,d) S_dofindlabel(aTHX_ a,b,c,d)
+diff --git a/pp_ctl.c b/pp_ctl.c
+index 60bc30d..7c4651c 100644
+--- a/pp_ctl.c
++++ b/pp_ctl.c
+@@ -4339,14 +4339,14 @@ S_destroy_matcher(pTHX_ PMOP *matcher)
+ PP(pp_smartmatch)
+ {
+ DEBUG_M(Perl_deb(aTHX_ "Starting smart match resolution\n"));
+- return do_smartmatch(NULL, NULL);
++ return do_smartmatch(NULL, NULL, 0);
+ }
+
+ /* This version of do_smartmatch() implements the
+ * table of smart matches that is found in perlsyn.
+ */
+ STATIC OP *
+-S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
++S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
+ {
+ dVAR;
+ dSP;
+@@ -4358,7 +4358,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
+ /* Take care only to invoke mg_get() once for each argument.
+ * Currently we do this by copying the SV if it's magical. */
+ if (d) {
+- if (SvGMAGICAL(d))
++ if (!copied && SvGMAGICAL(d))
+ d = sv_mortalcopy(d);
+ }
+ else
+@@ -4669,7 +4669,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
+
+ PUTBACK;
+ DEBUG_M(Perl_deb(aTHX_ " recursively comparing array element...\n"));
+- (void) do_smartmatch(seen_this, seen_other);
++ (void) do_smartmatch(seen_this, seen_other, 0);
+ SPAGAIN;
+ DEBUG_M(Perl_deb(aTHX_ " recursion finished\n"));
+
+@@ -4731,7 +4731,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
+ PUTBACK;
+ /* infinite recursion isn't supposed to happen here */
+ DEBUG_M(Perl_deb(aTHX_ " recursively testing array element...\n"));
+- (void) do_smartmatch(NULL, NULL);
++ (void) do_smartmatch(NULL, NULL, 1);
+ SPAGAIN;
+ DEBUG_M(Perl_deb(aTHX_ " recursion finished\n"));
+ if (SvTRUEx(POPs))
+diff --git a/proto.h b/proto.h
+index 0b46a79..666e0d6 100644
+--- a/proto.h
++++ b/proto.h
+@@ -5696,7 +5696,7 @@ STATIC void S_destroy_matcher(pTHX_ PMOP* matcher)
+ #define PERL_ARGS_ASSERT_DESTROY_MATCHER \
+ assert(matcher)
+
+-STATIC OP* S_do_smartmatch(pTHX_ HV* seen_this, HV* seen_other);
++STATIC OP* S_do_smartmatch(pTHX_ HV* seen_this, HV* seen_other, const bool copied);
+ STATIC OP* S_docatch(pTHX_ OP *o)
+ __attribute__warn_unused_result__;
+
+diff --git a/t/op/taint.t b/t/op/taint.t
+index 3a2b5d9..3929f58 100644
+--- a/t/op/taint.t
++++ b/t/op/taint.t
+@@ -17,7 +17,7 @@ BEGIN {
+ use strict;
+ use Config;
+
+-plan tests => 779;
++plan tests => 781;
+
+ $| = 1;
+
+@@ -2156,6 +2156,11 @@ end
+ ok(!tainted "", "tainting still works after index() of the constant");
+ }
+
++# Tainted values with smartmatch
++# [perl #93590] S_do_smartmatch stealing its own string buffers
++ok "M$TAINT" ~~ ['m', 'M'], '$tainted ~~ ["whatever", "match"]';
++ok !("M$TAINT" ~~ ['m', undef]), '$tainted ~~ ["whatever", undef]';
++
+ { # 111654
+ eval {
+ eval { die "Test\n".substr($ENV{PATH}, 0, 0); };
diff -Nru perl-5.14.2/debian/patches/series perl-5.14.2/debian/patches/series
--- perl-5.14.2/debian/patches/series 2012-10-10 21:16:46.000000000 +0300
+++ perl-5.14.2/debian/patches/series 2012-10-21 19:10:35.000000000 +0300
@@ -61,3 +61,12 @@
fixes/socket_cache_propagate.diff
fixes/ipc_open3.diff
fixes/string_repeat_overrun.diff
+debian/cpan-missing-site-dirs.diff
+fixes/kfreebsd-overrides.diff
+fixes/tainted-smartmatch.diff
+fixes/regexp-matching-starter.diff
+fixes/regexp-matching-fold.diff
+fixes/regexp-matching-opposite-case.diff
+fixes/reading-glob-copy-handle.diff
+fixes/smartmatch-rhs-precedence.diff
+fixes/perlcheat-update.diff
>From 0b575dfeee79f43c5e7779ee0c80010f0f2fe62b Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Tue, 16 Oct 2012 23:07:56 +0300
Subject: Fix CPAN::FirstTime defaults with nonexisting site dirs if a parent
is writable
The site directories do not exist on a typical Debian system. The build
systems will create them when necessary, so there's no need for a prompt
suggesting local::lib if the first existing parent directory is writable.
Also, writability of the core directories is not interesting as we
explicitly tell CPAN not to touch those with INSTALLDIRS=site.
Bug-Debian: http://bugs.debian.org/688842
Patch-Name: debian/cpan-missing-site-dirs.diff
---
cpan/CPAN/lib/CPAN/FirstTime.pm | 31 +++++++++++++++++++++++++++----
1 file changed, 27 insertions(+), 4 deletions(-)
diff --git a/cpan/CPAN/lib/CPAN/FirstTime.pm b/cpan/CPAN/lib/CPAN/FirstTime.pm
index c38c890..bca3c8f 100644
--- a/cpan/CPAN/lib/CPAN/FirstTime.pm
+++ b/cpan/CPAN/lib/CPAN/FirstTime.pm
@@ -2003,11 +2003,34 @@ sub _print_urllist {
};
}
+# Debian modification: return true if this directory
+# or the first existing one upwards is writable
+sub _can_write_to_this_or_parent {
+ my ($dir) = @_;
+ my @parts = File::Spec->splitdir($dir);
+ while (@parts) {
+ my $cur = File::Spec->catdir(@parts);
+ return 1 if -w $cur;
+ return 0 if -e _;
+ pop @parts;
+ }
+ return 0;
+}
+
+# Debian specific modification: the site directories don't necessarily
+# exist on the system, but the build systems create them when necessary,
+# so return true if the first existing directory upwards is writable
+#
+# Furthermore, on Debian, only test the site directories
+# (installsite*, expanded to /usr/local/{share,lib}/perl),
+# not the core ones
+# (install*lib, expanded to /usr/{share,lib}/perl).
+# We pass INSTALLDIRS=site by default to keep CPAN from touching
+# the core directories.
+
sub _can_write_to_libdirs {
- return -w $Config{installprivlib}
- && -w $Config{installarchlib}
- && -w $Config{installsitelib}
- && -w $Config{installsitearch}
+ return _can_write_to_this_or_parent($Config{installsitelib})
+ && _can_write_to_this_or_parent($Config{installsitearch})
}
sub _using_installbase {
>From 51233d46ac437fd272fcf3db0dc79e3700954a41 Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Wed, 17 Oct 2012 12:56:43 -0400
Subject: Remove unnecessary overrides in gnukfreebsd and gnuknetbsd hints.
hints/gnukfreebsd.sh and hints/gnuknetbsd.sh unconditionally
override Configure's values for ccdlflags and lddlflags, even though
the default Configure guesses should be correct for those systems.
Configure was altered in commit fb2e1bc0638d5a5d7ac552a79a71a996a5d604cc
(Perforce change 23909) to get the correct values, but later commit
46c947e8b9def6de34ac831834a3c290ab266515 (Perforce change 24017) included
these now-outdated hints file changes as part of importing a larger set
of patches from Debian.
This patch removes the unnecessary overrides. Thanks to Niko Tyni for
digging up the history and supplying the hints/gnukfreebsd.sh patch.
Origin: upstream, http://perl5.git.perl.org/perl.git/commit/7dc65651902f0390dfb92783b32c0b4976885475
Bug: http://rt.perl.org/rt3/Ticket/Display.html?id=115324
Bug-Debian: http://bugs.debian.org/689713
Patch-Name: fixes/kfreebsd-overrides.diff
---
hints/gnukfreebsd.sh | 3 ---
hints/gnuknetbsd.sh | 3 ---
2 files changed, 6 deletions(-)
diff --git a/hints/gnukfreebsd.sh b/hints/gnukfreebsd.sh
index 1225f69..435afe7 100644
--- a/hints/gnukfreebsd.sh
+++ b/hints/gnukfreebsd.sh
@@ -5,6 +5,3 @@
. ./hints/linux.sh
-# Configure sets these where $osname = linux
-ccdlflags='-Wl,-E'
-lddlflags='-shared'
diff --git a/hints/gnuknetbsd.sh b/hints/gnuknetbsd.sh
index 6ee1433..008547f 100644
--- a/hints/gnuknetbsd.sh
+++ b/hints/gnuknetbsd.sh
@@ -5,6 +5,3 @@
. ./hints/linux.sh
-# Configure sets these where $osname = linux
-ccdlflags='-Wl,-E'
-lddlflags='-shared'
>From 41a55c909a7df9ee1d986a010351d23e19b39bba Mon Sep 17 00:00:00 2001
From: "H.Merijn Brand" <h.m.brand@xs4all.nl>
Date: Tue, 14 Jun 2011 20:12:01 +0200
Subject: Update PerlCheat to 5.14
Origin: upstream, http://perl5.git.perl.org/perl.git/commit/ab0ae0ad72e5601626d0b408edd884d7bd14d7dd
Bug-Debian: http://bugs.debian.org/691112
Patch-Name: fixes/perlcheat-update.diff
See the discussion at
http://www.nntp.perl.org/group/perl.perl5.porters/2011/06/msg173391.html
---
pod/perlcheat.pod | 118 +++++++++++++++++++++++++++--------------------------
1 file changed, 60 insertions(+), 58 deletions(-)
diff --git a/pod/perlcheat.pod b/pod/perlcheat.pod
index d210fa0..deee2fe 100644
--- a/pod/perlcheat.pod
+++ b/pod/perlcheat.pod
@@ -10,68 +10,70 @@ already be overwhelming.
=head2 The sheet
- CONTEXTS SIGILS ARRAYS HASHES
- void $scalar whole: @array %hash
- scalar @array slice: @array[0, 2] @hash{'a', 'b'}
- list %hash element: $array[0] $hash{'a'}
- &sub
- *glob SCALAR VALUES
- number, string, reference, glob, undef
+ CONTEXTS SIGILS ref ARRAYS HASHES
+ void $scalar SCALAR @array %hash
+ scalar @array ARRAY @array[0, 2] @hash{'a', 'b'}
+ list %hash HASH $array[0] $hash{'a'}
+ &sub CODE
+ *glob GLOB SCALAR VALUES
+ FORMAT number, string, ref, glob, undef
REFERENCES
- \ references $$foo[1] aka $foo->[1]
- $@%&* dereference $$foo{bar} aka $foo->{bar}
- [] anon. arrayref ${$$foo[1]}[2] aka $foo->[1]->[2]
- {} anon. hashref ${$$foo[1]}[2] aka $foo->[1][2]
- \() list of refs
- NUMBERS vs STRINGS LINKS
- OPERATOR PRECEDENCE = = perl.plover.com
- -> + . search.cpan.org
- ++ -- == != eq ne cpan.org
- ** < > <= >= lt gt le ge pm.org
- ! ~ \ u+ u- <=> cmp tpj.com
- =~ !~ perldoc.com
- * / % x SYNTAX
- + - . for (LIST) { }, for (a;b;c) { }
- << >> while ( ) { }, until ( ) { }
- named uops if ( ) { } elsif ( ) { } else { }
- < > <= >= lt gt le ge unless ( ) { } elsif ( ) { } else { }
- == != <=> eq ne cmp ~~ for equals foreach (ALWAYS)
+ \ reference $$foo[1] aka $foo->[1]
+ $@%&* dereference $$foo{bar} aka $foo->{bar}
+ [] anon. arrayref ${$$foo[1]}[2] aka $foo->[1]->[2]
+ {} anon. hashref ${$$foo[1]}[2] aka $foo->[1][2]
+ \() list of refs
+ NUMBERS vs STRINGS LINKS
+ OPERATOR PRECEDENCE = = perldoc.perl.org
+ -> + . search.cpan.org
+ ++ -- == != eq ne cpan.org
+ ** < > <= >= lt gt le ge pm.org
+ ! ~ \ u+ u- <=> cmp p3rl.org
+ =~ !~ perlmonks.org
+ * / % x SYNTAX
+ + - . foreach (LIST) { } for (a;b;c) { }
+ << >> while (e) { } until (e) { }
+ named uops if (e) { } elsif (e) { } else { }
+ < > <= >= lt gt le ge unless (e) { } elsif (e) { } else { }
+ == != <=> eq ne cmp ~~ given (e) { when (e) {} default {} }
&
- | ^ REGEX METACHARS REGEX MODIFIERS
- && ^ string begin /i case insens.
- || // $ str. end (before \n) /m line based ^$
- .. ... + one or more /s . includes \n
- ?: * zero or more /x ign. wh.space
- = += -= *= etc. ? zero or one /g global
- , => {3,7} repeat in range /o cmpl pat. once
- list ops () capture
- not (?:) no capture REGEX CHARCLASSES
- and [] character class . == [^\n]
- or xor | alternation \s == whitespace
- \b word boundary \w == word characters
- \z string end \d == digits
- DO \S, \W and \D negate
- use strict; DON'T
- use warnings; "$foo" LINKS
- my $var; $$variable_name perl.com
- open() or die $!; `$userinput` use.perl.org
- use Modules; /$userinput/ perl.apache.org
-
+ | ^ REGEX METACHARS REGEX MODIFIERS
+ && ^ string begin /i case insensitive
+ || // $ str end (bfr \n) /m line based ^$
+ .. ... + one or more /s . includes \n
+ ?: * zero or more /x ignore wh.space
+ = += -= *= etc ? zero or one /p preserve
+ , => {3,7} repeat in range /a ASCII /aa safe
+ list ops | alternation /l locale /d dual
+ not [] character class /u Unicode
+ and \b word boundary /e evaluate /ee rpts
+ or xor \z string end /g global
+ () capture /o compile pat once
+ DEBUG (?:p) no capture
+ -MO=Deparse (?#t) comment REGEX CHARCLASSES
+ -MO=Terse (?=p) ZW pos ahead . [^\n]
+ -D## (?!p) ZW neg ahead \s whitespace
+ -d:Trace (?<=p) ZW pos behind \K \w word chars
+ (?<!p) ZW neg behind \d digits
+ CONFIGURATION (?>p) no backtrack \pP named property
+ perl -V:ivsize (?|p|p)branch reset \h horiz.wh.space
+ (?&NM) cap to name \R linebreak
+ \S \W \D \H negate
FUNCTION RETURN LISTS
stat localtime caller SPECIAL VARIABLES
- 0 dev 0 second 0 package $_ default variable
- 1 ino 1 minute 1 filename $0 program name
- 2 mode 2 hour 2 line $/ input separator
- 3 nlink 3 day 3 subroutine $\ output separator
- 4 uid 4 month-1 4 hasargs $| autoflush
- 5 gid 5 year-1900 5 wantarray $! sys/libcall error
- 6 rdev 6 weekday 6 evaltext $@ eval error
- 7 size 7 yearday 7 is_require $$ process ID
- 8 atime 8 is_dst 8 hints $. line number
- 9 mtime 9 bitmask @ARGV command line args
- 10 ctime just use @INC include paths
- 11 blksz POSIX:: 3..9 only @_ subroutine args
- 12 blcks strftime! with EXPR %ENV environment
+ 0 dev 0 second 0 package $_ default variable
+ 1 ino 1 minute 1 filename $0 program name
+ 2 mode 2 hour 2 line $/ input separator
+ 3 nlink 3 day 3 subroutine $\ output separator
+ 4 uid 4 month-1 4 hasargs $| autoflush
+ 5 gid 5 year-1900 5 wantarray $! sys/libcall error
+ 6 rdev 6 weekday 6 evaltext $@ eval error
+ 7 size 7 yearday 7 is_require $$ process ID
+ 8 atime 8 is_dst 8 hints $. line number
+ 9 mtime 9 bitmask @ARGV command line args
+ 10 ctime 10 hinthash @INC include paths
+ 11 blksz 3..10 only @_ subroutine args
+ 12 blcks with EXPR %ENV environment
=head1 ACKNOWLEDGEMENTS
>From 79336c812d09ba475bff661f849514b3876a73dd Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 5 Jun 2011 22:37:54 -0700
Subject: <$fh> hangs on a glob copy
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Opening a file handle to \$glob causes assertion failures
(under debugging) or hangs or other erratic behaviour without
debugging. This might even crash in some cases.
It never really worked properly, but it didn’t start hanging
apparently until 5.12.2 and 5.14.0.
Bug: http://rt.perl.org/rt3/Public/Bug/Display.html?id=92258
Bug-Debian: http://bugs.debian.org/629363
Origin: upstream, http://perl5.git.perl.org/perl.git/commit/fd1564b91b0e38f6c270a1bb7d144762ab1aea5c
Patch-Name: fixes/reading-glob-copy-handle.diff
---
ext/PerlIO-scalar/scalar.xs | 13 ++++++++++---
t/io/perlio.t | 8 +++++++-
2 files changed, 17 insertions(+), 4 deletions(-)
diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index de98738..e0f75ac 100644
--- a/ext/PerlIO-scalar/scalar.xs
+++ b/ext/PerlIO-scalar/scalar.xs
@@ -240,9 +240,13 @@ PerlIOScalar_get_cnt(pTHX_ PerlIO * f)
{
if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+ STRLEN len;
SvGETMAGIC(s->var);
- if (SvCUR(s->var) > (STRLEN) s->posn)
- return SvCUR(s->var) - (STRLEN)s->posn;
+ if (isGV_with_GP(s->var))
+ (void)SvPV(s->var,len);
+ else len = SvCUR(s->var);
+ if (len > (STRLEN) s->posn)
+ return len - (STRLEN)s->posn;
else
return 0;
}
@@ -264,9 +268,12 @@ void
PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
{
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+ STRLEN len;
PERL_UNUSED_ARG(ptr);
SvGETMAGIC(s->var);
- s->posn = SvCUR(s->var) - cnt;
+ if (isGV_with_GP(s->var)) (void)SvPV(s->var,len);
+ else len = SvCUR(s->var);
+ s->posn = len - cnt;
}
PerlIO *
diff --git a/t/io/perlio.t b/t/io/perlio.t
index 1a330f4..a65b0d3 100644
--- a/t/io/perlio.t
+++ b/t/io/perlio.t
@@ -6,7 +6,7 @@ BEGIN {
skip_all_without_perlio();
}
-plan tests => 42;
+plan tests => 44;
use_ok('PerlIO');
@@ -191,6 +191,12 @@ close ($perlio);
close ($no_perlio);
}
+{ # [perl #92258]
+ open my $fh, "<", \(my $f = *f);
+ is join("", <$fh>), '*main::f', 'reading from a glob copy';
+ is ref \$f, 'GLOB', 'the glob copy is unaffected';
+}
+
}
>From df7aadd27f9aa2fcd9467d1a2c6f02ddf97a84b9 Mon Sep 17 00:00:00 2001
From: Karl Williamson <public@khwilliamson.com>
Date: Thu, 13 Oct 2011 19:56:45 -0600
Subject: regexec.c: Fix "\x{FB01}\x{FB00}" =~ /ff/i
Only the first character of the string was being checked when scanning
for the beginning position of the pattern match.
This was so wrong, it looks like it has to be a regression. I
experimented a little and did not find any. I believe (but am not
certain) that a multi-char fold has to be involved. The the handling of
these was so broken before 5.14 that there very well may not be a
regression.
Bug-Debian: http://bugs.debian.org/690976
Origin: upstream, http://perl5.git.perl.org/perl.git/commit/399fb9c0594c29de7dc8815c6596bd6a67ddc9e6
Patch-Name: fixes/regexp-matching-fold.diff
---
regexec.c | 3 ++-
t/re/re_tests | 6 ++++++
2 files changed, 8 insertions(+), 1 deletion(-)
diff --git a/regexec.c b/regexec.c
index 2354be1..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() */
diff --git a/t/re/re_tests b/t/re/re_tests
index 35a7220..ae12452 100644
--- a/t/re/re_tests
+++ b/t/re/re_tests
@@ -1522,4 +1522,10 @@ 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}
+
# vim: softtabstop=0 noexpandtab
>From 39d47b454e4e0498e35ba00a9d928d87348c8304 Mon Sep 17 00:00:00 2001
From: Karl Williamson <public@khwilliamson.com>
Date: Thu, 27 Oct 2011 09:39:11 -0600
Subject: /[[:lower:]]/i matches upper case
This bug is a regression in 5.14, in which /[[:lower:]]/i and
/[[:upper:]]/i no longer matched the opposite case.
The fix is to have these use a different table under /i matching, that
includes the correct /i code points. These tables were already
available, just unused.
Bug: http://rt.perl.org/rt3/Public/Bug/Display.html?id=101970
Bug-Debian: http://bugs.debian.org/690979
Origin: upstream, http://perl5.git.perl.org/perl.git/commit/dc91d5ae29f578629526894098163d30c2d3a951
Patch-Name: fixes/regexp-matching-opposite-case.diff
---
regcomp.c | 51 ++++++++++++++++++++++++++++++++-------------------
t/re/re_tests | 4 ++++
2 files changed, 36 insertions(+), 19 deletions(-)
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/t/re/re_tests b/t/re/re_tests
index ae12452..144cf1e 100644
--- a/t/re/re_tests
+++ b/t/re/re_tests
@@ -1528,4 +1528,8 @@ abc\N{def - c - \\N{NAME} must be resolved by the lexer
/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
>From 9dc7c3307242fe74116b62a2cc55a63544131a2d Mon Sep 17 00:00:00 2001
From: Karl Williamson <public@khwilliamson.com>
Date: Tue, 1 Nov 2011 17:57:15 -0600
Subject: Regression with /i, latin1 chars.
The root cause of this bug is that it was assuming that a string was in
utf8 when it wasn't, and so was thinking that a byte was a starter byte
that wasn't, so was skipping ahead based on that starter byte.
Bug: http://rt.perl.org/rt3/Public/Bug/Display.html?id=101710
Bug-Debian: http://bugs.debian.org/690975
Origin: upstream, http://perl5.git.perl.org/perl.git/commit/6e634c54a0f90c8878c8086142fe3451f8970a9e
Patch-Name: fixes/regexp-matching-starter.diff
---
regexec.c | 2 +-
t/re/pat.t | 9 ++++++++-
2 files changed, 9 insertions(+), 2 deletions(-)
diff --git a/regexec.c b/regexec.c
index 0dc093f..2354be1 100644
--- a/regexec.c
+++ b/regexec.c
@@ -1521,7 +1521,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/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;
>From 0d0e8db75c2c00e8863043c3efeaedff4fd62aa4 Mon Sep 17 00:00:00 2001
From: Leon Timmermans <fawaka@gmail.com>
Date: Mon, 23 Jan 2012 02:01:00 +0100
Subject: Enforce Any ~~ Object smartmatch precedence
Origin: upstream, http://perl5.git.perl.org/perl.git/commit/011be0badf32a8d73f13b6565fbd8c398f8ab27e
Bug-Debian: http://bugs.debian.org/691102
Patch-Name: fixes/smartmatch-rhs-precedence.diff
See the related discussion at
http://www.nntp.perl.org/group/perl.perl5.porters/2011/07/msg174260.html
---
pp_ctl.c | 2 +-
t/op/smartmatch.t | 4 +---
2 files changed, 2 insertions(+), 4 deletions(-)
diff --git a/pp_ctl.c b/pp_ctl.c
index 7c4651c..cbeeeee 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4374,7 +4374,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Object\n"));
DEBUG_M(Perl_deb(aTHX_ " attempting overload\n"));
- tmpsv = amagic_call(d, e, smart_amg, 0);
+ tmpsv = amagic_call(d, e, smart_amg, AMGf_noleft);
if (tmpsv) {
SPAGAIN;
(void)POPs;
diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t
index da4840e..79c9847 100644
--- a/t/op/smartmatch.t
+++ b/t/op/smartmatch.t
@@ -73,7 +73,7 @@ my %keyandmore = map { $_ => 0 } @keyandmore;
my %fooormore = map { $_ => 0 } @fooormore;
# Load and run the tests
-plan tests => 351;
+plan tests => 349;
while (<DATA>) {
SKIP: {
@@ -223,8 +223,6 @@ __DATA__
@ "object" $str_obj
@ FALSE $str_obj
# Those will treat the $str_obj as a string because of fallback:
-! $ov_obj $str_obj
- $ov_obj_2 $str_obj
# object (overloaded or not) ~~ Any
$obj qr/NoOverload/
>From bbcc2ed685e887c153554b86f2bbbd53e7e9b06d Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 20 Sep 2011 08:55:09 -0700
Subject: $tainted ~~ [...] failing
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
When smartmatch is about to start, to avoid calling get-magic (e.g.,
FETCH methods) more than once, it copies any argument that has
get-magic.
Tainting uses get-magic to taint the expression. Calling mg_get(sv)
on a tainted scalar causes PL_tainted to be set, causing any scalars
modified by sv_setsv_flags to be tainted. That means that tainting
magic gets copied from one scalar to another.
So when smartmatch tries to copy the variable to avoid repeated calls
to magic, it still copies taint magic to the new variable.
For $scalar ~~ @array (or ~~ [...]), S_do_smartmatch calls itself
recursively for each element of @array, with $scalar (on the suppos-
edly non-magical copy of $scalar) on the left and the element on
the right.
In that recursive call, it again does the get-magic check and copies
the argument. Since the copied of a tainted variable on the LHS is
magical, it gets copied again. Since the first copy is a mortal
(marked TEMP) with a refcount of one, the second copy steal its
string buffer.
The outer call to S_do_smartmatch then proceeds with the second ele-
ment of @array, without realising that its copy of $scalar has lost
its string buffer and is now undefined.
So these produce incorrect results under -T (where $^X is ‘perl’):
$^X =~ ["whatever", undef] # matches
$^X =~ ["whatever", "perl"] # fails
This problem did not start occurring until this commit:
commit 8985fe98dcc5c0af2fadeac15dfbc13f553ee7fc
Author: David Mitchell <davem@iabyn.com>
Date: Thu Dec 30 10:32:44 2010 +0000
Better handling of magic methods freeing the SV
mg_get used to increase the refcount unconditionally, pushing it on to
the mortals stack. So the magical copy would have had a refcount of
2, preventing its string buffer from being stolen. Now it has a ref-
erence count of 1.
This commit solves it by adding a new parameter to S_do_smartmatch
telling it that the variable has already been copied and does not even
need to be checked. The $scalar~~@array case sets that parameter for
the recursive calls. That avoids the whole string-stealing problem
*and* avoids extra unnecessary SVs.
Bug: http://rt.perl.org/rt3/Public/Bug/Display.html?id=93590
Bug-Debian: http://bugs.debian.org/690571
Origin: upstream, http://perl5.git.perl.org/perl.git/commit/be88a5c3cc8efc0dbee86240eabf0050554fc717
Patch-Name: fixes/tainted-smartmatch.diff
(Backported to 5.14 by Niko Tyni.)
---
embed.fnc | 3 ++-
embed.h | 2 +-
pp_ctl.c | 10 +++++-----
proto.h | 2 +-
t/op/taint.t | 7 ++++++-
5 files changed, 15 insertions(+), 9 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index bce167e..e508212 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1739,7 +1739,8 @@ sR |I32 |run_user_filter|int idx|NN SV *buf_sv|int maxlen
sR |PMOP* |make_matcher |NN REGEXP* re
sR |bool |matcher_matches_sv|NN PMOP* matcher|NN SV* sv
s |void |destroy_matcher|NN PMOP* matcher
-s |OP* |do_smartmatch |NULLOK HV* seen_this|NULLOK HV* seen_other
+s |OP* |do_smartmatch |NULLOK HV* seen_this \
+ |NULLOK HV* seen_other|const bool copied
#endif
#if defined(PERL_IN_PP_HOT_C)
diff --git a/embed.h b/embed.h
index 04b32d1..b2876f4 100644
--- a/embed.h
+++ b/embed.h
@@ -1382,7 +1382,7 @@
# if defined(PERL_IN_PP_CTL_C)
#define check_type_and_open(a) S_check_type_and_open(aTHX_ a)
#define destroy_matcher(a) S_destroy_matcher(aTHX_ a)
-#define do_smartmatch(a,b) S_do_smartmatch(aTHX_ a,b)
+#define do_smartmatch(a,b,c) S_do_smartmatch(aTHX_ a,b,c)
#define docatch(a) S_docatch(aTHX_ a)
#define doeval(a,b,c,d) S_doeval(aTHX_ a,b,c,d)
#define dofindlabel(a,b,c,d) S_dofindlabel(aTHX_ a,b,c,d)
diff --git a/pp_ctl.c b/pp_ctl.c
index 60bc30d..7c4651c 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4339,14 +4339,14 @@ S_destroy_matcher(pTHX_ PMOP *matcher)
PP(pp_smartmatch)
{
DEBUG_M(Perl_deb(aTHX_ "Starting smart match resolution\n"));
- return do_smartmatch(NULL, NULL);
+ return do_smartmatch(NULL, NULL, 0);
}
/* This version of do_smartmatch() implements the
* table of smart matches that is found in perlsyn.
*/
STATIC OP *
-S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
+S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
{
dVAR;
dSP;
@@ -4358,7 +4358,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
/* Take care only to invoke mg_get() once for each argument.
* Currently we do this by copying the SV if it's magical. */
if (d) {
- if (SvGMAGICAL(d))
+ if (!copied && SvGMAGICAL(d))
d = sv_mortalcopy(d);
}
else
@@ -4669,7 +4669,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
PUTBACK;
DEBUG_M(Perl_deb(aTHX_ " recursively comparing array element...\n"));
- (void) do_smartmatch(seen_this, seen_other);
+ (void) do_smartmatch(seen_this, seen_other, 0);
SPAGAIN;
DEBUG_M(Perl_deb(aTHX_ " recursion finished\n"));
@@ -4731,7 +4731,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
PUTBACK;
/* infinite recursion isn't supposed to happen here */
DEBUG_M(Perl_deb(aTHX_ " recursively testing array element...\n"));
- (void) do_smartmatch(NULL, NULL);
+ (void) do_smartmatch(NULL, NULL, 1);
SPAGAIN;
DEBUG_M(Perl_deb(aTHX_ " recursion finished\n"));
if (SvTRUEx(POPs))
diff --git a/proto.h b/proto.h
index 0b46a79..666e0d6 100644
--- a/proto.h
+++ b/proto.h
@@ -5696,7 +5696,7 @@ STATIC void S_destroy_matcher(pTHX_ PMOP* matcher)
#define PERL_ARGS_ASSERT_DESTROY_MATCHER \
assert(matcher)
-STATIC OP* S_do_smartmatch(pTHX_ HV* seen_this, HV* seen_other);
+STATIC OP* S_do_smartmatch(pTHX_ HV* seen_this, HV* seen_other, const bool copied);
STATIC OP* S_docatch(pTHX_ OP *o)
__attribute__warn_unused_result__;
diff --git a/t/op/taint.t b/t/op/taint.t
index 3a2b5d9..3929f58 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ BEGIN {
use strict;
use Config;
-plan tests => 779;
+plan tests => 781;
$| = 1;
@@ -2156,6 +2156,11 @@ end
ok(!tainted "", "tainting still works after index() of the constant");
}
+# Tainted values with smartmatch
+# [perl #93590] S_do_smartmatch stealing its own string buffers
+ok "M$TAINT" ~~ ['m', 'M'], '$tainted ~~ ["whatever", "match"]';
+ok !("M$TAINT" ~~ ['m', undef]), '$tainted ~~ ["whatever", undef]';
+
{ # 111654
eval {
eval { die "Test\n".substr($ENV{PATH}, 0, 0); };
--- End Message ---