In perl.git, the branch maint-5.26 has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/7c81d8053a9c291f3c0200baa8a05bbae14ad6fb?hp=d05b59d55be3b732cdd217d2384f24339112df3b>

- Log -----------------------------------------------------------------
commit 7c81d8053a9c291f3c0200baa8a05bbae14ad6fb
Author: Aaron Crane <a...@cpan.org>
Date:   Sun Jan 21 20:28:52 2018 +0000

    perlpolicy: update policy in accordance with recent moderator discussions
    
    Substantive changes:
    
    Firstly, as promised earlier, we have clarified that, by forwarding a
    message to the list, the sender takes responsibility for the content of the
    message in question.
    
    Secondly, we have changed the policy regarding ban lengths. Previously,
    third or subsequent instances of unacceptable behaviour resulted in a ban
    twice the length of the person's previous ban. Under the new policy, a third
    instance of unacceptable behaviour results in a further warning, and a
    fourth instance results in a ban of indefinite length.
    
    Our rationale is that temporary bans are for the offender: to give them the
    opportunity to change their behaviour in a way that aligns with our
    community expectations. However, if the person in question fails to take
    advantage of that opportunity, our focus must shift to the community: we aim
    to protect other list members from having to bear the burden of unacceptable
    behaviour.
    
    Finally, we welcome Karen Etheridge and Todd Rinaldo as additional
    moderators. I'd like to offer both Karen and Todd my personal thanks for
    agreeing to serve.
    
    (cherry picked from commit ef7498d2b69936a5c6476ecf1950066f638b2dac)

