Bug#691185: pre-approval: perl/5.14.2-15

Niko Tyni ntyni at debian.org
Mon Oct 22 18:45:21 UTC 2012


Package: release.debian.org
Severity: normal
User: release.debian.org at packages.debian.org
Usertags: unblock
X-Debbugs-Cc: perl at 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 at debian.org
-------------- next part --------------
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 at 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 at 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 at 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 at 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 at 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 at 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 at 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 at 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 at 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 at 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 at 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
-------------- next part --------------
A non-text attachment was scrubbed...
Name: cpan-missing-site-dirs.diff
Type: text/x-diff
Size: 2281 bytes
Desc: not available
URL: <http://lists.alioth.debian.org/pipermail/perl-maintainers/attachments/20121022/d4bd6f35/attachment-0009.diff>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: kfreebsd-overrides.diff
Type: text/x-diff
Size: 1750 bytes
Desc: not available
URL: <http://lists.alioth.debian.org/pipermail/perl-maintainers/attachments/20121022/d4bd6f35/attachment-0010.diff>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: perlcheat-update.diff
Type: text/x-diff
Size: 7661 bytes
Desc: not available
URL: <http://lists.alioth.debian.org/pipermail/perl-maintainers/attachments/20121022/d4bd6f35/attachment-0011.diff>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: reading-glob-copy-handle.diff
Type: text/x-diff
Size: 2459 bytes
Desc: not available
URL: <http://lists.alioth.debian.org/pipermail/perl-maintainers/attachments/20121022/d4bd6f35/attachment-0012.diff>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: regexp-matching-fold.diff
Type: text/x-diff
Size: 1895 bytes
Desc: not available
URL: <http://lists.alioth.debian.org/pipermail/perl-maintainers/attachments/20121022/d4bd6f35/attachment-0013.diff>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: regexp-matching-opposite-case.diff
Type: text/x-diff
Size: 7314 bytes
Desc: not available
URL: <http://lists.alioth.debian.org/pipermail/perl-maintainers/attachments/20121022/d4bd6f35/attachment-0014.diff>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: regexp-matching-starter.diff
Type: text/x-diff
Size: 1804 bytes
Desc: not available
URL: <http://lists.alioth.debian.org/pipermail/perl-maintainers/attachments/20121022/d4bd6f35/attachment-0015.diff>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: smartmatch-rhs-precedence.diff
Type: text/x-diff
Size: 1647 bytes
Desc: not available
URL: <http://lists.alioth.debian.org/pipermail/perl-maintainers/attachments/20121022/d4bd6f35/attachment-0016.diff>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: tainted-smartmatch.diff
Type: text/x-diff
Size: 6724 bytes
Desc: not available
URL: <http://lists.alioth.debian.org/pipermail/perl-maintainers/attachments/20121022/d4bd6f35/attachment-0017.diff>


More information about the Perl-maintainers mailing list