In perl.git, the branch smoke-me/jkeenan/harness-investigation has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/2711466d72f0279114175be33edbfe38cc4a50bd?hp=23631b86622c2f3eb8258164aa581e23a355a06b> - Log ----------------------------------------------------------------- commit 2711466d72f0279114175be33edbfe38cc4a50bd Merge: 755aff3d5f 23631b8662 Author: James E Keenan <[email protected]> Date: Thu Mar 2 15:00:10 2017 -0500 Merge branch 'smoke-me/jkeenan/harness-investigation' of git://perl5.git.perl.org/perl into smoke-me/jkeenan/harness-investigation commit 755aff3d5f7abeafbde05ba984993a62d6b3b77e Author: James E Keenan <[email protected]> Date: Sat Feb 25 21:57:08 2017 -0500 Trigger new SHA. M INSTALL commit f3a6b4416d1825a61a38baa16c312eed519bb6ac Author: James E Keenan <[email protected]> Date: Wed Feb 22 09:50:46 2017 -0500 Reposition ext/XS-APItest/t/*.t in t/TEST. Add debugging code to t/TEST and t/harness. M t/TEST M t/harness commit 8a3e57d7fb8b93aa50cd11231b018da4c2dfa9af Author: Karl Williamson <[email protected]> Date: Sat Feb 18 17:12:59 2017 -0700 Move API testing to earlier M t/TEST M t/harness ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + Porting/Maintainers.pl | 4 +- Porting/checkAUTHORS.pl | 1 + cpan/Config-Perl-V/V.pm | 24 ++-- cpan/Config-Perl-V/t/30_plv5240.t | 11 +- cpan/Config-Perl-V/t/31_plv52511.t | 182 ++++++++++++++++++++++++++++++ dist/IO/t/cachepropagate-unix.t | 8 +- dist/PathTools/Changes | 3 + dist/PathTools/Cwd.pm | 2 +- dist/PathTools/lib/File/Spec.pm | 11 +- dist/PathTools/lib/File/Spec/AmigaOS.pm | 2 +- dist/PathTools/lib/File/Spec/Cygwin.pm | 2 +- dist/PathTools/lib/File/Spec/Epoc.pm | 2 +- dist/PathTools/lib/File/Spec/Functions.pm | 2 +- dist/PathTools/lib/File/Spec/Mac.pm | 2 +- dist/PathTools/lib/File/Spec/OS2.pm | 2 +- dist/PathTools/lib/File/Spec/Unix.pm | 2 +- dist/PathTools/lib/File/Spec/VMS.pm | 2 +- dist/PathTools/lib/File/Spec/Win32.pm | 2 +- dist/threads-shared/lib/threads/shared.pm | 18 +-- dist/threads/lib/threads.pm | 4 +- dist/threads/t/exit.t | 10 +- dist/threads/t/thread.t | 2 +- dump.c | 15 +-- gv.c | 9 +- hv.c | 4 +- pod/perlfunc.pod | 6 +- pod/perlop.pod | 86 +++++++------- pp.c | 4 +- t/op/substr.t | 14 ++- 30 files changed, 330 insertions(+), 107 deletions(-) create mode 100644 cpan/Config-Perl-V/t/31_plv52511.t diff --git a/MANIFEST b/MANIFEST index ef1d98472e..d23f9857cc 100644 --- a/MANIFEST +++ b/MANIFEST @@ -241,6 +241,7 @@ cpan/Config-Perl-V/t/28_plv5220.t Config::Perl::V cpan/Config-Perl-V/t/28_plv52201w.t Config::Perl::V cpan/Config-Perl-V/t/29_plv5235w.t Config::Perl::V cpan/Config-Perl-V/t/30_plv5240.t Config::Perl::V +cpan/Config-Perl-V/t/31_plv52511.t Config::Perl::V cpan/Config-Perl-V/V.pm Config::Perl::V cpan/CPAN/lib/App/Cpan.pm helper package for CPAN.pm cpan/CPAN/lib/CPAN.pm Interface to Comprehensive Perl Archive Network diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 712735cb54..ca66df6d06 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1244,7 +1244,7 @@ use File::Glob qw(:case); }, 'threads' => { - 'DISTRIBUTION' => 'JDHEDDEN/threads-2.12.tar.gz', + 'DISTRIBUTION' => 'JDHEDDEN/threads-2.15.tar.gz', 'FILES' => q[dist/threads], 'EXCLUDED' => [ qr{^examples/}, @@ -1256,7 +1256,7 @@ use File::Glob qw(:case); }, 'threads::shared' => { - 'DISTRIBUTION' => 'JDHEDDEN/threads-shared-1.54.tar.gz', + 'DISTRIBUTION' => 'JDHEDDEN/threads-shared-1.55.tar.gz', 'FILES' => q[dist/threads-shared], 'EXCLUDED' => [ qw( examples/class.pl diff --git a/Porting/checkAUTHORS.pl b/Porting/checkAUTHORS.pl index cb8863c79a..9ee55f7724 100755 --- a/Porting/checkAUTHORS.pl +++ b/Porting/checkAUTHORS.pl @@ -593,6 +593,7 @@ damian\100conway.org damian\100cs.monash.edu.au dan\100sidhe.org sugalsd\100lbcc.cc.or.us + sugalskd\100osshe.edu daniel\100bitpusher.com daniel\100biz.bitpusher.com +dave\100mag-sol.com dave\100dave.org.uk david.dyck\100fluke.com dcd\100tc.fluke.com david\100justatheory.com david\100wheeler.net + david\100kineticode.com diff --git a/cpan/Config-Perl-V/V.pm b/cpan/Config-Perl-V/V.pm index c396f31854..9e9c09c9fa 100644 --- a/cpan/Config-Perl-V/V.pm +++ b/cpan/Config-Perl-V/V.pm @@ -8,8 +8,8 @@ use warnings; use Config; use Exporter; use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS); -$VERSION = "0.27"; -@ISA = ("Exporter"); +$VERSION = "0.28"; +@ISA = qw( Exporter ); @EXPORT_OK = qw( plv2hash summary myconfig signature ); %EXPORT_TAGS = ( all => [ @EXPORT_OK ], @@ -161,7 +161,7 @@ my @config_vars = qw( useithreads usemultiplicity useperlio d_sfio uselargefiles usesocks use64bitint use64bitall uselongdouble - usemymalloc bincompat5005 + usemymalloc default_inc_excludes_dot bincompat5005 cc ccflags optimize @@ -190,8 +190,7 @@ my %empty_build = ( patches => [], ); -sub _make_derived -{ +sub _make_derived { my $conf = shift; for ( [ lseektype => "Off_t" ], @@ -230,11 +229,12 @@ sub _make_derived $conf->{config}{git_describe} ||= $conf->{config}{perl_patchlevel}; } + $conf->{config}{$_} ||= "undef" for grep m/^(?:use|def)/ => @config_vars; + $conf; } # _make_derived -sub plv2hash -{ +sub plv2hash { my %config; my $pv = join "\n" => @_; @@ -308,8 +308,7 @@ sub plv2hash }); } # plv2hash -sub summary -{ +sub summary { my $conf = shift || myconfig (); ref $conf eq "HASH" && exists $conf->{config} && exists $conf->{build} or return; @@ -321,14 +320,14 @@ sub summary d_longdbl d_longlong use64bitall use64bitint useithreads uselongdouble usemultiplicity usemymalloc useperlio useshrplib doublesize intsize ivsize nvsize longdblsize longlongsize lseeksize + default_inc_excludes_dot ); $info{$_}++ for grep { $conf->{build}{options}{$_} } keys %{$conf->{build}{options}}; return \%info; } # summary -sub signature -{ +sub signature { eval { require Digest::MD5 }; $@ and return "00000000000000000000000000000000"; @@ -339,8 +338,7 @@ sub signature } sort keys %$conf); } # signature -sub myconfig -{ +sub myconfig { my $args = shift; my %args = ref $args eq "HASH" ? %$args : ref $args eq "ARRAY" ? @$args : (); diff --git a/cpan/Config-Perl-V/t/30_plv5240.t b/cpan/Config-Perl-V/t/30_plv5240.t index a730d240f0..b43b46f518 100644 --- a/cpan/Config-Perl-V/t/30_plv5240.t +++ b/cpan/Config-Perl-V/t/30_plv5240.t @@ -5,7 +5,7 @@ use warnings; BEGIN { use Test::More; - my $tests = 117; + my $tests = 125; unless ($ENV{PERL_CORE}) { require Test::NoWarnings; Test::NoWarnings->import (); @@ -15,7 +15,7 @@ BEGIN { plan tests => $tests; } -use Config::Perl::V; +use Config::Perl::V qw( summary ); ok (my $conf = Config::Perl::V::plv2hash (<DATA>), "Read perl -v block"); ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc ); @@ -64,9 +64,16 @@ my %check = ( osvers => "4.5.2-1-default", use64bitall => "define", use64bitint => "define", + usemymalloc => "n", + default_inc_excludes_dot + => "undef", ); is ($conf->{config}{$_}, $check{$_}, "reconstructed \$Config{$_}") for sort keys %check; +ok (my $info = summary ($conf), "A summary"); +ok (exists $info->{$_}, "Summary has $_") for qw( cc config_args usemymalloc default_inc_excludes_dot ); +is ($info->{default_inc_excludes_dot}, "undef", "This build has . in INC"); + __END__ Summary of my perl5 (revision 5 version 24 subversion 0) configuration: diff --git a/cpan/Config-Perl-V/t/31_plv52511.t b/cpan/Config-Perl-V/t/31_plv52511.t new file mode 100644 index 0000000000..b3c09cd522 --- /dev/null +++ b/cpan/Config-Perl-V/t/31_plv52511.t @@ -0,0 +1,182 @@ +#!/pro/bin/perl + +use strict; +use warnings; + +BEGIN { + use Test::More; + my $tests = 125; + unless ($ENV{PERL_CORE}) { + require Test::NoWarnings; + Test::NoWarnings->import (); + $tests++; + } + + plan tests => $tests; + } + +use Config::Perl::V qw( summary ); + +ok (my $conf = Config::Perl::V::plv2hash (<DATA>), "Read perl -v block"); +ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc ); + +is ($conf->{build}{osname}, $conf->{config}{osname}, "osname"); +is ($conf->{build}{stamp}, "Feb 27 2017 15:02:41", "Build time"); +is ($conf->{config}{version}, "5.25.11", "reconstructed \$Config{version}"); + +my $opt = Config::Perl::V::plv2hash ("")->{build}{options}; +foreach my $o (sort qw( + DEBUGGING HAS_TIMES MULTIPLICITY PERLIO_LAYERS PERL_COPY_ON_WRITE + PERL_DONT_CREATE_GVSV PERL_TRACK_MEMPOOL PERL_IMPLICIT_CONTEXT + PERL_MALLOC_WRAP PERL_OP_PARENT PERL_PRESERVE_IVUV PERL_USE_DEVEL + USE_64_BIT_ALL + USE_64_BIT_INT USE_ITHREADS USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE + USE_LOCALE_CTYPE USE_LOCALE_NUMERIC USE_LOCALE_TIME + USE_LONG_DOUBLE USE_PERLIO USE_PERL_ATOF USE_REENTRANT_API + )) { + is ($conf->{build}{options}{$o}, 1, "Runtime option $o set"); + delete $opt->{$o}; + } +foreach my $o (sort keys %$opt) { + is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset"); + } + +is_deeply ($conf->{build}{patches}, + [ "SMOKEaa9ac6cf00899a6f55881d4ca6c1214215dc83ee" ], "Local patches"); + +my %check = ( + alignbytes => 16, + api_version => 25, + bincompat5005 => "undef", + byteorder => 12345678, + cc => "cc", + cccdlflags => "-fPIC", + ccdlflags => "-Wl,-E", + config_args => "-des -Dusedevel -Duseithreads -Duse64bitall -Duselongdouble -DDEBUGGING", + gccversion => "6.3.1 20170202 [gcc-6-branch revision 245119]", + gnulibc_version => "2.24", + ivsize => 8, + ivtype => "long", + ld => "cc", + lddlflags => "-shared -O2 -g -L/pro/local/lib -fstack-protector-strong", + ldflags => "-L/pro/local/lib -fstack-protector-strong", + libc => "libc-2.24.so", + lseektype => "off_t", + osvers => "4.10.0-1-default", + use64bitall => "define", + use64bitint => "define", + usemymalloc => "n", + default_inc_excludes_dot + => "undef", + ); +is ($conf->{config}{$_}, $check{$_}, "reconstructed \$Config{$_}") for sort keys %check; + +ok (my $info = summary ($conf), "A summary"); +ok (exists $info->{$_}, "Summary has $_") for qw( cc config_args usemymalloc default_inc_excludes_dot ); +is ($info->{default_inc_excludes_dot}, "undef", "This build has . in INC"); + +__END__ +Summary of my perl5 (revision 5 version 25 subversion 11) configuration: + Snapshot of: aa9ac6cf00899a6f55881d4ca6c1214215dc83ee + Platform: + osname=linux + osvers=4.10.0-1-default + archname=x86_64-linux-thread-multi-ld + uname='linux lx09 4.10.0-1-default #1 smp preempt mon feb 20 16:47:26 utc 2017 (81ace5a) x86_64 x86_64 x86_64 gnulinux ' + config_args='-des -Dusedevel -Duseithreads -Duse64bitall -Duselongdouble -DDEBUGGING' + hint=recommended + useposix=true + d_sigaction=define + useithreads=define + usemultiplicity=define + use64bitint=define + use64bitall=define + uselongdouble=define + usemymalloc=n + default_inc_excludes_dot=undef + bincompat5005=undef + Compiler: + cc='cc' + ccflags ='-D_REENTRANT -D_GNU_SOURCE -fPIC -DDEBUGGING -fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/pro/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' + optimize='-O2 -g' + cppflags='-D_REENTRANT -D_GNU_SOURCE -fPIC -DDEBUGGING -fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/pro/local/include' + ccversion='' + gccversion='6.3.1 20170202 [gcc-6-branch revision 245119]' + gccosandvers='' + intsize=4 + longsize=8 + ptrsize=8 + doublesize=8 + byteorder=12345678 + doublekind=3 + d_longlong=define + longlongsize=8 + d_longdbl=define + longdblsize=16 + longdblkind=3 + ivtype='long' + ivsize=8 + nvtype='long double' + nvsize=16 + Off_t='off_t' + lseeksize=8 + alignbytes=16 + prototype=define + Linker and Libraries: + ld='cc' + ldflags ='-L/pro/local/lib -fstack-protector-strong' + libpth=/usr/local/lib /usr/lib64/gcc/x86_64-suse-linux/6/include-fixed /usr/lib64/gcc/x86_64-suse-linux/6/../../../../x86_64-suse-linux/lib /usr/lib /pro/local/lib /lib/../lib64 /usr/lib/../lib64 ... [40 chars truncated] + libs=-lpthread -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat + perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc + libc=libc-2.24.so + so=so + useshrplib=false + libperl=libperl.a + gnulibc_version='2.24' + Dynamic Linking: + dlsrc=dl_dlopen.xs + dlext=so + d_dlsymun=undef + ccdlflags='-Wl,-E' + cccdlflags='-fPIC' + lddlflags='-shared -O2 -g -L/pro/local/lib -fstack-protector-strong' + + +Characteristics of this binary (from libperl): + Compile-time options: + DEBUGGING + HAS_TIMES + MULTIPLICITY + PERLIO_LAYERS + PERL_COPY_ON_WRITE + PERL_DONT_CREATE_GVSV + PERL_IMPLICIT_CONTEXT + PERL_MALLOC_WRAP + PERL_OP_PARENT + PERL_PRESERVE_IVUV + PERL_TRACK_MEMPOOL + PERL_USE_DEVEL + USE_64_BIT_ALL + USE_64_BIT_INT + USE_ITHREADS + USE_LARGE_FILES + USE_LOCALE + USE_LOCALE_COLLATE + USE_LOCALE_CTYPE + USE_LOCALE_NUMERIC + USE_LOCALE_TIME + USE_LONG_DOUBLE + USE_PERLIO + USE_PERL_ATOF + USE_REENTRANT_API + Locally applied patches: + SMOKEaa9ac6cf00899a6f55881d4ca6c1214215dc83ee + Built under linux + Compiled at Feb 27 2017 15:02:41 + @INC: + lib + /pro/lib/perl5/site_perl/5.25.11/x86_64-linux-thread-multi-ld + /pro/lib/perl5/site_perl/5.25.11 + /pro/lib/perl5/5.25.11/x86_64-linux-thread-multi-ld + /pro/lib/perl5/5.25.11 + . diff --git a/dist/IO/t/cachepropagate-unix.t b/dist/IO/t/cachepropagate-unix.t index 20c70dd86a..9ec42b0455 100644 --- a/dist/IO/t/cachepropagate-unix.t +++ b/dist/IO/t/cachepropagate-unix.t @@ -24,8 +24,12 @@ my $socketpath = catfile(tempdir( CLEANUP => 1 ), 'testsock'); # https://rt.cpan.org/Ticket/Display.html?id=116819 my $name = eval { pack_sockaddr_un($socketpath) }; -defined $name && (unpack_sockaddr_un($name))[0] eq $socketpath - or plan skip_all => "socketpath too long for sockaddr_un"; +if (defined $name) { + my ($packed_name) = eval { unpack_sockaddr_un($name) }; + if (!defined $packed_name || $packed_name ne $socketpath) { + plan skip_all => "socketpath too long for sockaddr_un"; + } +} plan tests => 15; diff --git a/dist/PathTools/Changes b/dist/PathTools/Changes index 46c9a9e558..7d0c1798b8 100644 --- a/dist/PathTools/Changes +++ b/dist/PathTools/Changes @@ -1,5 +1,8 @@ Revision history for Perl distribution PathTools. +3.67 - Mon Feb 27 09:33:04 EST 2017 +- Add security usage note to File::Spec::no_upwards + 3.66 - Sat Nov 19 10:30:19 MST 2016 - white space change so can compile under C++11 diff --git a/dist/PathTools/Cwd.pm b/dist/PathTools/Cwd.pm index 362a000e7a..ce142cfe69 100644 --- a/dist/PathTools/Cwd.pm +++ b/dist/PathTools/Cwd.pm @@ -3,7 +3,7 @@ use strict; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); -$VERSION = '3.66'; +$VERSION = '3.67'; my $xs_version = $VERSION; $VERSION =~ tr/_//d; diff --git a/dist/PathTools/lib/File/Spec.pm b/dist/PathTools/lib/File/Spec.pm index 85ad17426c..a9a7619470 100644 --- a/dist/PathTools/lib/File/Spec.pm +++ b/dist/PathTools/lib/File/Spec.pm @@ -3,7 +3,7 @@ package File::Spec; use strict; use vars qw(@ISA $VERSION); -$VERSION = '3.66'; +$VERSION = '3.67'; $VERSION =~ tr/_//d; my %module = (MacOS => 'Mac', @@ -158,10 +158,13 @@ Returns a string representation of the parent directory. =item no_upwards -Given a list of file names, strip out those that refer to a parent -directory. (Does not strip symlinks, only '.', '..', and equivalents.) +Given a list of files in a directory (such as from C<readdir()>), +strip out C<'.'> and C<'..'>. - @paths = File::Spec->no_upwards( @paths ); +B<SECURITY NOTE:> This does NOT filter paths containing C<'..'>, like +C<'../../../../etc/passwd'>, only literal matches to C<'.'> and C<'..'>. + + @paths = File::Spec->no_upwards( readdir $dirhandle ); =item case_tolerant diff --git a/dist/PathTools/lib/File/Spec/AmigaOS.pm b/dist/PathTools/lib/File/Spec/AmigaOS.pm index b288f224ae..8d3796e123 100644 --- a/dist/PathTools/lib/File/Spec/AmigaOS.pm +++ b/dist/PathTools/lib/File/Spec/AmigaOS.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.66'; +$VERSION = '3.67'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Cygwin.pm b/dist/PathTools/lib/File/Spec/Cygwin.pm index 48da5426b8..745df86ee5 100644 --- a/dist/PathTools/lib/File/Spec/Cygwin.pm +++ b/dist/PathTools/lib/File/Spec/Cygwin.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.66'; +$VERSION = '3.67'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Epoc.pm b/dist/PathTools/lib/File/Spec/Epoc.pm index ef8af40145..959261a58e 100644 --- a/dist/PathTools/lib/File/Spec/Epoc.pm +++ b/dist/PathTools/lib/File/Spec/Epoc.pm @@ -3,7 +3,7 @@ package File::Spec::Epoc; use strict; use vars qw($VERSION @ISA); -$VERSION = '3.66'; +$VERSION = '3.67'; $VERSION =~ tr/_//d; require File::Spec::Unix; diff --git a/dist/PathTools/lib/File/Spec/Functions.pm b/dist/PathTools/lib/File/Spec/Functions.pm index ccf1562599..cb7532e57f 100644 --- a/dist/PathTools/lib/File/Spec/Functions.pm +++ b/dist/PathTools/lib/File/Spec/Functions.pm @@ -5,7 +5,7 @@ use strict; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); -$VERSION = '3.66'; +$VERSION = '3.67'; $VERSION =~ tr/_//d; require Exporter; diff --git a/dist/PathTools/lib/File/Spec/Mac.pm b/dist/PathTools/lib/File/Spec/Mac.pm index a7454e7ded..192cc8da9b 100644 --- a/dist/PathTools/lib/File/Spec/Mac.pm +++ b/dist/PathTools/lib/File/Spec/Mac.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.66'; +$VERSION = '3.67'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/OS2.pm b/dist/PathTools/lib/File/Spec/OS2.pm index a17f995674..1e201ebade 100644 --- a/dist/PathTools/lib/File/Spec/OS2.pm +++ b/dist/PathTools/lib/File/Spec/OS2.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.66'; +$VERSION = '3.67'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Unix.pm b/dist/PathTools/lib/File/Spec/Unix.pm index 9f66dc2035..ff3599acf6 100644 --- a/dist/PathTools/lib/File/Spec/Unix.pm +++ b/dist/PathTools/lib/File/Spec/Unix.pm @@ -3,7 +3,7 @@ package File::Spec::Unix; use strict; use vars qw($VERSION); -$VERSION = '3.66'; +$VERSION = '3.67'; my $xs_version = $VERSION; $VERSION =~ tr/_//d; diff --git a/dist/PathTools/lib/File/Spec/VMS.pm b/dist/PathTools/lib/File/Spec/VMS.pm index c055e6b853..fb4351f086 100644 --- a/dist/PathTools/lib/File/Spec/VMS.pm +++ b/dist/PathTools/lib/File/Spec/VMS.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.66'; +$VERSION = '3.67'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Win32.pm b/dist/PathTools/lib/File/Spec/Win32.pm index 9036654d4c..17f1c5a190 100644 --- a/dist/PathTools/lib/File/Spec/Win32.pm +++ b/dist/PathTools/lib/File/Spec/Win32.pm @@ -5,7 +5,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.66'; +$VERSION = '3.67'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/threads-shared/lib/threads/shared.pm b/dist/threads-shared/lib/threads/shared.pm index d42981b86b..5a203b0cd7 100644 --- a/dist/threads-shared/lib/threads/shared.pm +++ b/dist/threads-shared/lib/threads/shared.pm @@ -7,7 +7,7 @@ use warnings; use Scalar::Util qw(reftype refaddr blessed); -our $VERSION = '1.54'; # Please update the pod, too. +our $VERSION = '1.55'; # Please update the pod, too. my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -195,7 +195,7 @@ threads::shared - Perl extension for sharing data structures between threads =head1 VERSION -This document describes threads::shared version 1.54 +This document describes threads::shared version 1.55 =head1 SYNOPSIS @@ -570,16 +570,18 @@ not propagate the blessing to the shared reference: Therefore, you should bless objects before sharing them. It is often not wise to share an object unless the class itself has been -written to support sharing. For example, an object's destructor may get -called multiple times, once for each thread's scope exit. Another danger is -that the contents of hash-based objects will be lost due to the above -mentioned limitation. See F<examples/class.pl> (in the CPAN distribution of -this module) for how to create a class that supports object sharing. +written to support sharing. For example, a shared object's destructor may +get called multiple times, once for each thread's scope exit, or may not +get called at all if it is embedded inside another shared object. Another +issue is that the contents of hash-based objects will be lost due to the +above mentioned limitation. See F<examples/class.pl> (in the CPAN +distribution of this module) for how to create a class that supports object +sharing. Destructors may not be called on objects if those objects still exist at global destruction time. If the destructors must be called, make sure there are no circular references and that nothing is referencing the -objects, before the program ends. +objects before the program ends. Does not support C<splice> on arrays. Does not support explicitly changing array lengths via $#array -- use C<push> and C<pop> instead. diff --git a/dist/threads/lib/threads.pm b/dist/threads/lib/threads.pm index b2bd872344..d174f72496 100644 --- a/dist/threads/lib/threads.pm +++ b/dist/threads/lib/threads.pm @@ -5,7 +5,7 @@ use 5.008; use strict; use warnings; -our $VERSION = '2.13'; +our $VERSION = '2.15'; my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -134,7 +134,7 @@ threads - Perl interpreter-based threads =head1 VERSION -This document describes threads version 2.12 +This document describes threads version 2.15 =head1 WARNING diff --git a/dist/threads/t/exit.t b/dist/threads/t/exit.t index c50bf98e4d..bad602f8bb 100644 --- a/dist/threads/t/exit.t +++ b/dist/threads/t/exit.t @@ -48,7 +48,7 @@ my $rc = $thr->join(); ok(! defined($rc), 'Exited: threads->exit()'); -run_perl(prog => 'use threads 2.12;' . +run_perl(prog => 'use threads 2.15;' . 'threads->exit(86);' . 'exit(99);', nolib => ($ENV{PERL_CORE}) ? 0 : 1, @@ -98,7 +98,7 @@ $rc = $thr->join(); ok(! defined($rc), 'Exited: $thr->set_thread_exit_only'); -run_perl(prog => 'use threads 2.12 qw(exit thread_only);' . +run_perl(prog => 'use threads 2.15 qw(exit thread_only);' . 'threads->create(sub { exit(99); })->join();' . 'exit(86);', nolib => ($ENV{PERL_CORE}) ? 0 : 1, @@ -108,7 +108,7 @@ run_perl(prog => 'use threads 2.12 qw(exit thread_only);' . is($?>>8, 86, "'use threads 'exit' => 'thread_only'"); } -my $out = run_perl(prog => 'use threads 2.12;' . +my $out = run_perl(prog => 'use threads 2.15;' . 'threads->create(sub {' . ' exit(99);' . '});' . @@ -124,7 +124,7 @@ my $out = run_perl(prog => 'use threads 2.12;' . like($out, qr/1 finished and unjoined/, "exit(status) in thread"); -$out = run_perl(prog => 'use threads 2.12 qw(exit thread_only);' . +$out = run_perl(prog => 'use threads 2.15 qw(exit thread_only);' . 'threads->create(sub {' . ' threads->set_thread_exit_only(0);' . ' exit(99);' . @@ -141,7 +141,7 @@ $out = run_perl(prog => 'use threads 2.12 qw(exit thread_only);' . like($out, qr/1 finished and unjoined/, "set_thread_exit_only(0)"); -run_perl(prog => 'use threads 2.12;' . +run_perl(prog => 'use threads 2.15;' . 'threads->create(sub {' . ' $SIG{__WARN__} = sub { exit(99); };' . ' die();' . diff --git a/dist/threads/t/thread.t b/dist/threads/t/thread.t index 466fb13b1b..8f4f156967 100644 --- a/dist/threads/t/thread.t +++ b/dist/threads/t/thread.t @@ -161,7 +161,7 @@ package main; # bugid #24165 -run_perl(prog => 'use threads 2.12;' . +run_perl(prog => 'use threads 2.15;' . 'sub a{threads->create(shift)} $t = a sub{};' . '$t->tid; $t->join; $t->tid', nolib => ($ENV{PERL_CORE}) ? 0 : 1, diff --git a/dump.c b/dump.c index 52b52cab08..c5e3a79feb 100644 --- a/dump.c +++ b/dump.c @@ -1227,21 +1227,22 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o) case OP_REDO: if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS)) break; - /* FALLTHROUGH */ - case OP_TRANS: - case OP_TRANSR: - if ( (o->op_type == OP_TRANS || o->op_type == OP_TRANSR) - && (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))) - break; - { SV * const label = newSVpvs_flags("", SVs_TEMP); generic_pv_escape(label, cPVOPo->op_pv, strlen(cPVOPo->op_pv), 0); S_opdump_indent(aTHX_ o, level, bar, file, "PV = \"%" SVf "\" (0x%" UVxf ")\n", SVfARG(label), PTR2UV(cPVOPo->op_pv)); + break; } + case OP_TRANS: + case OP_TRANSR: + S_opdump_indent(aTHX_ o, level, bar, file, + "PV = 0x%" UVxf "\n", + PTR2UV(cPVOPo->op_pv)); + break; + default: break; diff --git a/gv.c b/gv.c index 8c85614386..d32a9c5399 100644 --- a/gv.c +++ b/gv.c @@ -1496,7 +1496,14 @@ S_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char *name, U32 namelen, I32 flag (flags & SVf_UTF8) ? HVhek_UTF8 : 0, 0, NULL, 0 ); - if (he) return INT2PTR(HV*,SvIVX(HeVAL(he))); + if (he) { + SV *sv = HeVAL(he); + HV *hv; + assert(SvIOK(sv)); + hv = INT2PTR(HV*, SvIVX(sv)); + assert(SvTYPE(hv) == SVt_PVHV); + return hv; + } else if (flags & GV_CACHE_ONLY) return NULL; if (namesv) { diff --git a/hv.c b/hv.c index efeadb7dad..85e42d13e0 100644 --- a/hv.c +++ b/hv.c @@ -2172,8 +2172,8 @@ S_hv_auxinit(pTHX_ HV *hv) { =for apidoc hv_iterinit Prepares a starting point to traverse a hash table. Returns the number of -keys in the hash (i.e. the same as C<HvUSEDKEYS(hv)>). The return value is -currently only meaningful for hashes without tie magic. +keys in the hash, including placeholders (i.e. the same as C<HvTOTALKEYS(hv)>). +The return value is currently only meaningful for hashes without tie magic. NOTE: Before version 5.004_65, C<hv_iterinit> used to return the number of hash buckets that happen to be in use. If you still need that esoteric diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 88d30a55fd..3854acf6e6 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -2295,8 +2295,8 @@ always parses its argument (or L<C<$_>|perlvar/$_> if EXPR is omitted) as a string of independent bytes. If called when S<C<use utf8>> is in effect, the string will be assumed -to be encoded in UTF-8, and C<evalbytes> will make a temporary -downgraded to non-UTF-8 copy to work from. If this is not possible +to be encoded in UTF-8, and C<evalbytes> will make a temporary copy to +work from, downgraded to non-UTF-8. If this is not possible (because one or more characters in it require UTF-8), the C<evalbytes> will fail with the error stored in C<$@>. @@ -5765,7 +5765,7 @@ returning the filehandle value instead, in which case the LIST may not be omitted: print { $files[$i] } "stuff\n"; - print { $OK ? STDOUT : STDERR } "stuff\n"; + print { $OK ? *STDOUT : *STDERR } "stuff\n"; Printing to a closed pipe or socket will generate a SIGPIPE signal. See L<perlipc> for more on signal handling. diff --git a/pod/perlop.pod b/pod/perlop.pod index 7df98f716d..e627ee8c99 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -404,7 +404,7 @@ If you get tired of being subject to your platform's native integers, the S<C<use bigint>> pragma neatly sidesteps the issue altogether: print 20 << 20; # 20971520 - print 20 << 40; # 5120 on 32-bit machines, + print 20 << 40; # 5120 on 32-bit machines, # 21990232555520 on 64-bit machines use bigint; print 20 << 100; # 25353012004564588029934064107520 @@ -449,7 +449,7 @@ See also L</"Terms and List Operators (Leftward)">. =head2 Relational Operators X<relational operator> X<operator, relational> -Perl operators that return true or false generally return values +Perl operators that return true or false generally return values that can be safely used as numbers. For example, the relational operators in this section and the equality operators in the next one return C<1> for true and a special version of the defined empty @@ -579,81 +579,81 @@ whose types apply determines the smartmatch behavior. Because what actually happens is mostly determined by the type of the second operand, the table is sorted on the right operand instead of on the left. - Left Right Description and pseudocode + Left Right Description and pseudocode =============================================================== - Any undef check whether Any is undefined + Any undef check whether Any is undefined like: !defined Any Any Object invoke ~~ overloading on Object, or die Right operand is an ARRAY: - Left Right Description and pseudocode + Left Right Description and pseudocode =============================================================== ARRAY1 ARRAY2 recurse on paired elements of ARRAY1 and ARRAY2[2] like: (ARRAY1[0] ~~ ARRAY2[0]) && (ARRAY1[1] ~~ ARRAY2[1]) && ... - HASH ARRAY any ARRAY elements exist as HASH keys + HASH ARRAY any ARRAY elements exist as HASH keys like: grep { exists HASH->{$_} } ARRAY Regexp ARRAY any ARRAY elements pattern match Regexp like: grep { /Regexp/ } ARRAY - undef ARRAY undef in ARRAY + undef ARRAY undef in ARRAY like: grep { !defined } ARRAY - Any ARRAY smartmatch each ARRAY element[3] + Any ARRAY smartmatch each ARRAY element[3] like: grep { Any ~~ $_ } ARRAY Right operand is a HASH: - Left Right Description and pseudocode + Left Right Description and pseudocode =============================================================== - HASH1 HASH2 all same keys in both HASHes + HASH1 HASH2 all same keys in both HASHes like: keys HASH1 == grep { exists HASH2->{$_} } keys HASH1 - ARRAY HASH any ARRAY elements exist as HASH keys + ARRAY HASH any ARRAY elements exist as HASH keys like: grep { exists HASH->{$_} } ARRAY - Regexp HASH any HASH keys pattern match Regexp + Regexp HASH any HASH keys pattern match Regexp like: grep { /Regexp/ } keys HASH - undef HASH always false (undef can't be a key) + undef HASH always false (undef can't be a key) like: 0 == 1 - Any HASH HASH key existence + Any HASH HASH key existence like: exists HASH->{Any} Right operand is CODE: - Left Right Description and pseudocode + Left Right Description and pseudocode =============================================================== ARRAY CODE sub returns true on all ARRAY elements[1] like: !grep { !CODE->($_) } ARRAY HASH CODE sub returns true on all HASH keys[1] like: !grep { !CODE->($_) } keys HASH - Any CODE sub passed Any returns true + Any CODE sub passed Any returns true like: CODE->(Any) Right operand is a Regexp: - Left Right Description and pseudocode + Left Right Description and pseudocode =============================================================== - ARRAY Regexp any ARRAY elements match Regexp + ARRAY Regexp any ARRAY elements match Regexp like: grep { /Regexp/ } ARRAY - HASH Regexp any HASH keys match Regexp + HASH Regexp any HASH keys match Regexp like: grep { /Regexp/ } keys HASH - Any Regexp pattern match + Any Regexp pattern match like: Any =~ /Regexp/ Other: - Left Right Description and pseudocode + Left Right Description and pseudocode =============================================================== Object Any invoke ~~ overloading on Object, or fall back to... - Any Num numeric equality + Any Num numeric equality like: Any == Num Num nummy[4] numeric equality like: Num == nummy undef Any check whether undefined like: !defined(Any) - Any Any string equality + Any Any string equality like: Any eq Any @@ -662,13 +662,13 @@ Notes: =over =item 1. -Empty hashes or arrays match. +Empty hashes or arrays match. =item 2. That is, each element smartmatches the element of the same index in the other array.[3] =item 3. -If a circular reference is found, fall back to referential equality. +If a circular reference is found, fall back to referential equality. =item 4. Either an actual number, or a string that looks like one. @@ -723,7 +723,7 @@ recursively. my @bigger = ("red", "blue", [ "orange", "green" ] ); if (@little ~~ @bigger) { # true! say "little is contained in bigger"; - } + } Because the smartmatch operator recurses on nested arrays, this will still report that "red" is in the array. @@ -737,21 +737,21 @@ If two arrays smartmatch each other, then they are deep copies of each others' values, as this example reports: use v5.12.0; - my @a = (0, 1, 2, [3, [4, 5], 6], 7); - my @b = (0, 1, 2, [3, [4, 5], 6], 7); + my @a = (0, 1, 2, [3, [4, 5], 6], 7); + my @b = (0, 1, 2, [3, [4, 5], 6], 7); if (@a ~~ @b && @b ~~ @a) { say "a and b are deep copies of each other"; - } + } elsif (@a ~~ @b) { say "a smartmatches in b"; - } + } elsif (@b ~~ @a) { say "b smartmatches in a"; - } + } else { say "a and b don't smartmatch each other at all"; - } + } If you were to set S<C<$b[3] = 4>>, then instead of reporting that "a and b @@ -818,7 +818,7 @@ C<I<X>>, overloading may or may not be invoked. For simple strings or numbers, "in" becomes equivalent to this: $object ~~ $number ref($object) == $number - $object ~~ $string ref($object) eq $string + $object ~~ $string ref($object) eq $string For example, this reports that the handle smells IOish (but please don't really do this!): @@ -827,7 +827,7 @@ For example, this reports that the handle smells IOish my $fh = IO::Handle->new(); if ($fh ~~ /\bIO\b/) { say "handle smells IOish"; - } + } That's because it treats C<$fh> as a string like C<"IO::Handle=GLOB(0x8039e0)">, then pattern matches against that. @@ -940,7 +940,7 @@ It would be even more readable to write that this way: unless(unlink("alpha", "beta", "gamma")) { gripe(); next LINE; - } + } Using C<"or"> for assignment is unlikely to do what you want; see below. @@ -1092,9 +1092,9 @@ To get the 25 traditional lowercase Greek letters, including both sigmas, you could use this instead: use charnames "greek"; - my @greek_small = map { chr } ( ord("\N{alpha}") + my @greek_small = map { chr } ( ord("\N{alpha}") .. - ord("\N{omega}") + ord("\N{omega}") ); However, because there are I<many> other lowercase Greek characters than @@ -1694,7 +1694,7 @@ interpolation is done. Returns a Perl value which may be used instead of the corresponding C</I<STRING>/msixpodualn> expression. The returned value is a normalized version of the original pattern. It magically differs from a string containing the same characters: C<ref(qr/x/)> returns "Regexp"; -however, dereferencing it is not well defined (you currently get the +however, dereferencing it is not well defined (you currently get the normalized version of the original pattern, but this may change). @@ -1874,7 +1874,7 @@ If the C</g> option is not used, C<m//> in list context returns a list consisting of the subexpressions matched by the parentheses in the pattern, that is, (C<$1>, C<$2>, C<$3>...) (Note that here C<$1> etc. are also set). When there are no parentheses in the pattern, the return -value is the list C<(1)> for success. +value is the list C<(1)> for success. With or without parentheses, an empty list is returned upon failure. Examples: @@ -2294,7 +2294,7 @@ On some platforms (notably DOS-like ones), the shell may not be capable of dealing with multiline commands, so putting newlines in the string may not get you what you want. You may be able to evaluate multiple commands in a single line by separating them with the command -separator character, if your shell supports that (for example, C<;> on +separator character, if your shell supports that (for example, C<;> on many Unix shells and C<&> on the Windows NT C<cmd> shell). Perl will attempt to flush all files opened for @@ -2790,7 +2790,7 @@ If the left part is delimited by bracketing punctuation (that is C<()>, C<[]>, C<{}>, or C<< <> >>), the right part needs another pair of delimiters such as C<s(){}> and C<tr[]//>. In these cases, whitespace and comments are allowed between the two parts, although the comment must follow -at least one whitespace character; otherwise a character expected as the +at least one whitespace character; otherwise a character expected as the start of the comment may be regarded as the starting delimiter of the right part. During this search no attention is paid to the semantics of the construct. @@ -3077,7 +3077,7 @@ The following lines are equivalent: print while ($_ = <STDIN>); print while <STDIN>; -This also behaves similarly, but assigns to a lexical variable +This also behaves similarly, but assigns to a lexical variable instead of to C<$_>: while (my $line = <STDIN>) { print $line } @@ -3284,7 +3284,7 @@ variable substitution. Backslash interpolation also happens at compile time. You can say 'Now is the time for all' - . "\n" + . "\n" . 'good men to come to.' and this all reduces to one string internally. Likewise, if diff --git a/pp.c b/pp.c index 62316fc8b4..a640995e31 100644 --- a/pp.c +++ b/pp.c @@ -3396,8 +3396,10 @@ PP(pp_substr) tmps = SvPV_force_nomg(sv, curlen); if (DO_UTF8(repl_sv) && repl_len) { if (!DO_UTF8(sv)) { + /* Upgrade the dest, and recalculate tmps in case the buffer + * got reallocated; curlen may also have been changed */ sv_utf8_upgrade_nomg(sv); - curlen = SvCUR(sv); + tmps = SvPV_nomg(sv, curlen); } } else if (DO_UTF8(sv)) diff --git a/t/op/substr.t b/t/op/substr.t index a8abed825c..3c7f0eb158 100644 --- a/t/op/substr.t +++ b/t/op/substr.t @@ -22,7 +22,7 @@ $SIG{__WARN__} = sub { } }; -plan(391); +plan(393); run_tests() unless caller; @@ -880,3 +880,15 @@ is($destroyed, 1, 'Timely scalar destruction with lvalue substr'); # failed with ASAN fresh_perl_is('$0 = "/usr/bin/perl"; substr($0, 0, 0, $0)', '', {}, "(perl #129340) substr() with source in target"); + + +# [perl #130624] - heap-use-after-free, observable under asan +{ + my $x = "\xE9zzzz"; + my $y = "\x{100}"; + my $z = substr $x, 0, 1, $y; + is $z, "\xE9", "RT#130624: heap-use-after-free in 4-arg substr (ret)"; + is $x, "\x{100}zzzz", "RT#130624: heap-use-after-free in 4-arg substr (targ)"; +} + + -- Perl5 Master Repository