commit 15f5c3eecd5da721bdf15140559a57019a110794
Author: Karl Williamson <k...@cpan.org>
Date:   Mon Mar 12 08:32:33 2018 +0000

    PATCH: [perl #132463] perluniprops for \p{Word}
    
    perluniprops was not updated to reflect the changes made to what
    \p{Word} contains as of 5.18.  What was added was the code points that
    have the Join_Control property, which, so far, only contain U+200C and
    U+200D.  This commit uses Join Control instead of the hard-coded code
    point numbers, so that when Unicode changes it, it automatically will
    still be valid.
    
    Thanks for spotting this.
    
    (cherry picked from commit 9b79e9e3431d11e79a4f85268f70130b7b4369f6)

commit 13800a14eb740499290fd72091ef0be221d483e8
Author: Lukas Mai <l....@web.de>
Date:   Mon Oct 16 22:39:45 2017 +0200

    PERL5LIB documentation: '.' is no longer in @INC by default
    
    (cherry picked from commit 490a0bffed65156cc6a814fa753c05a0621e084f)

commit 67c86af199a94a334fff01416597edf16c103f16
Author: Jarkko Hietaniemi <j...@iki.fi>
Date:   Mon Oct 30 07:19:18 2017 +0200

    The AIX doubledouble longdouble has been left broken for three years.
    
    I must have left the test in the wrong position while
    working on getting it to work, and never tested it since.
    My apologies.
    
    With this simple trick the following failing tests start to work.
    
            ../cpan/Math-Complex/t/Complex.t
            ../cpan/Math-Complex/t/Trig.t
            ../cpan/Math-Complex/t/underbar.t
            ../cpan/Scalar-List-Utils/t/uniq.t
            ../ext/POSIX/t/math.t
            ../lib/warnings.t
            op/sprintf2.t
            op/time.t
    
    Or rather, the broken part of the functionality, Infinity,
    starts being avoided, as it should be.  See the comment above
    about the known brokenness of long doubles and infinity in AIX.
    
    Note that even after this fix the following are still broken in
    this AIX (the perl5 aix machine), but these are unrelated to infnan:
    
            ../cpan/ExtUtils-MakeMaker/t/03-xsstatic.t
            ../dist/Storable/t/store.t
            ../ext/XS-APItest/t/handy00.t
            re/uniprops01.t
            re/uniprops02.t
            re/uniprops03.t
            re/uniprops04.t
            re/uniprops05.t
            re/uniprops06.t
            re/uniprops07.t
            re/uniprops08.t
            re/uniprops09.t
            re/uniprops10.t
    
    (as of blead 4faa3060)
    
    (cherry picked from commit 4ea0a103754f8e4f9459019cb6f8750bde08cd2d)

commit 0b90769be86e4460b579dbc4fd7ddaa8184c349e
Author: Tony Cook <t...@develop-help.com>
Date:   Tue Sep 19 17:40:52 2017 +1000

    (perl #132008) make sure the test behaves without a tty
    
    The test is intended to test how Term::ReadLine behaves without a tty
    and mocks up an invalid tty.
    
    Unfortunately some of the checks it does fail if the test starts without
    a tty.
    
    Modified the test to handle the lack of a tty.
    
    (cherry picked from commit 1d217c696857b2bf41d87a7e927c43d20cc556e5)

commit 6ee32476ad472ce39fd6eb1151298016f6563b85
Author: James E Keenan <jkee...@cpan.org>
Date:   Thu Aug 31 22:57:06 2017 -0400

    Term::ReadLine generates empty &STDERR files
    
    Revert to 2-arg open in one case.
    
    If /dev/tty is inaccessible, redirecting file handles to STDERR:
    
           open (my $fh, ">&STDERR))
    
    ... cannot be done as a 3 arg open or it'll actually try to write to that
    file.
    
    Bump $Term::ReadLine::VERSION.
    Add unit test for RT #132008
    
    For: RT #132008
    (cherry picked from commit e4dc68d725b19f46c6fca9423e6e7a0eaeff47f4)
    Signed-off-by: Nicolas R <atoo...@cpan.org>
    
    xx
    
    (cherry picked from commit d8b61909479178ddb668ad385988877d26f202f2)

commit 6a4c4e874df5fa02375a8deb534b7d806350cad7
Author: Zefram <zef...@fysh.org>
Date:   Mon Mar 12 08:27:48 2018 +0000

    fix GvSV refcounting in sort
    
    Where a sort operation passes the comparands to a comparison block in $a
    and $b, it wasn't taking account of the fact that the GvSV slots in *a
    and *b are refcounted.  It would write the comparands into those slots
    without altering any reference counts, and end by restoring the values
    those slots had to start with.  This was all fine so long as nothing
    else touched those slots during the process.  But code running during
    the comparison is free to write to them by "*a = \1", which does frob
    the reference counts.
    
    Fix it by switching sort to manipulate GvSV in a refcount-preserving
    manner, compatible with all other operations on those slots.  Fixes
    [perl #92264].
    
    (cherry picked from commit 16ada235c332e017667585e1a5a00ce43a31c529)

commit 35495e08e8391f177db14fb548d6a88a00a27e1c
Author: Tony Cook <t...@develop-help.com>
Date:   Thu Aug 31 10:05:54 2017 +1000

    (perl #128263) handle PL_last_in_gv being &PL_sv_undef
    
    rv2gv will return &PL_sv_undef when it can't get a GV, previously
    this could cause an assertion failure in mg.c
    
    My original fix for this changed each op that deals with GVs for I/O
    to set PL_last_in_gv to NULL if there was no io object in the GV, but
    this changes other behaviour as noted by FatherC.
    
    Also partly reverts 84ee769f, which unnecessarily did the same for
    readline(), so now we're consistent.
    
    (cherry picked from commit 745e740c825d415f535852b90516127e64c24905)

commit 5a695dfd66cb8bb3f800c48cda176c8d95d2f233
Author: Tony Cook <t...@develop-help.com>
Date:   Thu Aug 24 14:38:41 2017 +1000

    (perl #131949) adjust s in case peekspace() moves the line string
    
    (cherry picked from commit 1141a2c757171575dd43caa4b731ca4f491c2bcf)

commit 0d2957d192624d1d89d1d42c9ecef466fa811743
Author: Tony Cook <t...@develop-help.com>
Date:   Mon Aug 7 11:27:50 2017 +1000

    (perl #131836) avoid a use-after-free after parsing a "sub" keyword
    
    The:
    
      d = skipspace(d);
    
    can reallocate linestr in the test case, invalidating s.  This would
    end up in PL_bufptr from the embedded (PL_bufptr = s) in the TOKEN()
    macro.
    
    Assigning s to PL_bufptr and restoring s from PL_bufptr allows
    lex_next_chunk() to adjust the pointer to the reallocated buffer.
    
    (cherry picked from commit 3b8804a4c2320ae4e7e713c5836d340eb210b6cd)

commit e3344ddbfd9ba6a7f8433fbc3f86d141c84d22ec
Author: Karl Williamson <k...@cpan.org>
Date:   Wed Dec 27 18:55:13 2017 -0700

    Fix t/comp/parser_run.t for EBCDIC
    
    Commit 36000cd1c47863d8412b285701db7232dd450239 added a test which isn't
    portable to EBCDIC, using \xD5.  The is "N" on EBCDIC platforms, whereas
    a non-alphabetic character was intended.
    
    Change to use \xB6 which means paragraph sign on both character sets.
    
    (cherry picked from commit faa9b9ce7303b784a3dbd278ddaa49f8789c1672)

commit f252c27cfa1fd8b07c3781a8cae30b22f169e9d6
Author: Tony Cook <t...@develop-help.com>
Date:   Wed Jul 26 12:04:18 2017 +1000

    (perl #131793) sanely handle PL_linestart > PL_bufptr
    
    In the test case, scan_ident() ends up fetching another line
    (updating PL_linestart), and since in this case we don't
    successfully parse ${identifier} s (and PL_bufptr) end up being
    before PL_linestart.
    
    (cherry picked from commit 36000cd1c47863d8412b285701db7232dd450239)

commit 7b50dc277468ba12349fb8cb3071dc62e50c485d
Author: Tony Cook <t...@develop-help.com>
Date:   Thu Jun 8 11:06:39 2017 +1000

    [perl #131221] sv_dup/sv_dup_inc are only available under threads
    
    (cherry picked from commit 7b3443d31f11c15859593e5b710c301795a6de01)

commit e654100334d4a4bf01ab419f41c4824f1f2fec98
Author: Tony Cook <t...@develop-help.com>
Date:   Thu Jun 1 15:11:27 2017 +1000

    [perl #131221] improve duplication of :via handles
    
    Previously duplication (as with open ... ">&...") would fail
    unless the user supplied a GETARG, which wasn't documented, and
    resulted in an attempt to free and unreferened scalar if supplied.
    
    Cloning on thread creation was simply broken.
    
    We now handle GETARG correctly, and provide a useful default if it
    returns nothing.
    
    Cloning on thread creation now duplicates the appropriate parts of the
    parent thread's handle.
    
    (cherry picked from commit 99b847695211f825df6299aa9da91f9494f741e2)

-----------------------------------------------------------------------

Summary of changes:
 MANIFEST                                |  2 +
 charclass_invlists.h                    |  2 +-
 dist/Term-ReadLine/lib/Term/ReadLine.pm | 17 +++++---
 dist/Term-ReadLine/t/ReadLine-STDERR.t  | 49 ++++++++++++++++++++++
 ext/PerlIO-via/t/thread.t               | 73 +++++++++++++++++++++++++++++++++
 ext/PerlIO-via/t/via.t                  | 56 ++++++++++++++++++++++++-
 ext/PerlIO-via/via.pm                   |  2 +-
 ext/PerlIO-via/via.xs                   | 59 +++++++++++++++++++++++---
 hints/aix.sh                            |  2 +-
 lib/unicore/mktables                    |  3 +-
 mg.c                                    |  2 +-
 pod/perlpolicy.pod                      | 46 ++++++++++++++-------
 pod/perlrun.pod                         |  8 ++--
 pp_hot.c                                |  5 +--
 pp_sort.c                               | 15 +++++--
 regcharclass.h                          |  2 +-
 t/comp/parser_run.t                     | 27 +++++++++++-
 t/op/magic.t                            | 12 +++++-
 t/op/sort.t                             | 25 ++++++++++-
 toke.c                                  | 26 +++++++++---
 20 files changed, 380 insertions(+), 53 deletions(-)
 create mode 100644 dist/Term-ReadLine/t/ReadLine-STDERR.t
 create mode 100644 ext/PerlIO-via/t/thread.t

diff --git a/MANIFEST b/MANIFEST
index 161c5a3e4b..76004137e5 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3646,6 +3646,7 @@ dist/Term-ReadLine/lib/Term/ReadLine.pm           Stub 
readline library
 dist/Term-ReadLine/t/AE.t                      See if Term::ReadLine works
 dist/Term-ReadLine/t/AETk.t                    See if Term::ReadLine works
 dist/Term-ReadLine/t/ReadLine.t                        See if Term::ReadLine 
works
+dist/Term-ReadLine/t/ReadLine-STDERR.t         See if Term::ReadLine works
 dist/Term-ReadLine/t/Tk.t                      See if Term::ReadLine works
 dist/Test/lib/Test.pm          A simple framework for writing test scripts
 dist/Test/t/05_about_verbose.t See if Test works
@@ -4048,6 +4049,7 @@ ext/PerlIO-scalar/scalar.xs       PerlIO layer for scalars
 ext/PerlIO-scalar/t/scalar.t   See if PerlIO::scalar works
 ext/PerlIO-scalar/t/scalar_ungetc.t    Tests for PerlIO layer for scalars
 ext/PerlIO-via/hints/aix.pl    Hint for PerlIO::via for named architecture
+ext/PerlIO-via/t/thread.t              See if PerlIO::via works with threads
 ext/PerlIO-via/t/via.t         See if PerlIO::via works
 ext/PerlIO-via/via.pm          PerlIO layer for layers in perl
 ext/PerlIO-via/via.xs          PerlIO layer for layers in perl
diff --git a/charclass_invlists.h b/charclass_invlists.h
index 6d476d35c8..222c90e29f 100644
--- a/charclass_invlists.h
+++ b/charclass_invlists.h
@@ -95407,7 +95407,7 @@ static const U8 WB_table[24][24] = {
  * 37f6186253da9824bdb27f4ad867bfe8c25d4dc6bdb2f05585e40a034675a348 
lib/unicore/extracted/DLineBreak.txt
  * ef24061b5a5dc93d7e90c2e34530ec757180ee75d872cba65ffc946e52624ae8 
lib/unicore/extracted/DNumType.txt
  * a197371fec9a1b517058b440841f60f9378d81682084eef8db22a88cb2f96e90 
lib/unicore/extracted/DNumValues.txt
- * 79a7216aceb1d291f2857085545fdda289518bc540a09bc0a15cde105d76028d 
lib/unicore/mktables
+ * 4e326cd667e6212b35f1786d22970d19f1e85ec6622156cfd86febd5bb18fe50 
lib/unicore/mktables
  * cdecb300baad839a6f62791229f551a4fa33f3cbdca08e378dc976466354e778 
lib/unicore/version
  * 913d2f93f3cb6cdf1664db888bf840bc4eb074eef824e082fceda24a9445e60c 
regen/charset_translations.pl
  * 9534d0cc3914fa1f5d574332c3199605c3d14f8691a0729d68d8498ac2b36280 
regen/mk_invlists.pl
diff --git a/dist/Term-ReadLine/lib/Term/ReadLine.pm 
b/dist/Term-ReadLine/lib/Term/ReadLine.pm
index 88d5a75877..e00fb376cd 100644
--- a/dist/Term-ReadLine/lib/Term/ReadLine.pm
+++ b/dist/Term-ReadLine/lib/Term/ReadLine.pm
@@ -229,12 +229,17 @@ sub readline {
 }
 sub addhistory {}
 
+# used for testing purpose
+sub devtty { return '/dev/tty' }
+
 sub findConsole {
     my $console;
     my $consoleOUT;
 
-    if ($^O ne 'MSWin32' and -e "/dev/tty") {
-       $console = "/dev/tty";
+    my $devtty = devtty();
+
+    if ($^O ne 'MSWin32' and -e $devtty) {
+       $console = $devtty;
     } elsif ($^O eq 'MSWin32' or $^O eq 'msys' or -e "con") {
        $console = 'CONIN$';
        $consoleOUT = 'CONOUT$';
@@ -248,7 +253,7 @@ sub findConsole {
 
     $consoleOUT = $console unless defined $consoleOUT;
     $console = "&STDIN" unless defined $console;
-    if ($console eq "/dev/tty" && !open(my $fh, "<", $console)) {
+    if ($console eq $devtty && !open(my $fh, "<", $console)) {
       $console = "&STDIN";
       undef($consoleOUT);
     }
@@ -266,11 +271,11 @@ sub new {
   if (@_==2) {
     my($console, $consoleOUT) = $_[0]->findConsole;
 
-
     # the Windows CONIN$ needs GENERIC_WRITE mode to allow
     # a SetConsoleMode() if we end up using Term::ReadKey
     open FIN, (( $^O eq 'MSWin32' && $console eq 'CONIN$' ) ? '+<' : '<' ), 
$console;
-    open FOUT,'>', $consoleOUT;
+    # RT #132008:  Still need 2-arg open here
+    open FOUT,">$consoleOUT";
 
     #OUT->autoflush(1);                # Conflicts with debugger?
     my $sel = select(FOUT);
@@ -319,7 +324,7 @@ sub Features { \%features }
 
 package Term::ReadLine;                # So late to allow the above code be 
defined?
 
-our $VERSION = '1.16';
+our $VERSION = '1.17';
 
 my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
 if ($which) {
diff --git a/dist/Term-ReadLine/t/ReadLine-STDERR.t 
b/dist/Term-ReadLine/t/ReadLine-STDERR.t
new file mode 100644
index 0000000000..2bdf799f42
--- /dev/null
+++ b/dist/Term-ReadLine/t/ReadLine-STDERR.t
@@ -0,0 +1,49 @@
+#!./perl -w
+use strict;
+
+use Test::More;
+
+## unit test for RT 132008 - https://rt.perl.org/Ticket/Display.html?id=132008
+
+if ( $^O eq 'MSWin32' || !-e q{/dev/tty} ) {
+    plan skip_all => "Not tested on windows or when /dev/tty does not exist";
+}
+else {
+    plan tests => 9;
+}
+
+if ( -e q[&STDERR] ) {
+    note q[Removing existing file &STDERR];
+    unlink q[&STDERR] or die q{Cannot remove existing file &STDERR [probably 
created from a previous run]};
+}
+
+use_ok('Term::ReadLine');
+can_ok( 'Term::ReadLine::Stub', qw{new devtty findConsole} );
+is( Term::ReadLine->devtty(), q{/dev/tty}, "check sub devtty" );
+SKIP:
+{
+    open my $tty, "<",  Term::ReadLine->devtty()
+      or skip "Cannot open tty", 1;
+    -t $tty
+      or skip "No tty found, so findConsole() won't return /dev/tty", 1;
+    my @out = Term::ReadLine::Stub::findConsole();
+    is_deeply \@out, [ q{/dev/tty}, q{/dev/tty} ], "findConsole is using 
/dev/tty";
+}
+
+{
+    no warnings 'redefine';
+    my $donotexist = q[/this/should/not/exist/hopefully];
+
+    ok !-e $donotexist, "File $donotexist does not exist";
+    # double mention to prevent warning
+    local *Term::ReadLine::Stub::devtty =
+      *Term::ReadLine::Stub::devtty = sub { $donotexist };
+    is( Term::ReadLine->devtty(), $donotexist, "devtty mocked" );
+
+    my @out = Term::ReadLine::Stub::findConsole();
+    is_deeply \@out, [ q{&STDIN}, q{&STDERR} ], "findConsole isn't using 
/dev/tty" or diag explain \@out;
+
+    ok !-e q[&STDERR], 'file &STDERR do not exist before Term::ReadLine call';
+    my $tr = Term::ReadLine->new('whatever');
+    ok !-e q[&STDERR], 'file &STDERR was not created by mistake';
+}
diff --git a/ext/PerlIO-via/t/thread.t b/ext/PerlIO-via/t/thread.t
new file mode 100644
index 0000000000..e4358f9c24
--- /dev/null
+++ b/ext/PerlIO-via/t/thread.t
@@ -0,0 +1,73 @@
+#!perl
+BEGIN {
+    unless (find PerlIO::Layer 'perlio') {
+       print "1..0 # Skip: not perlio\n";
+       exit 0;
+    }
+    require Config;
+    unless ($Config::Config{'usethreads'}) {
+        print "1..0 # Skip -- need threads for this test\n";
+        exit 0;
+    }
+    if (($Config::Config{'extensions'} !~ m!\bPerlIO/via\b!) ){
+        print "1..0 # Skip -- Perl configured without PerlIO::via module\n";
+        exit 0;
+    }
+}
+
+use strict;
+use warnings;
+use threads;
+
+my $tmp = "via$$";
+
+END {
+    1 while unlink $tmp;
+}
+
+use Test::More tests => 2;
+
+our $push_count = 0;
+
+{
+    open my $fh, ">:via(Test1)", $tmp
+      or die "Cannot open $tmp: $!";
+    $fh->autoflush;
+
+    print $fh "AXAX";
+
+    # previously this would crash
+    threads->create(
+        sub {
+            print $fh "XZXZ";
+        })->join;
+
+    print $fh "BXBX";
+    close $fh;
+
+    open my $in, "<", $tmp;
+    my $line = <$in>;
+    close $in;
+
+    is($line, "AYAYYZYZBYBY", "check thread data delivered");
+
+    is($push_count, 1, "PUSHED not called for dup on thread creation");
+}
+
+package PerlIO::via::Test1;
+
+sub PUSHED {
+    my ($class) = @_;
+    ++$main::push_count;
+    bless {}, $class;
+}
+
+sub WRITE {
+    my ($self, $data, $fh) = @_;
+    $data =~ tr/X/Y/;
+    $fh->autoflush;
+    print $fh $data;
+    return length $data;
+}
+
+
diff --git a/ext/PerlIO-via/t/via.t b/ext/PerlIO-via/t/via.t
index 6787e11cc4..80577df140 100644
--- a/ext/PerlIO-via/t/via.t
+++ b/ext/PerlIO-via/t/via.t
@@ -17,7 +17,7 @@ use warnings;
 
 my $tmp = "via$$";
 
-use Test::More tests => 18;
+use Test::More tests => 26;
 
 my $fh;
 my $a = join("", map { chr } 0..255) x 10;
@@ -84,6 +84,60 @@ is( $obj, 'Foo', 'search for package Foo' );
 open $fh, '<:via(Bar)', "bar";
 is( $obj, 'PerlIO::via::Bar', 'search for package PerlIO::via::Bar' );
 
+{
+    # [perl #131221]
+    ok(open(my $fh1, ">", $tmp), "open $tmp");
+    ok(binmode($fh1, ":via(XXX)"), "binmode :via(XXX) onto it");
+    ok(open(my $fh2, ">&", $fh1), "dup it");
+    close $fh1;
+    close $fh2;
+
+    # make sure the old workaround still works
+    ok(open($fh1, ">", $tmp), "open $tmp");
+    ok(binmode($fh1, ":via(YYY)"), "binmode :via(YYY) onto it");
+    ok(open($fh2, ">&", $fh1), "dup it");
+    print $fh2 "XZXZ";
+    close $fh1;
+    close $fh2;
+
+    ok(open($fh1, "<", $tmp), "open $tmp for check");
+    { local $/; $b = <$fh1> }
+    close $fh1;
+    is($b, "XZXZ", "check result is from non-filtering class");
+
+    package PerlIO::via::XXX;
+
+    sub PUSHED {
+        my $class = shift;
+        bless {}, $class;
+    }
+
+    sub WRITE {
+        my ($self, $buffer, $handle) = @_;
+
+        print $handle $buffer;
+        return length($buffer);
+    }
+    package PerlIO::via::YYY;
+
+    sub PUSHED {
+        my $class = shift;
+        bless {}, $class;
+    }
+
+    sub WRITE {
+        my ($self, $buffer, $handle) = @_;
+
+        $buffer =~ tr/X/Y/;
+        print $handle $buffer;
+        return length($buffer);
+    }
+
+    sub GETARG {
+        "XXX";
+    }
+}
+
 END {
     1 while unlink $tmp;
 }
diff --git a/ext/PerlIO-via/via.pm b/ext/PerlIO-via/via.pm
index e477dcca19..30083feae8 100644
--- a/ext/PerlIO-via/via.pm
+++ b/ext/PerlIO-via/via.pm
@@ -1,5 +1,5 @@
 package PerlIO::via;
-our $VERSION = '0.16';
+our $VERSION = '0.17';
 require XSLoader;
 XSLoader::load();
 1;
diff --git a/ext/PerlIO-via/via.xs b/ext/PerlIO-via/via.xs
index 8a7f1fc9ed..d91c6855fc 100644
--- a/ext/PerlIO-via/via.xs
+++ b/ext/PerlIO-via/via.xs
@@ -38,6 +38,8 @@ typedef struct
  CV *UTF8;
 } PerlIOVia;
 
+static const MGVTBL PerlIOVia_tag = { 0, 0, 0, 0, 0, 0, 0, 0 };
+
 #define MYMethod(x) #x,&s->x
 
 static CV *
@@ -131,8 +133,14 @@ PerlIOVia_pushed(pTHX_ PerlIO * f, const char *mode, SV * 
arg,
                 PerlIO_funcs * tab)
 {
     IV code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
+
+    if (SvTYPE(arg) >= SVt_PVMG
+               && mg_findext(arg, PERL_MAGIC_ext, &PerlIOVia_tag)) {
+       return code;
+    }
+
     if (code == 0) {
-       PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
        if (!arg) {
            if (ckWARN(WARN_LAYER))
                Perl_warner(aTHX_ packWARN(WARN_LAYER),
@@ -583,9 +591,28 @@ static SV *
 PerlIOVia_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
 {
     PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
-    PERL_UNUSED_ARG(param);
+    SV *arg;
     PERL_UNUSED_ARG(flags);
-    return PerlIOVia_method(aTHX_ f, MYMethod(GETARG), G_SCALAR, Nullsv);
+
+    /* During cloning, return an undef token object so that _pushed() knows
+     * that it should not call methods and wait for _dup() to actually dup the
+     * object. */
+    if (param) {
+       SV *sv = newSV(0);
+       sv_magicext(sv, NULL, PERL_MAGIC_ext, &PerlIOVia_tag, 0, 0);
+       return sv;
+    }
+
+    arg = PerlIOVia_method(aTHX_ f, MYMethod(GETARG), G_SCALAR, Nullsv);
+    if (arg) {
+        /* arg is a temp, and PerlIOBase_dup() will explicitly free it */
+        SvREFCNT_inc(arg);
+    }
+    else {
+        arg = newSVpvn(HvNAME(s->stash), HvNAMELEN(s->stash));
+    }
+
+    return arg;
 }
 
 static PerlIO *
@@ -593,10 +620,30 @@ PerlIOVia_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS 
* param,
              int flags)
 {
     if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
-       /* Most of the fields will lazily set themselves up as needed
-          stash and obj have been set up by the implied push
-        */
+#ifdef USE_ITHREADS
+        if (param) {
+            /* For a non-interpreter dup stash and obj have been set up
+               by the implied push.
+
+               But if this is a clone for a new interpreter we need to
+               translate the objects to their dups.
+            */
+
+            PerlIOVia *fs = PerlIOSelf(f, PerlIOVia);
+            PerlIOVia *os = PerlIOSelf(o, PerlIOVia);
+
+            fs->obj = sv_dup_inc(os->obj, param);
+            fs->stash = (HV*)sv_dup((SV*)os->stash, param);
+            fs->var = sv_dup_inc(os->var, param);
+            fs->cnt = os->cnt;
+
+            /* fh, io, cached CVs left as NULL, PerlIOVia_method()
+               will reinitialize them if needed */
+        }
+#endif
+        /* for a non-threaded dup fs->obj and stash should be set by _pushed() 
*/
     }
+
     return f;
 }
 
diff --git a/hints/aix.sh b/hints/aix.sh
index 3c606c60e9..fde59954d6 100644
--- a/hints/aix.sh
+++ b/hints/aix.sh
@@ -584,7 +584,7 @@ fi
 # The missing math functions affect the POSIX extension math interfaces.
 
 case "$uselongdouble" in
-'')
+$define)
   echo "Checking if your infinity is working with long doubles..." >&4
   cat > inf$$.c <<EOF
 #include <math.h>
diff --git a/lib/unicore/mktables b/lib/unicore/mktables
index e3336f50e0..761d3c6653 100644
--- a/lib/unicore/mktables
+++ b/lib/unicore/mktables
@@ -14485,7 +14485,8 @@ sub compile_perl() {
 
     my $Word = $perl->add_match_table('Word', Full_Name => 'XPosixWord',
                                 Description => '\w, including beyond ASCII;'
-                                            . ' = \p{Alnum} + \pM + \p{Pc}',
+                                            . ' = \p{Alnum} + \pM + \p{Pc}'
+                                            . ' + \p{Join_Control}',
                                 Initialize => $Alnum + $gc->table('Mark'),
                                 );
     my $Pc = $gc->table('Connector_Punctuation'); # 'Pc' Not in release 1
diff --git a/mg.c b/mg.c
index 969d183d6a..39e194b92d 100644
--- a/mg.c
+++ b/mg.c
@@ -951,7 +951,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        break;
     case '\014':               /* ^LAST_FH */
        if (strEQ(remaining, "AST_FH")) {
-           if (PL_last_in_gv) {
+           if (PL_last_in_gv && (SV*)PL_last_in_gv != &PL_sv_undef) {
                assert(isGV_with_GP(PL_last_in_gv));
                SV_CHECK_THINKFIRST_COW_DROP(sv);
                prepare_SV_for_RV(sv);
diff --git a/pod/perlpolicy.pod b/pod/perlpolicy.pod
index ff841fc0db..7ea1597abd 100644
--- a/pod/perlpolicy.pod
+++ b/pod/perlpolicy.pod
@@ -537,8 +537,9 @@ it doesn't need to fully describe how all old versions used 
to work.
 =head1 STANDARDS OF CONDUCT
 
 The official forum for the development of perl is the perl5-porters mailing
-list, mentioned above, and its bugtracker at rt.perl.org.  All participants in
-discussion there are expected to adhere to a standard of conduct.
+list, mentioned above, and its bugtracker at rt.perl.org.  Posting to the
+list and the bugtracker is not a right: all participants in discussion are
+expected to adhere to a standard of conduct.
 
 =over 4
 
@@ -546,15 +547,18 @@ discussion there are expected to adhere to a standard of 
conduct.
 
 Always be civil.
 
-=item * 
+=item *
 
 Heed the moderators.
 
 =back
 
-Civility is simple:  stick to the facts while avoiding demeaning remarks and
-sarcasm.  It is not enough to be factual.  You must also be civil.  Responding
-in kind to incivility is not acceptable.
+Civility is simple: stick to the facts while avoiding demeaning remarks,
+belittling other individuals, sarcasm, or a presumption of bad faith. It is
+not enough to be factual.  You must also be civil.  Responding in kind to
+incivility is not acceptable.  If you relay otherwise-unposted comments to
+the list from a third party, you take responsibility for the content of
+those comments, and you must therefore ensure that they are civil.
 
 While civility is required, kindness is encouraged; if you have any doubt about
 whether you are being civil, simply ask yourself, "Am I being kind?" and aspire
@@ -563,16 +567,30 @@ to that.
 If the list moderators tell you that you are not being civil, carefully
 consider how your words have appeared before responding in any way.  Were they
 kind?  You may protest, but repeated protest in the face of a repeatedly
-reaffirmed decision is not acceptable.
-
-Unacceptable behavior will result in a public and clearly identified warning.
-Repeated unacceptable behavior will result in removal from the mailing list and
-revocation of rights to update rt.perl.org.  The first removal is for one
-month.  Subsequent removals will double in length.  After six months with no
-warning, a user's ban length is reset.  Removals, like warnings, are public.
+reaffirmed decision is not acceptable.  Repeatedly protesting about the
+moderators' decisions regarding a third party is also unacceptable, as is
+continuing to initiate off-list contact with the moderators about their
+decisions.
+
+Unacceptable behavior will result in a public and clearly identified
+warning.  A second instance of unacceptable behavior from the same
+individual will result in removal from the mailing list and rt.perl.org,
+for a period of one calendar month.  The rationale for this is to
+provide an opportunity for the person to change the way they act.
+
+After the time-limited ban has been lifted, a third instance of
+unacceptable behavior will result in a further public warning.  A fourth
+or subsequent instance will result in an indefinite ban.  The rationale
+is that, in the face of an apparent refusal to change behavior, we must
+protect other community members from future unacceptable actions.  The
+moderators may choose to lift an indefinite ban if the person in
+question affirms they will not transgress again.
+
+Removals, like warnings, are public.
 
 The list of moderators will be public knowledge.  At present, it is:
-Aaron Crane, Andy Dougherty, Ricardo Signes, Sawyer X, Steffen Müller.
+Aaron Crane, Andy Dougherty, Karen Etheridge, Ricardo Signes, Sawyer X,
+Steffen Müller, Todd Rinaldo.
 
 =head1 CREDITS
 
diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index dff9f71cdd..e7c52c70dc 100644
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -995,9 +995,9 @@ used.
 =item PERL5LIB
 X<PERL5LIB>
 
-A list of directories in which to look for Perl library
-files before looking in the standard library and the current
-directory.  Any architecture-specific and version-specific directories,
+A list of directories in which to look for Perl library files before
+looking in the standard library.
+Any architecture-specific and version-specific directories,
 such as F<version/archname/>, F<version/>, or F<archname/> under the
 specified locations are automatically included if they exist, with this
 lookup done at interpreter startup time.  In addition, any directories
@@ -1178,7 +1178,7 @@ support.
 X<PERLLIB>
 
 A list of directories in which to look for Perl library
-files before looking in the standard library and the current directory.
+files before looking in the standard library.
 If PERL5LIB is defined, PERLLIB is not used.
 
 The PERLLIB environment variable is completely ignored when Perl
diff --git a/pp_hot.c b/pp_hot.c
index f445fd904b..2fa08f6222 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -448,10 +448,7 @@ PP(pp_readline)
            PUTBACK;
            Perl_pp_rv2gv(aTHX);
            PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--);
-           if (PL_last_in_gv == (GV *)&PL_sv_undef)
-               PL_last_in_gv = NULL;
-           else
-               assert(isGV_with_GP(PL_last_in_gv));
+            assert((SV*)PL_last_in_gv == &PL_sv_undef || 
isGV_with_GP(PL_last_in_gv));
        }
     }
     return do_readline();
diff --git a/pp_sort.c b/pp_sort.c
index a54768a022..c2ecf85072 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1655,8 +1655,10 @@ PP(pp_sort)
                 /* we don't want modifications localized */
                 GvINTRO_off(PL_firstgv);
                 GvINTRO_off(PL_secondgv);
-               SAVESPTR(GvSV(PL_firstgv));
-               SAVESPTR(GvSV(PL_secondgv));
+               SAVEGENERICSV(GvSV(PL_firstgv));
+               SvREFCNT_inc(GvSV(PL_firstgv));
+               SAVEGENERICSV(GvSV(PL_secondgv));
+               SvREFCNT_inc(GvSV(PL_secondgv));
            }
 
             gimme = G_SCALAR;
@@ -1789,11 +1791,16 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     I32 result;
     PMOP * const pm = PL_curpm;
     COP * const cop = PL_curcop;
+    SV *olda, *oldb;
  
     PERL_ARGS_ASSERT_SORTCV;
 
-    GvSV(PL_firstgv) = a;
-    GvSV(PL_secondgv) = b;
+    olda = GvSV(PL_firstgv);
+    GvSV(PL_firstgv) = SvREFCNT_inc_simple_NN(a);
+    SvREFCNT_dec(olda);
+    oldb = GvSV(PL_secondgv);
+    GvSV(PL_secondgv) = SvREFCNT_inc_simple_NN(b);
+    SvREFCNT_dec(oldb);
     PL_stack_sp = PL_stack_base;
     PL_op = PL_sortcop;
     CALLRUNOPS(aTHX);
diff --git a/regcharclass.h b/regcharclass.h
index cde4f1e039..2835e1b618 100644
--- a/regcharclass.h
+++ b/regcharclass.h
@@ -1897,7 +1897,7 @@
  * 37f6186253da9824bdb27f4ad867bfe8c25d4dc6bdb2f05585e40a034675a348 
lib/unicore/extracted/DLineBreak.txt
  * ef24061b5a5dc93d7e90c2e34530ec757180ee75d872cba65ffc946e52624ae8 
lib/unicore/extracted/DNumType.txt
  * a197371fec9a1b517058b440841f60f9378d81682084eef8db22a88cb2f96e90 
lib/unicore/extracted/DNumValues.txt
- * 79a7216aceb1d291f2857085545fdda289518bc540a09bc0a15cde105d76028d 
lib/unicore/mktables
+ * 4e326cd667e6212b35f1786d22970d19f1e85ec6622156cfd86febd5bb18fe50 
lib/unicore/mktables
  * cdecb300baad839a6f62791229f551a4fa33f3cbdca08e378dc976466354e778 
lib/unicore/version
  * 913d2f93f3cb6cdf1664db888bf840bc4eb074eef824e082fceda24a9445e60c 
regen/charset_translations.pl
  * c468aea5062ef84422219d74e83b6f3216f2823544b445f53ee1af71deeb2044 
regen/regcharclass.pl
diff --git a/t/comp/parser_run.t b/t/comp/parser_run.t
index e74644d3fb..0a19af77fd 100644
--- a/t/comp/parser_run.t
+++ b/t/comp/parser_run.t
@@ -10,7 +10,7 @@ BEGIN {
 }
 
 require './test.pl';
-plan(1);
+plan(4);
 
 # [perl #130814] can reallocate lineptr while looking ahead for
 # "Missing $ on loop variable" diagnostic.
@@ -24,5 +24,30 @@ syntax error at - line 3, near "foreach m0
 Identifier too long at - line 3.
 EXPECT
 
+fresh_perl_is(<<EOS, <<'EXPECT', {}, "linestart before bufptr");
+\${ \xB6eeeeeeeeeeee
+'x
+EOS
+Unrecognized character \xB6; marked by <-- HERE after ${ <-- HERE near column 
4 at - line 1.
+EXPECT
+
+fresh_perl_is(<<'EOS', <<'EXPECTED', {}, "use after free (#131836)");
+${sub#xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+EOS
+Missing right curly or square bracket at - line 1, at end of line
+syntax error at - line 1, at EOF
+Execution of - aborted due to compilation errors.
+EXPECTED
+
+SKIP:
+{
+    # [perl #131949] use after free
+    # detected by ASAN
+    # Win32 cmd.exe can't handle newlines well
+    skip("Need POSIXish", 1) if $^O eq "MSWin32";
+    my $out = runperl(prog => "\@{ 0\n\n}", stderr => 1, non_portable => 1);
+    is($out, "", "check for ASAN use after free");
+}
+
 __END__
 # ex: set ts=8 sts=4 sw=4 et:
diff --git a/t/op/magic.t b/t/op/magic.t
index 3f71f8ec64..36abafb098 100644
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
     set_up_inc( '../lib' );
-    plan (tests => 192); # some tests are run in BEGIN block
+    plan (tests => 196); # some tests are run in BEGIN block
 }
 
 # Test that defined() returns true for magic variables created on the fly,
@@ -643,6 +643,16 @@ is ${^LAST_FH}, \*STDIN, '${^LAST_FH} after another tell';
 # This also tests that ${^LAST_FH} is a weak reference:
 is ${^LAST_FH}, undef, '${^LAST_FH} is undef when PL_last_in_gv is NULL';
 
+# all of these would set PL_last_in_gv to a non-GV which would
+# assert when referenced by the magic for ${^LAST_FH}.
+# Instead it should act like <$0> which NULLs PL_last_in_gv and the magic
+# returns that as undef.
+# The approach to fixing this has changed (#128263), but it's still useful
+# to check each op.
+for my $code ('tell $0', 'sysseek $0, 0, 0', 'seek $0, 0, 0', 'eof $0') {
+    fresh_perl_is("$code; print defined \${^LAST_FH} ? qq(not ok\n) : 
qq(ok\n)", "ok\n",
+                  undef, "check $code doesn't define \${^LAST_FH}");
+}
 
 # $|
 fresh_perl_is 'print $| = ~$|', "1\n", {switches => ['-l']},
diff --git a/t/op/sort.t b/t/op/sort.t
index 96fad1c549..d201f00afd 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -7,7 +7,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 use warnings;
-plan(tests => 197);
+plan(tests => 199);
 
 # these shouldn't hang
 {
@@ -1160,3 +1160,26 @@ SKIP:
     my @out = sort { $a <=> $b } @in;
     is($out[1], "20000000000000000", "check sort order");
 }
+
+# [perl #92264] refcounting of GvSV slot of *a and *b
+{
+    my $act;
+    package ReportDestruction {
+       sub new { bless({ p => $_[1] }, $_[0]) }
+       sub DESTROY { $act .= $_[0]->{p}; }
+    }
+    $act = "";
+    my $filla = \(ReportDestruction->new("[filla]"));
+    () = sort { my $r = $a cmp $b; $act .= "0"; *a = \$$filla; $act .= "1"; $r 
}
+           ReportDestruction->new("[sorta]"), "foo";
+    $act .= "2";
+    $filla = undef;
+    is $act, "01[sorta]2[filla]";
+    $act = "";
+    my $fillb = \(ReportDestruction->new("[fillb]"));
+    () = sort { my $r = $a cmp $b; $act .= "0"; *b = \$$fillb; $act .= "1"; $r 
}
+           "foo", ReportDestruction->new("[sortb]");
+    $act .= "2";
+    $fillb = undef;
+    is $act, "01[sortb]2[fillb]";
+}
diff --git a/toke.c b/toke.c
index ee18153e34..e8a599ab42 100644
--- a/toke.c
+++ b/toke.c
@@ -5164,12 +5164,23 @@ Perl_yylex(pTHX)
         else {
             c = Perl_form(aTHX_ "\\x%02X", (unsigned char)*s);
         }
-        len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : 
(STRLEN) (s - PL_linestart);
-        if (len > UNRECOGNIZED_PRECEDE_COUNT) {
-            d = UTF ? (char *) utf8_hop_back((U8 *) s, 
-UNRECOGNIZED_PRECEDE_COUNT, (U8 *)PL_linestart) : s - 
UNRECOGNIZED_PRECEDE_COUNT;
-        } else {
+
+        if (s >= PL_linestart) {
             d = PL_linestart;
         }
+        else {
+            /* somehow (probably due to a parse failure), PL_linestart has 
advanced
+             * pass PL_bufptr, get a reasonable beginning of line
+             */
+            d = s;
+            while (d > SvPVX(PL_linestr) && d[-1] && d[-1] != '\n')
+                --d;
+        }
+        len = UTF ? Perl_utf8_length(aTHX_ (U8 *) d, (U8 *) s) : (STRLEN) (s - 
d);
+        if (len > UNRECOGNIZED_PRECEDE_COUNT) {
+            d = UTF ? (char *) utf8_hop_back((U8 *) s, 
-UNRECOGNIZED_PRECEDE_COUNT, (U8 *)d) : s - UNRECOGNIZED_PRECEDE_COUNT;
+        }
+
         Perl_croak(aTHX_  "Unrecognized character %s; marked by <-- HERE after 
%" UTF8f "<-- HERE near column %d", c,
                           UTF8fARG(UTF, (s - d), d),
                          (int) len + 1);
@@ -6221,8 +6232,10 @@ Perl_yylex(pTHX)
                        break;
                    }
                    if (strEQs(s, "sub")) {
+                        PL_bufptr = s;
                        d = s + 3;
                        d = skipspace(d);
+                        s = PL_bufptr;
                        if (*d == ':') {
                            PL_expect = XTERM;
                            break;
@@ -9433,10 +9446,13 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, 
I32 ck_uni)
 
         if ( !tmp_copline )
             tmp_copline = CopLINE(PL_curcop);
-        if ((skip = s < PL_bufend && isSPACE(*s)))
+        if ((skip = s < PL_bufend && isSPACE(*s))) {
             /* Avoid incrementing line numbers or resetting PL_linestart,
                in case we have to back up.  */
+            STRLEN s_off = s - SvPVX(PL_linestr);
             s2 = peekspace(s);
+            s = SvPVX(PL_linestr) + s_off;
+        }
         else
             s2 = s;
 

-- 
Perl5 Master Repository

Reply via email to