diff options
author | Karl Berry <karl@freefriends.org> | 2012-05-21 00:15:27 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2012-05-21 00:15:27 +0000 |
commit | a4c42bfb2337d37da89d789cb8cc226367994e32 (patch) | |
tree | c3eabdef5d565a4e515d2be0d9d4d0540bde0250 /Master/tlpkg/tlperl/lib/ExtUtils | |
parent | 8274475057f024d35332ac47c2e2f23ea156e6ed (diff) |
perl 5.14.2 from siep
git-svn-id: svn://tug.org/texlive/trunk@26525 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/ExtUtils')
54 files changed, 1641 insertions, 493 deletions
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder.pm index 7854e88dc94..969b3596832 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder.pm @@ -3,59 +3,12 @@ package ExtUtils::CBuilder; use File::Spec (); use File::Path (); use File::Basename (); +use Perl::OSType qw/os_type/; use vars qw($VERSION @ISA); -$VERSION = '0.27'; +$VERSION = '0.280203'; $VERSION = eval $VERSION; -# Okay, this is the brute-force method of finding out what kind of -# platform we're on. I don't know of a systematic way. These values -# came from the latest (bleadperl) perlport.pod. - -my %OSTYPES = qw( - aix Unix - bsdos Unix - dgux Unix - dynixptx Unix - freebsd Unix - linux Unix - hpux Unix - irix Unix - darwin Unix - machten Unix - next Unix - openbsd Unix - netbsd Unix - dec_osf Unix - svr4 Unix - svr5 Unix - sco_sv Unix - unicos Unix - unicosmk Unix - solaris Unix - sunos Unix - cygwin Unix - os2 Unix - gnu Unix - gnukfreebsd Unix - haiku Unix - - dos Windows - MSWin32 Windows - - os390 EBCDIC - os400 EBCDIC - posix-bc EBCDIC - vmesa EBCDIC - - MacOS MacOS - VMS VMS - VOS VOS - riscos RiscOS - amigaos Amiga - mpeix MPEiX - ); - # We only use this once - don't waste a symbol table entry on it. # More importantly, don't make it an inheritable method. my $load = sub { @@ -68,20 +21,19 @@ my $load = sub { { my @package = split /::/, __PACKAGE__; + my $ostype = os_type(); + if (grep {-e File::Spec->catfile($_, @package, 'Platform', $^O) . '.pm'} @INC) { $load->(__PACKAGE__ . "::Platform::$^O"); - } elsif (exists $OSTYPES{$^O} and - grep {-e File::Spec->catfile($_, @package, 'Platform', $OSTYPES{$^O}) . '.pm'} @INC) { - $load->(__PACKAGE__ . "::Platform::$OSTYPES{$^O}"); + } elsif ( $ostype && grep {-e File::Spec->catfile($_, @package, 'Platform', $ostype) . '.pm'} @INC) { + $load->(__PACKAGE__ . "::Platform::$ostype"); } else { $load->(__PACKAGE__ . "::Base"); } } -sub os_type { $OSTYPES{$^O} } - 1; __END__ diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Base.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Base.pm index 28036c61bdc..b57231272a6 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Base.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Base.pm @@ -7,9 +7,27 @@ use Cwd (); use Config; use Text::ParseWords; use IO::File; +use Data::Dumper;$Data::Dumper::Indent=1; +use IPC::Cmd qw(can_run); +use File::Temp qw(tempfile); use vars qw($VERSION); -$VERSION = '0.27'; +$VERSION = '0.280203'; + +# More details about C/C++ compilers: +# http://developers.sun.com/sunstudio/documentation/product/compiler.jsp +# http://gcc.gnu.org/ +# http://publib.boulder.ibm.com/infocenter/comphelp/v101v121/index.jsp +# http://msdn.microsoft.com/en-us/vstudio/default.aspx + +my %cc2cxx = ( + # first line order is important to support wrappers like in pkgsrc + cc => [ 'c++', 'CC', 'aCC', 'cxx', ], # Sun Studio, HP ANSI C/C++ Compilers + gcc => [ 'g++' ], # GNU Compiler Collection + xlc => [ 'xlC' ], # IBM C/C++ Set, xlc without thread-safety + xlc_r => [ 'xlC_r' ], # IBM C/C++ Set, xlc with thread-safety + cl => [ 'cl' ], # Microsoft Visual Studio +); sub new { my $class = shift; @@ -21,7 +39,37 @@ sub new { while (my ($k,$v) = each %Config) { $self->{config}{$k} = $v unless exists $self->{config}{$k}; } - $self->{config}{cc} = $ENV{CC} if exists $ENV{CC}; + $self->{config}{cc} = $ENV{CC} if defined $ENV{CC}; + $self->{config}{ccflags} = $ENV{CFLAGS} if defined $ENV{CFLAGS}; + $self->{config}{cxx} = $ENV{CXX} if defined $ENV{CXX}; + $self->{config}{cxxflags} = $ENV{CXXFLAGS} if defined $ENV{CXXFLAGS}; + $self->{config}{ld} = $ENV{LD} if defined $ENV{LD}; + $self->{config}{ldflags} = $ENV{LDFLAGS} if defined $ENV{LDFLAGS}; + + unless ( exists $self->{config}{cxx} ) { + my ($ccpath, $ccbase, $ccsfx ) = fileparse($self->{config}{cc}, qr/\.[^.]*/); + foreach my $cxx (@{$cc2cxx{$ccbase}}) { + if( can_run( File::Spec->catfile( $ccpath, $cxx, $ccsfx ) ) ) { + $self->{config}{cxx} = File::Spec->catfile( $ccpath, $cxx, $ccsfx ); + last; + } + if( can_run( File::Spec->catfile( $cxx, $ccsfx ) ) ) { + $self->{config}{cxx} = File::Spec->catfile( $cxx, $ccsfx ); + last; + } + if( can_run( $cxx ) ) { + $self->{config}{cxx} = $cxx; + last; + } + } + unless ( exists $self->{config}{cxx} ) { + $self->{config}{cxx} = $self->{config}{cc}; + my $cflags = $self->{config}{cflags}; + $self->{config}{cxxflags} = '-x c++'; + $self->{config}{cxxflags} .= " $cflags" if defined $cflags; + } + } + return $self; } @@ -29,7 +77,7 @@ sub find_perl_interpreter { my $perl; File::Spec->file_name_is_absolute($perl = $^X) or -f ($perl = $Config::Config{perlpath}) - or ($perl = $^X); + or ($perl = $^X); # XXX how about using IPC::Cmd::can_run here? return $perl; } @@ -47,6 +95,10 @@ sub cleanup { } } +sub get_config { + return %{ $_[0]->{config} }; +} + sub object_file { my ($self, $filename) = @_; @@ -87,78 +139,81 @@ sub compile { die "Missing 'source' argument to compile()" unless defined $args{source}; my $cf = $self->{config}; # For convenience - - $args{object_file} ||= $self->object_file($args{source}); - my @include_dirs = $self->arg_include_dirs - (@{$args{include_dirs} || []}, - $self->perl_inc()); + my $object_file = $args{object_file} + ? $args{object_file} + : $self->object_file($args{source}); + + my $include_dirs_ref = + (exists($args{include_dirs}) && ref($args{include_dirs}) ne "ARRAY") + ? [ $args{include_dirs} ] + : $args{include_dirs}; + my @include_dirs = $self->arg_include_dirs( + @{ $include_dirs_ref || [] }, + $self->perl_inc(), + ); my @defines = $self->arg_defines( %{$args{defines} || {}} ); - my @extra_compiler_flags = $self->split_like_shell($args{extra_compiler_flags}); + my @extra_compiler_flags = + $self->split_like_shell($args{extra_compiler_flags}); my @cccdlflags = $self->split_like_shell($cf->{cccdlflags}); - my @ccflags = $self->split_like_shell($cf->{ccflags}); - push @ccflags, qw/-x c++/ if $args{'C++'}; + my @ccflags = $self->split_like_shell($args{'C++'} ? $cf->{cxxflags} : $cf->{ccflags}); my @optimize = $self->split_like_shell($cf->{optimize}); - my @flags = (@include_dirs, @defines, @cccdlflags, @extra_compiler_flags, - $self->arg_nolink, - @ccflags, @optimize, - $self->arg_object_file($args{object_file}), - ); - - my @cc = $self->split_like_shell($cf->{cc}); + my @flags = ( + @include_dirs, + @defines, + @cccdlflags, + @extra_compiler_flags, + $self->arg_nolink, + @ccflags, + @optimize, + $self->arg_object_file($object_file), + ); + my @cc = $self->split_like_shell($args{'C++'} ? $cf->{cxx} : $cf->{cc}); $self->do_system(@cc, @flags, $args{source}) - or die "error building $args{object_file} from '$args{source}'"; + or die "error building $object_file from '$args{source}'"; - return $args{object_file}; + return $object_file; } sub have_compiler { my ($self, $is_cplusplus) = @_; - return $self->{have_compiler} if defined $self->{have_compiler}; + my $have_compiler_flag = $is_cplusplus ? "have_cxx" : "have_cc"; + my $suffix = $is_cplusplus ? ".cc" : ".c"; + return $self->{$have_compiler_flag} if defined $self->{$have_compiler_flag}; my $result; my $attempts = 3; # tmpdir has issues for some people so fall back to current dir - DIR: for my $dir ( File::Spec->tmpdir, '.' ) { - - # don't clobber existing files (rare, but possible) - my $rand = int(rand(2**31)); - my $tmpfile = File::Spec->catfile($dir, "compilet-$rand.c"); - $tmpfile .= "c" if $is_cplusplus; - if ( -e $tmpfile ) { - redo DIR if $attempts--; - next DIR; - } - { - my $FH = IO::File->new("> $tmpfile") or die "Can't create $tmpfile: $!"; - if ( $is_cplusplus ) { - print $FH "class Bogus { public: int boot_compilet() { return 1; } };\n"; - } - else { - print $FH "int boot_compilet() { return 1; }\n"; - } - } + # don't clobber existing files (rare, but possible) + my ( $FH, $tmpfile ) = tempfile( "compilet-XXXXX", SUFFIX => $suffix ); + binmode $FH; - my ($obj_file, @lib_files); - eval { - local $^W = 0; - local $self->{quiet} = 1; - $obj_file = $self->compile('C++' => $is_cplusplus, source => $tmpfile); - @lib_files = $self->link(objects => $obj_file, module_name => 'compilet'); - }; - $result = $@ ? 0 : 1; - - foreach (grep defined, $tmpfile, $obj_file, @lib_files) { - 1 while unlink; - } - last DIR if $result; + if ( $is_cplusplus ) { + print $FH "class Bogus { public: int boot_compilet() { return 1; } };\n"; + } + else { + print $FH "int boot_compilet() { return 1; }\n"; + } + close $FH; + + my ($obj_file, @lib_files); + eval { + local $^W = 0; + local $self->{quiet} = 1; + $obj_file = $self->compile('C++' => $is_cplusplus, source => $tmpfile); + @lib_files = $self->link(objects => $obj_file, module_name => 'compilet'); + }; + $result = $@ ? 0 : 1; + + foreach (grep defined, $tmpfile, $obj_file, @lib_files) { + 1 while unlink; } - return $self->{have_compiler} = $result; + return $self->{$have_compiler_flag} = $result; } sub have_cplusplus { @@ -187,23 +242,32 @@ sub extra_link_args_after_prelink { return } sub prelink { my ($self, %args) = @_; - - ($args{dl_file} = $args{dl_name}) =~ s/.*::// unless $args{dl_file}; - + + my ($dl_file_out, $mksymlists_args) = _prepare_mksymlists_args(\%args); + require ExtUtils::Mksymlists; - ExtUtils::Mksymlists::Mksymlists( # dl. abbrev for dynamic library - DL_VARS => $args{dl_vars} || [], - DL_FUNCS => $args{dl_funcs} || {}, - FUNCLIST => $args{dl_func_list} || [], - IMPORTS => $args{dl_imports} || {}, - NAME => $args{dl_name}, # Name of the Perl module - DLBASE => $args{dl_base}, # Basename of DLL file - FILE => $args{dl_file}, # Dir + Basename of symlist file - VERSION => (defined $args{dl_version} ? $args{dl_version} : '0.0'), - ); - + # dl. abbrev for dynamic library + ExtUtils::Mksymlists::Mksymlists( %{ $mksymlists_args } ); + # Mksymlists will create one of these files - return grep -e, map "$args{dl_file}.$_", qw(ext def opt); + return grep -e, map "$dl_file_out.$_", qw(ext def opt); +} + +sub _prepare_mksymlists_args { + my $args = shift; + ($args->{dl_file} = $args->{dl_name}) =~ s/.*::// unless $args->{dl_file}; + + my %mksymlists_args = ( + DL_VARS => $args->{dl_vars} || [], + DL_FUNCS => $args->{dl_funcs} || {}, + FUNCLIST => $args->{dl_func_list} || [], + IMPORTS => $args->{dl_imports} || {}, + NAME => $args->{dl_name}, # Name of the Perl module + DLBASE => $args->{dl_base}, # Basename of DLL file + FILE => $args->{dl_file}, # Dir + Basename of symlist file + VERSION => (defined $args->{dl_version} ? $args->{dl_version} : '0.0'), + ); + return ($args->{dl_file}, \%mksymlists_args); } sub link { @@ -227,14 +291,19 @@ sub _do_link { my @temp_files; @temp_files = - $self->prelink(%args, - dl_name => $args{module_name}) if $args{lddl} && $self->need_prelink; + $self->prelink(%args, dl_name => $args{module_name}) + if $args{lddl} && $self->need_prelink; - my @linker_flags = ($self->split_like_shell($args{extra_linker_flags}), - $self->extra_link_args_after_prelink(%args, dl_name => $args{module_name}, - prelink_res => \@temp_files)); + my @linker_flags = ( + $self->split_like_shell($args{extra_linker_flags}), + $self->extra_link_args_after_prelink( + %args, dl_name => $args{module_name}, prelink_res => \@temp_files + ) + ); - my @output = $args{lddl} ? $self->arg_share_object_file($out) : $self->arg_exec_file($out); + my @output = $args{lddl} + ? $self->arg_share_object_file($out) + : $self->arg_exec_file($out); my @shrp = $self->split_like_shell($cf->{shrpenv}); my @ld = $self->split_like_shell($cf->{ld}); @@ -259,6 +328,11 @@ sub split_like_shell { $string =~ s/^\s+|\s+$//g; return () unless length($string); + # Text::ParseWords replaces all 'escaped' characters with themselves, which completely + # breaks paths under windows. As such, we forcibly replace backwards slashes with forward + # slashes on windows. + $string =~ s@\\@/@g if $^O eq 'MSWin32'; + return Text::ParseWords::shellwords($string); } @@ -275,12 +349,12 @@ sub perl_src { # Try up to 5 levels upwards for (0..10) { if ( - -f File::Spec->catfile($dir,"config_h.SH") - && - -f File::Spec->catfile($dir,"perl.h") - && - -f File::Spec->catfile($dir,"lib","Exporter.pm") - ) { + -f File::Spec->catfile($dir,"config_h.SH") + && + -f File::Spec->catfile($dir,"perl.h") + && + -f File::Spec->catfile($dir,"lib","Exporter.pm") + ) { return Cwd::realpath( $dir ); } @@ -305,3 +379,5 @@ sub DESTROY { } 1; + +# vim: ts=2 sw=2 et: diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Unix.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Unix.pm index 78ff244b5ba..c8610b3841c 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Unix.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Unix.pm @@ -4,7 +4,7 @@ use strict; use ExtUtils::CBuilder::Base; use vars qw($VERSION @ISA); -$VERSION = '0.27'; +$VERSION = '0.280203'; @ISA = qw(ExtUtils::CBuilder::Base); sub link_executable { diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/VMS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/VMS.pm index 35a2eba550b..7e3120dc008 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/VMS.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/VMS.pm @@ -4,10 +4,11 @@ use strict; use ExtUtils::CBuilder::Base; use vars qw($VERSION @ISA); -$VERSION = '0.27'; +$VERSION = '0.280203'; @ISA = qw(ExtUtils::CBuilder::Base); use File::Spec::Functions qw(catfile catdir); +use Config; # We do prelink, but don't want the parent to redo it. @@ -47,6 +48,20 @@ sub arg_include_dirs { return ('/include=(' . join(',', @dirs) . ')'); } +# We override the compile method because we consume the includes and defines +# parts of ccflags in the process of compiling but don't save those parts +# anywhere, so $self->{config}{ccflags} needs to be reset for each compile +# operation. + +sub compile { + my ($self, %args) = @_; + + $self->{config}{ccflags} = $Config{ccflags}; + $self->{config}{ccflags} = $ENV{CFLAGS} if defined $ENV{CFLAGS}; + + return $self->SUPER::compile(%args); +} + sub _do_link { my ($self, $type, %args) = @_; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm index f0b98dbaa30..6e7d52384e5 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm @@ -10,7 +10,7 @@ use ExtUtils::CBuilder::Base; use IO::File; use vars qw($VERSION @ISA); -$VERSION = '0.27'; +$VERSION = '0.280203'; @ISA = qw(ExtUtils::CBuilder::Base); =begin comment @@ -86,6 +86,9 @@ sub compile { die "Missing 'source' argument to compile()" unless defined $args{source}; + $args{include_dirs} = [ $args{include_dirs} ] + if exists($args{include_dirs}) && ref($args{include_dirs}) ne "ARRAY"; + my ($basename, $srcdir) = ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1]; @@ -98,7 +101,7 @@ sub compile { builddir => $srcdir, basename => $basename, source => $args{source}, - output => File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext}, + output => $args{object_file} || File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext}, cc => $cf->{cc}, cflags => [ $self->split_like_shell($cf->{ccflags}), diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm index ee65c91a159..46938661253 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm @@ -1,7 +1,7 @@ package ExtUtils::CBuilder::Platform::Windows::BCC; use vars qw($VERSION); -$VERSION = '0.27'; +$VERSION = '0.280203'; sub format_compiler_cmd { my ($self, %spec) = @_; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm index 132bf842bdb..afeeb7cd838 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm @@ -1,7 +1,7 @@ package ExtUtils::CBuilder::Platform::Windows::GCC; use vars qw($VERSION); -$VERSION = '0.27'; +$VERSION = '0.280203'; sub format_compiler_cmd { my ($self, %spec) = @_; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm index 7da1c9b4c12..ad0695b5ae0 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm @@ -1,7 +1,7 @@ package ExtUtils::CBuilder::Platform::Windows::MSVC; use vars qw($VERSION); -$VERSION = '0.27'; +$VERSION = '0.280203'; sub arg_exec_file { my ($self, $file) = @_; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/aix.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/aix.pm index 656e0dc67ff..358cf8516f8 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/aix.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/aix.pm @@ -5,7 +5,7 @@ use ExtUtils::CBuilder::Platform::Unix; use File::Spec; use vars qw($VERSION @ISA); -$VERSION = '0.27'; +$VERSION = '0.280203'; @ISA = qw(ExtUtils::CBuilder::Platform::Unix); sub need_prelink { 1 } diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/cygwin.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/cygwin.pm index f8650978ec4..b1069296213 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/cygwin.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/cygwin.pm @@ -5,7 +5,7 @@ use File::Spec; use ExtUtils::CBuilder::Platform::Unix; use vars qw($VERSION @ISA); -$VERSION = '0.27'; +$VERSION = '0.280203'; @ISA = qw(ExtUtils::CBuilder::Platform::Unix); # TODO: If a specific exe_file name is requested, if the exe created diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/darwin.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/darwin.pm index efc79347708..3a30e6f333b 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/darwin.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/darwin.pm @@ -4,7 +4,7 @@ use strict; use ExtUtils::CBuilder::Platform::Unix; use vars qw($VERSION @ISA); -$VERSION = '0.27'; +$VERSION = '0.280203'; @ISA = qw(ExtUtils::CBuilder::Platform::Unix); sub compile { diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/dec_osf.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/dec_osf.pm index d07b71f6d65..5d0a7fd5020 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/dec_osf.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/dec_osf.pm @@ -6,7 +6,7 @@ use File::Spec; use vars qw($VERSION @ISA); @ISA = qw(ExtUtils::CBuilder::Platform::Unix); -$VERSION = '0.27'; +$VERSION = '0.280203'; sub link_executable { my $self = shift; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/os2.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/os2.pm index 2815d587d7f..828a9571682 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/os2.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/os2.pm @@ -4,7 +4,7 @@ use strict; use ExtUtils::CBuilder::Platform::Unix; use vars qw($VERSION @ISA); -$VERSION = '0.27'; +$VERSION = '0.280203'; @ISA = qw(ExtUtils::CBuilder::Platform::Unix); sub need_prelink { 1 } diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Command.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Command.pm index b5632ff06d6..2a4d8cdc39d 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Command.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Command.pm @@ -12,7 +12,7 @@ use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); @ISA = qw(Exporter); @EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod dos2unix); -$VERSION = '1.16'; +$VERSION = '1.17'; my $Is_VMS = $^O eq 'VMS'; my $Is_VMS_mode = $Is_VMS; @@ -32,7 +32,7 @@ if( $Is_VMS ) { my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || ''; - $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; + $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; $vms_efs = $efs_charset =~ /^[ET1]/i; $vms_case = $efs_case =~ /^[ET1]/i; } @@ -97,7 +97,7 @@ sub expand_wildcards Concatenates all files mentioned on command line to STDOUT. -=cut +=cut sub cat () { @@ -111,7 +111,7 @@ sub cat () Sets modified time of destination to that of source. -=cut +=cut sub eqtime { @@ -126,7 +126,7 @@ sub eqtime Removes files and directories - recursively (even if readonly) -=cut +=cut sub rm_rf { @@ -140,7 +140,7 @@ sub rm_rf Removes files (even if readonly) -=cut +=cut sub rm_f { expand_wildcards(); @@ -173,9 +173,9 @@ sub _unlink { touch file ... -Makes files exist, with current timestamp +Makes files exist, with current timestamp -=cut +=cut sub touch { my $t = time; @@ -197,7 +197,7 @@ destination is an existing directory. Returns true if all moves succeeded, false otherwise. -=cut +=cut sub mv { expand_wildcards(); @@ -249,7 +249,7 @@ sub cp { Sets UNIX like permissions 'mode' on all the files. e.g. 0666 -=cut +=cut sub chmod { local @ARGV = @ARGV; @@ -280,7 +280,7 @@ sub chmod { Creates directories, including any parent directories. -=cut +=cut sub mkpath { @@ -295,7 +295,7 @@ sub mkpath Tests if a file exists. I<Exits> with 0 if it does, 1 if it does not (ie. shell's idea of true and false). -=cut +=cut sub test_f { @@ -337,9 +337,9 @@ sub dos2unix { my $orig = $_; my $temp = '.dos2unix_tmp'; open ORIG, $_ or do { warn "dos2unix can't open $_: $!"; return }; - open TEMP, ">$temp" or + open TEMP, ">$temp" or do { warn "dos2unix can't create .dos2unix_tmp: $!"; return }; - while (my $line = <ORIG>) { + while (my $line = <ORIG>) { $line =~ s/\015\012/\012/g; print TEMP $line; } @@ -366,4 +366,3 @@ ExtUtils-MakeMaker package and, as a separate CPAN package, by Randy Kobes C<r.kobes@uwinnipeg.ca>. =cut - diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Command/MM.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Command/MM.pm index f9b474de16f..40bf780deab 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Command/MM.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Command/MM.pm @@ -8,9 +8,9 @@ use warnings; require Exporter; our @ISA = qw(Exporter); -our @EXPORT = qw(test_harness pod2man perllocal_install uninstall +our @EXPORT = qw(test_harness pod2man perllocal_install uninstall warn_if_old_packlist); -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; my $Is_VMS = $^O eq 'VMS'; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Constant.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Constant.pm index 0a20b89b792..0dc925873dc 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Constant.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Constant.pm @@ -1,6 +1,6 @@ package ExtUtils::Constant; use vars qw (@ISA $VERSION @EXPORT_OK %EXPORT_TAGS); -$VERSION = 0.22; +$VERSION = 0.23; =head1 NAME @@ -494,6 +494,9 @@ sub WriteConstants { croak "Module name not specified" unless length $ARGS{NAME}; + # Do this before creating (empty) files, in case it fails: + require ExtUtils::Constant::ProxySubs if $ARGS{PROXYSUBS}; + my $c_fh = $ARGS{C_FH}; if (!$c_fh) { if ($] <= 5.008) { @@ -522,7 +525,6 @@ sub WriteConstants { # names. if ($ARGS{PROXYSUBS}) { - require ExtUtils::Constant::ProxySubs; $ARGS{C_FH} = $c_fh; $ARGS{XS_FH} = $xs_fh; ExtUtils::Constant::ProxySubs->WriteConstants(%ARGS); diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Base.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Base.pm index b5b79af1ea7..b6abe1c201a 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Base.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Base.pm @@ -5,7 +5,7 @@ use vars qw($VERSION); use Carp; use Text::Wrap; use ExtUtils::Constant::Utils qw(C_stringify perl_stringify); -$VERSION = '0.04'; +$VERSION = '0.05'; use constant is_perl56 => ($] < 5.007 && $] > 5.005_50); @@ -83,6 +83,18 @@ sub macro_to_ifdef { return ""; } +sub macro_to_ifndef { + my ($self, $macro) = @_; + if (ref $macro) { + # Can't invert these stylishly, so "bodge it" + return "$macro->[0]#else\n"; + } + if (defined $macro && $macro ne "" && $macro ne "1") { + return $macro ? "#ifndef $macro\n" : "#if 1\n"; + } + croak "Can't generate an ifndef for unconditional code"; +} + sub macro_to_endif { my ($self, $macro) = @_; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Constant/ProxySubs.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/ProxySubs.pm index c3fe8ed3c56..545d3221a01 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Constant/ProxySubs.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/ProxySubs.pm @@ -9,7 +9,7 @@ require ExtUtils::Constant::XS; use ExtUtils::Constant::Utils qw(C_stringify); use ExtUtils::Constant::XS qw(%XS_TypeSet); -$VERSION = '0.06'; +$VERSION = '0.08'; @ISA = 'ExtUtils::Constant::XS'; %type_to_struct = @@ -123,7 +123,7 @@ sub partition_names { } sub boottime_iterator { - my ($self, $type, $iterator, $hash, $subname) = @_; + my ($self, $type, $iterator, $hash, $subname, $push) = @_; my $extractor = $type_from_struct{$type}; die "Can't find extractor code for type $type" unless defined $extractor; @@ -133,13 +133,24 @@ sub boottime_iterator { my $athx = $self->C_constant_prefix_param(); - return sprintf <<"EOBOOT", &$generator(&$extractor($iterator)); + if ($push) { + return sprintf <<"EOBOOT", &$generator(&$extractor($iterator)); + while ($iterator->name) { + he = $subname($athx $hash, $iterator->name, + $iterator->namelen, %s); + av_push(push, newSVhek(HeKEY_hek(he))); + ++$iterator; + } +EOBOOT + } else { + return sprintf <<"EOBOOT", &$generator(&$extractor($iterator)); while ($iterator->name) { $subname($athx $hash, $iterator->name, $iterator->namelen, %s); - ++$iterator; + ++$iterator; } EOBOOT + } } sub name_len_value_macro { @@ -164,14 +175,39 @@ sub WriteConstants { my $self = shift; my $ARGS = {@_}; - my ($c_fh, $xs_fh, $c_subname, $xs_subname, $default_type, $package) - = @{$ARGS}{qw(C_FH XS_FH C_SUBNAME XS_SUBNAME DEFAULT_TYPE NAME)}; + my ($c_fh, $xs_fh, $c_subname, $default_type, $package) + = @{$ARGS}{qw(C_FH XS_FH C_SUBNAME DEFAULT_TYPE NAME)}; + + my $xs_subname + = exists $ARGS->{XS_SUBNAME} ? $ARGS->{XS_SUBNAME} : 'constant'; my $options = $ARGS->{PROXYSUBS}; $options = {} unless ref $options; + my $push = $options->{push}; my $explosives = $options->{croak_on_read}; - - $xs_subname ||= 'constant'; + my $croak_on_error = $options->{croak_on_error}; + my $autoload = $options->{autoload}; + { + my $exclusive = 0; + ++$exclusive if $explosives; + ++$exclusive if $croak_on_error; + ++$exclusive if $autoload; + + # Until someone patches this (with test cases): + carp ("PROXYSUBS options 'autoload', 'croak_on_read' and 'croak_on_error' cannot be used together") + if $exclusive > 1; + } + # Strictly it requires Perl_caller_cx + carp ("PROXYSUBS option 'croak_on_error' requires v5.13.5 or later") + if $croak_on_error && $^V < v5.13.5; + # Strictly this is actually 5.8.9, but it's not well tested there + my $can_do_pcs = $] >= 5.009; + # Until someone patches this (with test cases) + carp ("PROXYSUBS option 'push' requires v5.10 or later") + if $push && !$can_do_pcs; + # Until someone patches this (with test cases) + carp ("PROXYSUBS options 'push' and 'croak_on_read' cannot be used together") + if $explosives && $push; # If anyone is insane enough to suggest a package name containing % my $package_sprintf_safe = $package; @@ -196,12 +232,29 @@ sub WriteConstants { my $pthx = $self->C_constant_prefix_param_defintion(); my $athx = $self->C_constant_prefix_param(); my $symbol_table = C_stringify($package) . '::'; - - my $can_do_pcs = $] >= 5.009; + $push = C_stringify($package . '::' . $push) if $push; my $cast_CONSTSUB = $] < 5.010 ? '(char *)' : ''; - print $c_fh $self->header(), <<"EOADD"; -static void + print $c_fh $self->header(); + if ($autoload || $croak_on_error) { + print $c_fh <<'EOC'; + +/* This allows slightly more efficient code on !USE_ITHREADS: */ +#ifdef USE_ITHREADS +# define COP_FILE(c) CopFILE(c) +# define COP_FILE_F "s" +#else +# define COP_FILE(c) CopFILESV(c) +# define COP_FILE_F SVf +#endif +EOC + } + + my $return_type = $push ? 'HE *' : 'void'; + + print $c_fh <<"EOADD"; + +static $return_type ${c_subname}_add_symbol($pthx HV *hash, const char *name, I32 namelen, SV *value) { EOADD if (!$can_do_pcs) { @@ -210,12 +263,16 @@ EOADD EO_NOPCS } else { print $c_fh <<"EO_PCS"; - SV **sv = hv_fetch(hash, name, namelen, TRUE); - if (!sv) { + HE *he = (HE*) hv_common_key_len(hash, name, namelen, HV_FETCH_LVALUE, NULL, + 0); + SV *sv; + + if (!he) { Perl_croak($athx "Couldn't add key '%s' to %%$package_sprintf_safe\::", name); } - if (SvOK(*sv) || SvTYPE(*sv) == SVt_PVGV) { + sv = HeVAL(he); + if (SvOK(sv) || SvTYPE(sv) == SVt_PVGV) { /* Someone has been here before us - have to make a real sub. */ EO_PCS } @@ -226,9 +283,9 @@ EOADD if ($can_do_pcs) { print $c_fh <<'EO_PCS'; } else { - SvUPGRADE(*sv, SVt_RV); - SvRV_set(*sv, value); - SvROK_on(*sv); + SvUPGRADE(sv, SVt_RV); + SvRV_set(sv, value); + SvROK_on(sv); SvREADONLY_on(value); } EO_PCS @@ -237,6 +294,7 @@ EO_PCS } EO_NOPCS } + print $c_fh " return he;\n" if $push; print $c_fh <<'EOADD'; } @@ -319,10 +377,13 @@ BOOT: dTHX; #endif HV *symbol_table = get_hv("$symbol_table", GV_ADD); -#ifndef SYMBIAN - HV *${c_subname}_missing; -#endif EOBOOT + if ($push) { + print $xs_fh <<"EOC"; + AV *push = get_av(\"$push\", GV_ADD); + HE *he; +EOC + } my %iterator; @@ -336,11 +397,17 @@ EOBOOT die "Can't find structure definition for type $type" unless defined $struct; - my $struct_type = $type ? lc($type) . '_s' : 'notfound_s'; + my $lc_type = $type ? lc($type) : 'notfound'; + my $struct_type = $lc_type . '_s'; + my $array_name = 'values_for_' . $lc_type; + $iterator{$type} = 'value_for_' . $lc_type; + # Give the notfound struct file scope. The others are scoped within the + # BOOT block + my $struct_fh = $type ? $xs_fh : $c_fh; + print $c_fh "struct $struct_type $struct;\n"; - my $array_name = 'values_for_' . ($type ? lc $type : 'notfound'); - print $xs_fh <<"EOBOOT"; + print $struct_fh <<"EOBOOT"; static const struct $struct_type $array_name\[] = { @@ -356,105 +423,114 @@ EOBOOT carp("Attempting to supply a default for '$name' which has no conditional macro"); next; } - print $xs_fh $ifdef; if ($item->{invert_macro}) { - print $xs_fh - " /* This is the default value: */\n" if $type; - print $xs_fh "#else\n"; + print $struct_fh $self->macro_to_ifndef($macro); + print $struct_fh + " /* This is the default value: */\n" if $type; + } else { + print $struct_fh $ifdef; } - print $xs_fh " { ", join (', ', "\"$name\"", $namelen, - &$type_to_value($value)), " },\n", + print $struct_fh " { ", join (', ', "\"$name\"", $namelen, + &$type_to_value($value)), + " },\n", $self->macro_to_endif($macro); } - # Terminate the list with a NULL - print $xs_fh " { NULL, 0", (", 0" x $number_of_args), " } };\n"; + print $struct_fh " { NULL, 0", (", 0" x $number_of_args), " } };\n"; - $iterator{$type} = "value_for_" . ($type ? lc $type : 'notfound'); - - print $xs_fh <<"EOBOOT"; + print $xs_fh <<"EOBOOT" if $type; const struct $struct_type *$iterator{$type} = $array_name; EOBOOT } delete $found->{''}; - print $xs_fh <<"EOBOOT"; -#ifndef SYMBIAN - ${c_subname}_missing = get_missing_hash(aTHX); -#endif -EOBOOT - my $add_symbol_subname = $c_subname . '_add_symbol'; foreach my $type (sort keys %$found) { print $xs_fh $self->boottime_iterator($type, $iterator{$type}, 'symbol_table', - $add_symbol_subname); + $add_symbol_subname, $push); } print $xs_fh <<"EOBOOT"; - while (value_for_notfound->name) { + if (C_ARRAY_LENGTH(values_for_notfound) > 1) { +#ifndef SYMBIAN + HV *const ${c_subname}_missing = get_missing_hash(aTHX); +#endif + const struct notfound_s *value_for_notfound = values_for_notfound; + do { EOBOOT print $xs_fh $explosives ? <<"EXPLODE" : << "DONT"; - SV *tripwire = newSV(0); - - sv_magicext(tripwire, 0, PERL_MAGIC_ext, ¬_defined_vtbl, 0, 0); - SvPV_set(tripwire, (char *)value_for_notfound->name); - if(value_for_notfound->namelen >= 0) { - SvCUR_set(tripwire, value_for_notfound->namelen); - } else { - SvCUR_set(tripwire, -value_for_notfound->namelen); - SvUTF8_on(tripwire); - } - SvPOKp_on(tripwire); - SvREADONLY_on(tripwire); - assert(SvLEN(tripwire) == 0); - - $add_symbol_subname($athx symbol_table, value_for_notfound->name, - value_for_notfound->namelen, tripwire); + SV *tripwire = newSV(0); + + sv_magicext(tripwire, 0, PERL_MAGIC_ext, ¬_defined_vtbl, 0, 0); + SvPV_set(tripwire, (char *)value_for_notfound->name); + if(value_for_notfound->namelen >= 0) { + SvCUR_set(tripwire, value_for_notfound->namelen); + } else { + SvCUR_set(tripwire, -value_for_notfound->namelen); + SvUTF8_on(tripwire); + } + SvPOKp_on(tripwire); + SvREADONLY_on(tripwire); + assert(SvLEN(tripwire) == 0); + + $add_symbol_subname($athx symbol_table, value_for_notfound->name, + value_for_notfound->namelen, tripwire); EXPLODE - /* Need to add prototypes, else parsing will vary by platform. */ - SV **sv = hv_fetch(symbol_table, value_for_notfound->name, - value_for_notfound->namelen, TRUE); - if (!sv) { - Perl_croak($athx - "Couldn't add key '%s' to %%$package_sprintf_safe\::", - value_for_notfound->name); - } - if (!SvOK(*sv) && SvTYPE(*sv) != SVt_PVGV) { - /* Nothing was here before, so mark a prototype of "" */ - sv_setpvn(*sv, "", 0); - } else if (SvPOK(*sv) && SvCUR(*sv) == 0) { - /* There is already a prototype of "" - do nothing */ - } else { - /* Someone has been here before us - have to make a real - typeglob. */ - /* It turns out to be incredibly hard to deal with all the - corner cases of sub foo (); and reporting errors correctly, - so lets cheat a bit. Start with a constant subroutine */ - CV *cv = newCONSTSUB(symbol_table, - ${cast_CONSTSUB}value_for_notfound->name, - &PL_sv_yes); - /* and then turn it into a non constant declaration only. */ - SvREFCNT_dec(CvXSUBANY(cv).any_ptr); - CvCONST_off(cv); - CvXSUB(cv) = NULL; - CvXSUBANY(cv).any_ptr = NULL; - } + /* Need to add prototypes, else parsing will vary by platform. */ + HE *he = (HE*) hv_common_key_len(symbol_table, + value_for_notfound->name, + value_for_notfound->namelen, + HV_FETCH_LVALUE, NULL, 0); + SV *sv; +#ifndef SYMBIAN + HEK *hek; +#endif + if (!he) { + Perl_croak($athx + "Couldn't add key '%s' to %%$package_sprintf_safe\::", + value_for_notfound->name); + } + sv = HeVAL(he); + if (!SvOK(sv) && SvTYPE(sv) != SVt_PVGV) { + /* Nothing was here before, so mark a prototype of "" */ + sv_setpvn(sv, "", 0); + } else if (SvPOK(sv) && SvCUR(sv) == 0) { + /* There is already a prototype of "" - do nothing */ + } else { + /* Someone has been here before us - have to make a real + typeglob. */ + /* It turns out to be incredibly hard to deal with all the + corner cases of sub foo (); and reporting errors correctly, + so lets cheat a bit. Start with a constant subroutine */ + CV *cv = newCONSTSUB(symbol_table, + ${cast_CONSTSUB}value_for_notfound->name, + &PL_sv_yes); + /* and then turn it into a non constant declaration only. */ + SvREFCNT_dec(CvXSUBANY(cv).any_ptr); + CvCONST_off(cv); + CvXSUB(cv) = NULL; + CvXSUBANY(cv).any_ptr = NULL; + } #ifndef SYMBIAN - if (!hv_store(${c_subname}_missing, value_for_notfound->name, - value_for_notfound->namelen, &PL_sv_yes, 0)) - Perl_croak($athx "Couldn't add key '%s' to missing_hash", - value_for_notfound->name); + hek = HeKEY_hek(he); + if (!hv_common(${c_subname}_missing, NULL, HEK_KEY(hek), + HEK_LEN(hek), HEK_FLAGS(hek), HV_FETCH_ISSTORE, + &PL_sv_yes, HEK_HASH(hek))) + Perl_croak($athx "Couldn't add key '%s' to missing_hash", + value_for_notfound->name); #endif DONT - print $xs_fh <<"EOBOOT"; + print $xs_fh " av_push(push, newSVhek(hek));\n" + if $push; - ++value_for_notfound; + print $xs_fh <<"EOBOOT"; + } while ((++value_for_notfound)->name); } EOBOOT @@ -502,14 +578,69 @@ EOBOOT print $xs_fh $self->macro_to_endif($macro); } - print $xs_fh <<EOBOOT; + if ($] >= 5.009) { + print $xs_fh <<EOBOOT; + /* As we've been creating subroutines, we better invalidate any cached + methods */ + mro_method_changed_in(symbol_table); + } +EOBOOT + } else { + print $xs_fh <<EOBOOT; /* As we've been creating subroutines, we better invalidate any cached methods */ ++PL_sub_generation; } EOBOOT + } - print $xs_fh $explosives ? <<"EXPLODE" : <<"DONT"; + return if !defined $xs_subname; + + if ($croak_on_error || $autoload) { + print $xs_fh $croak_on_error ? <<"EOC" : <<'EOA'; + +void +$xs_subname(sv) + INPUT: + SV * sv; + PREINIT: + const PERL_CONTEXT *cx = caller_cx(0, NULL); + /* cx is NULL if we've been called from the top level. PL_curcop isn't + ideal, but it's much cheaper than other ways of not going SEGV. */ + const COP *cop = cx ? cx->blk_oldcop : PL_curcop; +EOC + +void +AUTOLOAD() + PROTOTYPE: DISABLE + PREINIT: + SV *sv = newSVpvn_flags(SvPVX(cv), SvCUR(cv), SVs_TEMP | SvUTF8(cv)); + const COP *cop = PL_curcop; +EOA + print $xs_fh <<"EOC"; + PPCODE: +#ifndef SYMBIAN + /* It's not obvious how to calculate this at C pre-processor time. + However, any compiler optimiser worth its salt should be able to + remove the dead code, and hopefully the now-obviously-unused static + function too. */ + HV *${c_subname}_missing = (C_ARRAY_LENGTH(values_for_notfound) > 1) + ? get_missing_hash(aTHX) : NULL; + if ((C_ARRAY_LENGTH(values_for_notfound) > 1) + ? hv_exists_ent(${c_subname}_missing, sv, 0) : 0) { + sv = newSVpvf("Your vendor has not defined $package_sprintf_safe macro %" SVf + ", used at %" COP_FILE_F " line %d\\n", sv, + COP_FILE(cop), CopLINE(cop)); + } else +#endif + { + sv = newSVpvf("%"SVf" is not a valid $package_sprintf_safe macro at %" + COP_FILE_F " line %d\\n", sv, COP_FILE(cop), CopLINE(cop)); + } + croak_sv(sv_2mortal(sv)); +EOC + } else { + print $xs_fh $explosives ? <<"EXPLODE" : <<"DONT"; void $xs_subname(sv) @@ -523,27 +654,29 @@ EXPLODE void $xs_subname(sv) - PREINIT: - STRLEN len; INPUT: SV * sv; - const char * s = SvPV(sv, len); PPCODE: -#ifdef SYMBIAN - sv = newSVpvf("%"SVf" is not a valid $package_sprintf_safe macro", sv); -#else - HV *${c_subname}_missing = get_missing_hash(aTHX); - if (hv_exists(${c_subname}_missing, s, SvUTF8(sv) ? -(I32)len : (I32)len)) { +#ifndef SYMBIAN + /* It's not obvious how to calculate this at C pre-processor time. + However, any compiler optimiser worth its salt should be able to + remove the dead code, and hopefully the now-obviously-unused static + function too. */ + HV *${c_subname}_missing = (C_ARRAY_LENGTH(values_for_notfound) > 1) + ? get_missing_hash(aTHX) : NULL; + if ((C_ARRAY_LENGTH(values_for_notfound) > 1) + ? hv_exists_ent(${c_subname}_missing, sv, 0) : 0) { sv = newSVpvf("Your vendor has not defined $package_sprintf_safe macro %" SVf ", used", sv); - } else { + } else +#endif + { sv = newSVpvf("%"SVf" is not a valid $package_sprintf_safe macro", sv); } -#endif PUSHs(sv_2mortal(sv)); DONT - + } } 1; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Utils.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Utils.pm index 016507c72a6..9608256c34c 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Utils.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Constant/Utils.pm @@ -1,14 +1,16 @@ package ExtUtils::Constant::Utils; use strict; -use vars qw($VERSION @EXPORT_OK @ISA $is_perl56); +use vars qw($VERSION @EXPORT_OK @ISA); use Carp; @ISA = 'Exporter'; @EXPORT_OK = qw(C_stringify perl_stringify); -$VERSION = '0.02'; +$VERSION = '0.03'; -$is_perl56 = ($] < 5.007 && $] > 5.005_50); +use constant is_perl55 => ($] < 5.005_50); +use constant is_perl56 => ($] < 5.007 && $] > 5.005_50); +use constant is_sane_perl => $] > 5.007; =head1 NAME @@ -46,7 +48,7 @@ sub C_stringify { if tr/\0-\377// != length; # grr 5.6.1 moreso because its regexps will break on data that happens to # be utf8, which includes my 8 bit test cases. - $_ = pack 'C*', unpack 'U*', $_ . pack 'U*' if $is_perl56; + $_ = pack 'C*', unpack 'U*', $_ . pack 'U*' if is_perl56; s/\\/\\\\/g; s/([\"\'])/\\$1/g; # Grr. fix perl mode. s/\n/\\n/g; # Ensure newlines don't end up in octal @@ -54,15 +56,17 @@ sub C_stringify { s/\t/\\t/g; s/\f/\\f/g; s/\a/\\a/g; - if (ord('A') == 193) { # EBCDIC has no ^\0-\177 workalike. - s/([[:^print:]])/sprintf "\\%03o", ord $1/ge; - } else { - s/([^\0-\177])/sprintf "\\%03o", ord $1/ge; - } - unless ($] < 5.006) { + unless (is_perl55) { # This will elicit a warning on 5.005_03 about [: :] being reserved unless # I cheat my $cheat = '([[:^print:]])'; + + if (ord('A') == 193) { # EBCDIC has no ^\0-\177 workalike. + s/$cheat/sprintf "\\%03o", ord $1/ge; + } else { + s/([^\0-\177])/sprintf "\\%03o", ord $1/ge; + } + s/$cheat/sprintf "\\%03o", ord $1/ge; } else { require POSIX; @@ -89,10 +93,13 @@ sub perl_stringify { s/\t/\\t/g; s/\f/\\f/g; s/\a/\\a/g; - unless ($] < 5.006) { - if ($] > 5.007) { + unless (is_perl55) { + # This will elicit a warning on 5.005_03 about [: :] being reserved unless + # I cheat + my $cheat = '([[:^print:]])'; + if (is_sane_perl) { if (ord('A') == 193) { # EBCDIC has no ^\0-\177 workalike. - s/([[:^print:]])/sprintf "\\x{%X}", ord $1/ge; + s/$cheat/sprintf "\\x{%X}", ord $1/ge; } else { s/([^\0-\177])/sprintf "\\x{%X}", ord $1/ge; } @@ -107,9 +114,6 @@ sub perl_stringify { } $_ = $copy; } - # This will elicit a warning on 5.005_03 about [: :] being reserved unless - # I cheat - my $cheat = '([[:^print:]])'; s/$cheat/sprintf "\\%03o", ord $1/ge; } else { # Turns out "\x{}" notation only arrived with 5.6 diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Embed.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Embed.pm index 24ae9092f52..9710630e515 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Embed.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Embed.pm @@ -1,4 +1,3 @@ -# $Id: Embed.pm,v 1.1.1.1 2002/01/16 19:27:19 schwern Exp $ require 5.002; package ExtUtils::Embed; @@ -19,7 +18,7 @@ use vars qw(@ISA @EXPORT $VERSION use strict; # This is not a dual-life module, so no need for development version numbers -$VERSION = '1.28'; +$VERSION = '1.30'; @ISA = qw(Exporter); @EXPORT = qw(&xsinit &ldopts @@ -144,6 +143,7 @@ sub static_ext { sub _escape { my $arg = shift; + return $$arg if $^O eq 'VMS'; # parens legal in qualifier lists $$arg =~ s/([\(\)])/\\$1/g; } diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Install.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Install.pm index da583650fdf..3b030a511af 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Install.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Install.pm @@ -42,7 +42,7 @@ ExtUtils::Install - install files from here to there =cut -$VERSION = '1.55'; # <---- dont forget to update the POD section just above this line! +$VERSION = '1.56'; # <---- dont forget to update the POD section just above this line! $VERSION = eval $VERSION; =pod @@ -297,7 +297,7 @@ sub _unlink_or_rename { #XXX OS-SPECIFIC "Going to try to rename it to '$tmp'.\n"; if ( rename $file, $tmp ) { - warn "Rename succesful. Scheduling '$tmp'\nfor deletion at reboot.\n"; + warn "Rename successful. Scheduling '$tmp'\nfor deletion at reboot.\n"; # when $installing we can set $moan to true. # IOW, if we cant delete the renamed file at reboot its # not the end of the world. The other cases are more serious @@ -310,7 +310,7 @@ sub _unlink_or_rename { #XXX OS-SPECIFIC _move_file_at_boot( $tmp, $file ); return $tmp; } else { - _choke("Rename failed:$!", "Cannot procede."); + _choke("Rename failed:$!", "Cannot proceed."); } } @@ -520,7 +520,7 @@ sub _mkpath { Wrapper around File::Copy::copy to handle errors. -If $verbose is true and >1 then additional dignostics will be emitted. +If $verbose is true and >1 then additional diagnostics will be emitted. If $dry_run is true then the copy will not actually occur. @@ -790,7 +790,7 @@ sub install { #XXX OS-SPECIFIC ]; #restore the original directory we were in when File::Find - #called us so that it doesnt get horribly confused. + #called us so that it doesn't get horribly confused. _chdir($save_cwd); }, $current_directory ); _chdir($cwd); @@ -1056,7 +1056,7 @@ sub uninstall { Remove shadowed files. If $ignore is true then it is assumed to hold a filename to ignore. This is used to prevent spurious warnings from -occuring when doing an install at reboot. +occurring when doing an install at reboot. We now only die when failing to remove a file that has precedence over our own, when our install has precedence we only warn. diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Liblist.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Liblist.pm index ea4dac4ae7c..2184c4a6d7d 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Liblist.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Liblist.pm @@ -2,7 +2,7 @@ package ExtUtils::Liblist; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; use File::Spec; require ExtUtils::Liblist::Kid; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Liblist/Kid.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Liblist/Kid.pm index b807e97cc86..cf4826fe36f 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Liblist/Kid.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Liblist/Kid.pm @@ -9,7 +9,7 @@ use 5.006; # Broken out of MakeMaker from version 4.11 use strict; -our $VERSION = 6.56; +our $VERSION = 6.57_05; use Config; use Cwd 'cwd'; @@ -39,6 +39,7 @@ sub _unix_os2_ext { my($so) = $Config{so}; my($libs) = defined $Config{perllibs} ? $Config{perllibs} : $Config{libs}; my $Config_libext = $Config{lib_ext} || ".a"; + my $Config_dlext = $Config{dlext}; # compute $extralibs, $bsloadlibs and $ldloadlibs from @@ -130,8 +131,10 @@ sub _unix_os2_ext { && ($Config{'archname'} !~ /RM\d\d\d-svr4/) && ($thislib .= "_s") ){ # we must explicitly use _s version } elsif (-f ($fullname="$thispth/lib$thislib$Config_libext")){ + } elsif (defined($Config_dlext) + && -f ($fullname="$thispth/lib$thislib.$Config_dlext")){ } elsif (-f ($fullname="$thispth/$thislib$Config_libext")){ - } elsif (-f ($fullname="$thispth/lib$thislib.dll$Config_libext")){ + } elsif (-f ($fullname="$thispth/lib$thislib.dll$Config_libext")){ } elsif (-f ($fullname="$thispth/Slib$thislib$Config_libext")){ } elsif ($^O eq 'dgux' && -l ($fullname="$thispth/lib$thislib$Config_libext") diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MANIFEST.SKIP b/Master/tlpkg/tlperl/lib/ExtUtils/MANIFEST.SKIP index e50a7b390f7..bea687450f3 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MANIFEST.SKIP +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MANIFEST.SKIP @@ -47,5 +47,9 @@ # Mac OSX SMB mount metadata files \B\._ -# Avoid Devel::Cover files. +# Avoid Devel::Cover and Devel::CoverX::Covered files. \bcover_db\b +\bcovered\b + +# Avoid MYMETA files +^MYMETA\. diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM.pm index eac5f483494..945f24513b7 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM.pm @@ -3,7 +3,7 @@ package ExtUtils::MM; use strict; use ExtUtils::MakeMaker::Config; -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; require ExtUtils::Liblist; require ExtUtils::MakeMaker; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_AIX.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_AIX.pm index 5179be4bc2a..021238523e1 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_AIX.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_AIX.pm @@ -1,7 +1,7 @@ package ExtUtils::MM_AIX; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Any.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Any.pm index 4905aebc642..a38f2740f7f 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Any.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Any.pm @@ -1,7 +1,7 @@ package ExtUtils::MM_Any; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; use Carp; use File::Spec; @@ -486,8 +486,8 @@ clean :: clean_subdirs split /\s+/, $attribs{FILES} ; } - push(@files, qw[$(MAKE_APERL_FILE) - perlmain.c tmon.out mon.out so_locations + push(@files, qw[$(MAKE_APERL_FILE) + MYMETA.yml perlmain.c tmon.out mon.out so_locations blibdirs.ts pm_to_blib pm_to_blib.ts *$(OBJ_EXT) *$(LIB_EXT) perl.exe perl perl$(EXE_EXT) $(BOOTSTRAP) $(BASEEXT).bso @@ -880,7 +880,7 @@ sub metafile_data { ); # The author key is required and it takes a list. - $meta{author} = defined $self->{AUTHOR} ? [$self->{AUTHOR}] : []; + $meta{author} = defined $self->{AUTHOR} ? $self->{AUTHOR} : []; $meta{requires} = $self->{PREREQ_PM} if defined $self->{PREREQ_PM}; $meta{requires}{perl} = $self->{MIN_PERL_VERSION} if $self->{MIN_PERL_VERSION}; @@ -984,7 +984,7 @@ sub _dump_hash { ); if (exists $customs->{$key}) { my %k_custom = %{$customs->{$key}}; - foreach my $k qw(key_sort max_key_length customs) { + foreach my $k (qw(key_sort max_key_length customs)) { $k_options{$k} = $k_custom{$k} if exists $k_custom{$k}; } } @@ -1085,6 +1085,99 @@ MAKE } +=head3 mymeta + + my $mymeta = $mm->mymeta; + +Generate MYMETA information as a hash either from an existing META.yml +or from internal data. + +=cut + +sub mymeta { + my $self = shift; + + my $mymeta; + + if ( -e 'META.yml' ) { + $mymeta = $self->_mymeta_from_meta(); + } + + unless ( $mymeta ) { + my @metadata = $self->metafile_data( + $self->{META_ADD} || {}, + $self->{META_MERGE} || {}, + ); + $mymeta = {@metadata}; + } + + $mymeta->{dynamic_config} = 0; + + return $mymeta; +} + + +sub _mymeta_from_meta { + my $self = shift; + + my $meta; + eval { + my @yaml = ExtUtils::MakeMaker::YAML::LoadFile('META.yml'); + $meta = $yaml[0]; + }; + return undef unless $meta; + + # META.yml before 6.25_01 cannot be trusted. META.yml lived in the source directory. + # There was a good chance the author accidentally uploaded a stale META.yml if they + # rolled their own tarball rather than using "make dist". + if ($meta->{generated_by} && + $meta->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) { + my $eummv = do { local $^W = 0; $1+0; }; + if ($eummv < 6.2501) { + return undef; + } + } + + # Overwrite the non-configure dependency hashs + delete $meta->{requires}; + delete $meta->{build_requires}; + delete $meta->{recommends}; + if ( exists $self->{PREREQ_PM} ) { + $meta->{requires} = $self->{PREREQ_PM} || {}; + } + if ( exists $self->{BUILD_REQUIRES} ) { + $meta->{build_requires} = $self->{BUILD_REQUIRES} || {}; + } + return $meta; +} + + +=head3 write_mymeta + + $self->write_mymeta( $mymeta ); + +Write MYMETA information to MYMETA.yml. + +This will probably be refactored into a more generic YAML dumping method. + +=cut + +sub write_mymeta { + my $self = shift; + my $mymeta = shift; + + require ExtUtils::MakeMaker::YAML; + my $mymeta_content = ExtUtils::MakeMaker::YAML::Dump($mymeta); + + open(my $myfh, ">", "MYMETA.yml") + or die "Unable to open MYMETA.yml: $!"; + print $myfh $mymeta_content; + close $myfh; + + return; +} + + =head3 realclean (o) Defines the realclean target. diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_BeOS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_BeOS.pm index 0b7c8db9225..0eeb795e485 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_BeOS.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_BeOS.pm @@ -26,7 +26,7 @@ require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; =item os_flavor diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Cygwin.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Cygwin.pm index 394fbc68a75..d6ce3a7d68c 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Cygwin.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Cygwin.pm @@ -9,7 +9,7 @@ require ExtUtils::MM_Unix; require ExtUtils::MM_Win32; our @ISA = qw( ExtUtils::MM_Unix ); -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; =head1 NAME @@ -116,6 +116,39 @@ sub maybe_command { return $self->SUPER::maybe_command($file); } +=item dynamic_lib + +Use the default to produce the *.dll's. +But for new archdir dll's use the same rebase address if the old exists. + +=cut + +sub dynamic_lib { + my($self, %attribs) = @_; + my $s = ExtUtils::MM_Unix::dynamic_lib($self, %attribs); + my $ori = "$self->{INSTALLARCHLIB}/auto/$self->{FULLEXT}/$self->{BASEEXT}.$self->{DLEXT}"; + if (-e $ori) { + my $imagebase = `/bin/objdump -p $ori | /bin/grep ImageBase | /bin/cut -c12-`; + chomp $imagebase; + if ($imagebase gt "40000000") { + my $LDDLFLAGS = $self->{LDDLFLAGS}; + $LDDLFLAGS =~ s/-Wl,--enable-auto-image-base/-Wl,--image-base=0x$imagebase/; + $s =~ s/ \$\(LDDLFLAGS\) / $LDDLFLAGS /m; + } + } + $s; +} + +=item all_target + +Build man pages, too + +=cut + +sub all_target { + ExtUtils::MM_Unix::all_target(shift); +} + =back =cut diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_DOS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_DOS.pm index fc0a7947235..68612a80acd 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_DOS.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_DOS.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_DOS; use strict; -our $VERSION = 6.56; +our $VERSION = 6.57_05; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Darwin.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Darwin.pm index 1cb87c78815..20aeb791642 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Darwin.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Darwin.pm @@ -7,7 +7,7 @@ BEGIN { our @ISA = qw( ExtUtils::MM_Unix ); } -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; =head1 NAME diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_MacOS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_MacOS.pm index cfc82051e1b..4dcb6e55ec0 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_MacOS.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_MacOS.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_MacOS; use strict; -our $VERSION = 6.56; +our $VERSION = 6.57_05; sub new { die <<'UNSUPPORTED'; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_NW5.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_NW5.pm index 0c8f6c0affb..2089e8f88c2 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_NW5.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_NW5.pm @@ -22,7 +22,7 @@ use strict; use ExtUtils::MakeMaker::Config; use File::Basename; -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; require ExtUtils::MM_Win32; our @ISA = qw(ExtUtils::MM_Win32); diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_OS2.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_OS2.pm index 680502baf24..46d57be2933 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_OS2.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_OS2.pm @@ -5,7 +5,7 @@ use strict; use ExtUtils::MakeMaker qw(neatvalue); use File::Spec; -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_QNX.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_QNX.pm index f78d5e8a9ee..5efd3771f39 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_QNX.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_QNX.pm @@ -1,7 +1,7 @@ package ExtUtils::MM_QNX; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_UWIN.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_UWIN.pm index 5adc46ea8d2..032bf35b84b 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_UWIN.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_UWIN.pm @@ -1,7 +1,7 @@ package ExtUtils::MM_UWIN; use strict; -our $VERSION = 6.56; +our $VERSION = 6.57_05; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Unix.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Unix.pm index 239d6df826c..6964eea0883 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Unix.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Unix.pm @@ -15,7 +15,7 @@ use ExtUtils::MakeMaker qw($Verbose neatvalue); # If we make $VERSION an our variable parse_version() breaks use vars qw($VERSION); -$VERSION = '6.56'; +$VERSION = '6.57_05'; require ExtUtils::MM_Any; our @ISA = qw(ExtUtils::MM_Any); @@ -1079,7 +1079,6 @@ Inserts the sharpbang or equivalent magic number to a set of @files. sub fixin { # stolen from the pink Camel book, more or less my ( $self, @files ) = @_; - my ($does_shbang) = $Config{'sharpbang'} =~ /^\s*\#\!/; for my $file (@files) { my $file_new = "$file.new"; my $file_bak = "$file.bak"; @@ -1088,58 +1087,9 @@ sub fixin { # stolen from the pink Camel book, more or less local $/ = "\n"; chomp( my $line = <$fixin> ); next unless $line =~ s/^\s*\#!\s*//; # Not a shbang file. - # Now figure out the interpreter name. - my ( $cmd, $arg ) = split ' ', $line, 2; - $cmd =~ s!^.*/!!; - - # Now look (in reverse) for interpreter in absolute PATH (unless perl). - my $interpreter; - if ( $cmd =~ m{^perl(?:\z|[^a-z])} ) { - if ( $Config{startperl} =~ m,^\#!.*/perl, ) { - $interpreter = $Config{startperl}; - $interpreter =~ s,^\#!,,; - } - else { - $interpreter = $Config{perlpath}; - } - } - else { - my (@absdirs) - = reverse grep { $self->file_name_is_absolute($_) } $self->path; - $interpreter = ''; - - foreach my $dir (@absdirs) { - if ( $self->maybe_command($cmd) ) { - warn "Ignoring $interpreter in $file\n" - if $Verbose && $interpreter; - $interpreter = $self->catfile( $dir, $cmd ); - } - } - } - - # Figure out how to invoke interpreter on this machine. - my ($shb) = ""; - if ($interpreter) { - print STDOUT "Changing sharpbang in $file to $interpreter" - if $Verbose; - - # this is probably value-free on DOSISH platforms - if ($does_shbang) { - $shb .= "$Config{'sharpbang'}$interpreter"; - $shb .= ' ' . $arg if defined $arg; - $shb .= "\n"; - } - $shb .= qq{ -eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' - if 0; # not running under some shell -} unless $Is{Win32}; # this won't work on win32, so don't - } - else { - warn "Can't find $cmd in PATH, $file unchanged" - if $Verbose; - next; - } + my $shb = $self->_fixin_replace_shebang( $file, $line ); + next unless defined $shb; open( my $fixout, ">", "$file_new" ) or do { warn "Can't create new $file: $!\n"; @@ -1189,6 +1139,63 @@ sub _rename { return rename($old, $new); } +sub _fixin_replace_shebang { + my ( $self, $file, $line ) = @_; + + # Now figure out the interpreter name. + my ( $cmd, $arg ) = split ' ', $line, 2; + $cmd =~ s!^.*/!!; + + # Now look (in reverse) for interpreter in absolute PATH (unless perl). + my $interpreter; + if ( $cmd =~ m{^perl(?:\z|[^a-z])} ) { + if ( $Config{startperl} =~ m,^\#!.*/perl, ) { + $interpreter = $Config{startperl}; + $interpreter =~ s,^\#!,,; + } + else { + $interpreter = $Config{perlpath}; + } + } + else { + my (@absdirs) + = reverse grep { $self->file_name_is_absolute($_) } $self->path; + $interpreter = ''; + + foreach my $dir (@absdirs) { + if ( $self->maybe_command($cmd) ) { + warn "Ignoring $interpreter in $file\n" + if $Verbose && $interpreter; + $interpreter = $self->catfile( $dir, $cmd ); + } + } + } + + # Figure out how to invoke interpreter on this machine. + + my ($does_shbang) = $Config{'sharpbang'} =~ /^\s*\#\!/; + my ($shb) = ""; + if ($interpreter) { + print STDOUT "Changing sharpbang in $file to $interpreter" + if $Verbose; + # this is probably value-free on DOSISH platforms + if ($does_shbang) { + $shb .= "$Config{'sharpbang'}$interpreter"; + $shb .= ' ' . $arg if defined $arg; + $shb .= "\n"; + } + $shb .= qq{ +eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' + if 0; # not running under some shell +} unless $Is{Win32}; # this won't work on win32, so don't + } + else { + warn "Can't find $cmd in PATH, $file unchanged" + if $Verbose; + return undef; + } + return $shb +} =item force (o) @@ -2593,7 +2600,7 @@ sub parse_abstract { $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; next if !$inpod; chop; - next unless /^($package\s-\s)(.*)/; + next unless /^($package(?:\.pm)? \s+ -+ \s+)(.*)/x; $result = $2; last; } @@ -2634,7 +2641,7 @@ sub parse_version { $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; next if $inpod || /^\s*#/; chop; - next if /^\s*(if|unless)/; + next if /^\s*(if|unless|elsif)/; if ( m{^ \s* package \s+ \w[\w\:\']* \s+ (v?[0-9._]+) \s* ; }x ) { local $^W = 0; $result = $1; @@ -2754,7 +2761,6 @@ PERL_HDRS = \ $(PERL_INC)/INTERN.h \ $(PERL_INC)/XSUB.h \ $(PERL_INC)/av.h \ - $(PERL_INC)/cc_runtime.h \ $(PERL_INC)/config.h \ $(PERL_INC)/cop.h \ $(PERL_INC)/cv.h \ @@ -2884,7 +2890,7 @@ sub ppd { $abstract =~ s/</</g; $abstract =~ s/>/>/g; - my $author = $self->{AUTHOR} || ''; + my $author = join(', ',@{$self->{AUTHOR} || []}); $author =~ s/</</g; $author =~ s/>/>/g; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm index 2066d035976..d6b63eba63f 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm @@ -15,7 +15,7 @@ BEGIN { use File::Basename; -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; @@ -248,6 +248,23 @@ sub find_perl { 0; # false and not empty } +=item _fixin_replace_shebang (override) + +Helper routine for MM->fixin(), overridden because there's no such thing as an +actual shebang line that will be intepreted by the shell, so we just prepend +$Config{startperl} and preserve the shebang line argument for any switches it +may contain. + +=cut + +sub _fixin_replace_shebang { + my ( $self, $file, $line ) = @_; + + my ( undef, $arg ) = split ' ', $line, 2; + + return $Config{startperl} . "\n" . $Config{sharpbang} . "perl $arg\n"; +} + =item maybe_command (override) Follows VMS naming conventions for executable files. @@ -1067,14 +1084,14 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) =item extra_clean_files Clean up some OS specific files. Plus the temp file used to shorten -a lot of commands. +a lot of commands. And the name mangler database. =cut sub extra_clean_files { return qw( *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *.Opt $(BASEEXT).bso - .MM_Tmp + .MM_Tmp cxx_repository ); } @@ -1265,7 +1282,7 @@ sub perldepend { push @m, ' $(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h -$(OBJECT) : $(PERL_INC)av.h, $(PERL_INC)cc_runtime.h, $(PERL_INC)config.h +$(OBJECT) : $(PERL_INC)av.h, $(PERL_INC)config.h $(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h $(OBJECT) : $(PERL_INC)embedvar.h, $(PERL_INC)form.h $(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_VOS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VOS.pm index 1814a1dae4c..e5b60d78e38 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_VOS.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VOS.pm @@ -1,7 +1,7 @@ package ExtUtils::MM_VOS; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win32.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win32.pm index 19e462de593..faaf219ecba 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win32.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win32.pm @@ -27,7 +27,7 @@ use ExtUtils::MakeMaker qw( neatvalue ); require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; $ENV{EMXSHELL} = 'sh'; # to run `commands` @@ -289,17 +289,6 @@ sub dynamic_lib { my($ldfrom) = '$(LDFROM)'; my(@m); -# one thing for GCC/Mingw32: -# we try to overcome non-relocateable-DLL problems by generating -# a (hopefully unique) image-base from the dll's name -# -- BKS, 10-19-1999 - if ($GCC) { - my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT}; - $dllname =~ /(....)(.{0,4})/; - my $baseaddr = unpack("n", $1 ^ $2); - $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr); - } - push(@m,' # This section creates the dynamically loadable $(INST_DYNAMIC) # from $(OBJECT) and possibly $(MYEXTLIB). diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win95.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win95.pm index c47147695e8..19f5c7d61ed 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win95.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win95.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_Win95; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; require ExtUtils::MM_Win32; our @ISA = qw(ExtUtils::MM_Win32); diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MY.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MY.pm index bed177d210a..464f814f0f7 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MY.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MY.pm @@ -3,7 +3,7 @@ package ExtUtils::MY; use strict; require ExtUtils::MM; -our $VERSION = 6.56; +our $VERSION = 6.57_05; our @ISA = qw(ExtUtils::MM); { diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker.pm index 4422b686ce7..be9624e389e 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker.pm @@ -18,7 +18,7 @@ our @Overridable; my @Prepend_parent; my %Recognized_Att_Keys; -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; # Emulate something resembling CVS $Revision$ (our $Revision = $VERSION) =~ s{_}{}; @@ -52,6 +52,8 @@ sub WriteMakefile { require ExtUtils::MY; my %att = @_; + _convert_compat_attrs(\%att); + _verify_att(\%att); my $mm = MM->new(\%att); @@ -66,6 +68,7 @@ sub WriteMakefile { # scalar. my %Att_Sigs; my %Special_Sigs = ( + AUTHOR => 'ARRAY', C => 'ARRAY', CONFIG => 'ARRAY', CONFIGURE => 'CODE', @@ -111,6 +114,19 @@ my %Special_Sigs = ( @Att_Sigs{keys %Recognized_Att_Keys} = ('') x keys %Recognized_Att_Keys; @Att_Sigs{keys %Special_Sigs} = values %Special_Sigs; +sub _convert_compat_attrs { + my($att) = @_; + if (exists $att->{AUTHOR}) { + if ($att->{AUTHOR}) { + if (!ref($att->{AUTHOR})) { + my $t = $att->{AUTHOR}; + $att->{AUTHOR} = [$t]; + } + } else { + $att->{AUTHOR} = []; + } + } +} sub _verify_att { my($att) = @_; @@ -257,8 +273,8 @@ sub full_setup { INC INCLUDE_EXT LDFROM LIB LIBPERL_A LIBS LICENSE LINKTYPE MAKE MAKEAPERL MAKEFILE MAKEFILE_OLD MAN1PODS MAN3PODS MAP_TARGET META_ADD META_MERGE MIN_PERL_VERSION BUILD_REQUIRES CONFIGURE_REQUIRES - MYEXTLIB NAME NEEDS_LINKING NOECHO NO_META NORECURS NO_VC OBJECT OPTIMIZE - PERL_MALLOC_OK PERL PERLMAINCC PERLRUN PERLRUNINST PERL_CORE + MYEXTLIB NAME NEEDS_LINKING NOECHO NO_META NO_MYMETA NORECURS NO_VC OBJECT + OPTIMIZE PERL_MALLOC_OK PERL PERLMAINCC PERLRUN PERLRUNINST PERL_CORE PERL_SRC PERM_DIR PERM_RW PERM_RWX PL_FILES PM PM_FILTER PMLIBDIRS PMLIBPARENTDIRS POLLUTE PPM_INSTALL_EXEC PPM_INSTALL_SCRIPT PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ @@ -409,7 +425,7 @@ sub new { } print STDOUT "MakeMaker (v$VERSION)\n" if $Verbose; - if (-f "MANIFEST" && ! -f "Makefile"){ + if (-f "MANIFEST" && ! -f "Makefile" && ! $ENV{PERL_CORE}){ check_manifest(); } @@ -467,14 +483,16 @@ END if (!$installed_file) { warn sprintf "Warning: prerequisite %s %s not found.\n", $prereq, $required_version - unless $self->{PREREQ_FATAL}; + unless $self->{PREREQ_FATAL} + or $ENV{PERL_CORE}; $unsatisfied{$prereq} = 'not installed'; } elsif ($pr_version < $required_version ){ warn sprintf "Warning: prerequisite %s %s not found. We have %s.\n", $prereq, $required_version, ($pr_version || 'unknown version') - unless $self->{PREREQ_FATAL}; + unless $self->{PREREQ_FATAL} + or $ENV{PERL_CORE}; $unsatisfied{$prereq} = $required_version ? $required_version : 'unknown version' ; } @@ -494,6 +512,7 @@ END if (defined $self->{CONFIGURE}) { if (ref $self->{CONFIGURE} eq 'CODE') { %configure_att = %{&{$self->{CONFIGURE}}}; + _convert_compat_attrs(\%configure_att); $self = { %$self, %configure_att }; } else { Carp::croak "Attribute 'CONFIGURE' to WriteMakefile() not a code reference\n"; @@ -998,16 +1017,23 @@ sub flush { or die "Unable to open MakeMaker.tmp: $!"; for my $chunk (@{$self->{RESULT}}) { - print $fh "$chunk\n"; + print $fh "$chunk\n" + or die "Can't write to MakeMaker.tmp: $!"; } - close $fh; + close $fh + or die "Can't write to MakeMaker.tmp: $!"; _rename("MakeMaker.tmp", $finalname) or warn "rename MakeMaker.tmp => $finalname: $!"; chmod 0644, $finalname unless $Is_VMS; - my %keep = map { ($_ => 1) } qw(NEEDS_LINKING HAS_LINK_CODE); + unless ($self->{NO_MYMETA}) { + # Write MYMETA.yml to communicate metadata up to the CPAN clients + print STDOUT "Writing MYMETA.yml\n"; + $self->write_mymeta( $self->mymeta ); + } + my %keep = map { ($_ => 1) } qw(NEEDS_LINKING HAS_LINK_CODE); if ($self->{PARENT} && !$self->{_KEEP_AFTER_FLUSH}) { foreach (keys %$self) { # safe memory delete $self->{$_} unless $keep{$_}; @@ -1017,7 +1043,6 @@ sub flush { system("$Config::Config{eunicefix} $finalname") unless $Config::Config{eunicefix} eq ":"; } - # This is a rename for OS's where the target must be unlinked first. sub _rename { my($src, $dest) = @_; @@ -1465,8 +1490,9 @@ the first line in the "=head1 NAME" section. $2 becomes the abstract. =item AUTHOR -String containing name (and email address) of package author(s). Is used -in PPD (Perl Package Description) files for PPM (Perl Package Manager). +Array of strings containing name (and email address) of package author(s). +Is used in META.yml and PPD (Perl Package Description) files for PPM (Perl +Package Manager). =item BINARY_LOCATION @@ -1940,7 +1966,7 @@ may hold a name for that binary. Defaults to perl A hashrefs of items to add to the F<META.yml>. They differ in how they behave if they have the same key as the -default metadata. META_ADD will override the default value with it's +default metadata. META_ADD will override the default value with its own. META_MERGE will merge its value with the default. Unless you want to override the defaults, prefer META_MERGE so as to @@ -1990,6 +2016,13 @@ the META.yml module meta-data file during 'make distdir'. Defaults to false. +=item NO_MYMETA + +When true, suppresses the generation of MYMETA.yml module meta-data file +during 'perl Makefile.PL'. + +Defaults to false. + =item NO_VC In general, any generated Makefile checks for the current version of @@ -2225,18 +2258,17 @@ will C<die> instead of simply informing the user of the missing dependencies. It is I<extremely> rare to have to use C<PREREQ_FATAL>. Its use by module authors is I<strongly discouraged> and should never be used lightly. + Module installation tools have ways of resolving umet dependencies but to do that they need a F<Makefile>. Using C<PREREQ_FATAL> breaks this. That's bad. -The only situation where it is appropriate is when you have -dependencies that are indispensible to actually I<write> a -F<Makefile>. For example, MakeMaker's F<Makefile.PL> needs L<File::Spec>. -If its not available it cannot write the F<Makefile>. +Assuming you have good test coverage, your tests should fail with +missing dependencies informing the user more strongly that something +is wrong. You can write a F<t/00compile.t> test which will simply +check that your code compiles and stop "make test" prematurely if it +doesn't. See L<Test::More/BAIL_OUT> for more details. -Note: see L<Test::Harness> for a shortcut for stopping tests early -if you are missing dependencies and are afraid that users might -use your module with an incomplete environment. =item PREREQ_PM @@ -2796,6 +2828,8 @@ generated Makefile along with your report. For more up-to-date information, see L<http://www.makemaker.org>. +Repository available at L<http://github.com/schwern/extutils-makemaker>. + =head1 LICENSE This program is free software; you can redistribute it and/or diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Config.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Config.pm index 38b60affdda..a7ac47d94a6 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Config.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Config.pm @@ -2,7 +2,7 @@ package ExtUtils::MakeMaker::Config; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; use Config (); diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/FAQ.pod b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/FAQ.pod index d33f82e53b9..f3354231d1e 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/FAQ.pod +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/FAQ.pod @@ -1,6 +1,6 @@ package ExtUtils::MakeMaker::FAQ; -our $VERSION = '1.12'; +our $VERSION = '6.57_01'; 1; __END__ @@ -241,7 +241,7 @@ do that. Use at your own risk. Have fun blowing holes in your foot. use File::Spec; use File::Find; use ExtUtils::Manifest qw(maniread); - + my %manifest = map {( $_ => 1 )} grep { File::Spec->canonpath($_) } keys %{ maniread() }; @@ -250,14 +250,14 @@ do that. Use at your own risk. Have fun blowing holes in your foot. print "No files found in MANIFEST. Stopping.\n"; exit; } - + find({ wanted => sub { my $path = File::Spec->canonpath($_); - + return unless -f $path; return if exists $manifest{ $path }; - + print "unlink $path\n"; unlink $path; }, @@ -267,6 +267,10 @@ do that. Use at your own risk. Have fun blowing holes in your foot. ); +=item Which tar should I use on Windows? + +We recommend ptar from Archive::Tar not older that 1.66 with '-C' option. + =item Which zip should I use on Windows for '[nd]make zipdist'? We recommend InfoZIP: L<http://www.info-zip.org/Zip.html> diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Tutorial.pod b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Tutorial.pod index 8ad72649b1a..d5ff9086c36 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Tutorial.pod +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Tutorial.pod @@ -1,6 +1,6 @@ package ExtUtils::MakeMaker::Tutorial; -our $VERSION = 0.02; +our $VERSION = 6.57_01; =head1 NAME diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/YAML.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/YAML.pm new file mode 100644 index 00000000000..7582c5781f2 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/YAML.pm @@ -0,0 +1,658 @@ +package ExtUtils::MakeMaker::YAML; + +use strict; + +# UTF Support? +sub HAVE_UTF8 () { $] >= 5.007003 } +BEGIN { + if ( HAVE_UTF8 ) { + # The string eval helps hide this from Test::MinimumVersion + eval "require utf8;"; + die "Failed to load UTF-8 support" if $@; + } + + # Class structure + require 5.004; + require Exporter; + require Carp; + $ExtUtils::MakeMaker::YAML::VERSION = '1.44'; + @ExtUtils::MakeMaker::YAML::ISA = qw{ Exporter }; + @ExtUtils::MakeMaker::YAML::EXPORT = qw{ Load Dump }; + @ExtUtils::MakeMaker::YAML::EXPORT_OK = qw{ LoadFile DumpFile freeze thaw }; + + # Error storage + $ExtUtils::MakeMaker::YAML::errstr = ''; +} + +# The character class of all characters we need to escape +# NOTE: Inlined, since it's only used once +# my $RE_ESCAPE = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f\"\n]'; + +# Printed form of the unprintable characters in the lowest range +# of ASCII characters, listed by ASCII ordinal position. +my @UNPRINTABLE = qw( + z x01 x02 x03 x04 x05 x06 a + x08 t n v f r x0e x0f + x10 x11 x12 x13 x14 x15 x16 x17 + x18 x19 x1a e x1c x1d x1e x1f +); + +# Printable characters for escapes +my %UNESCAPES = ( + z => "\x00", a => "\x07", t => "\x09", + n => "\x0a", v => "\x0b", f => "\x0c", + r => "\x0d", e => "\x1b", '\\' => '\\', +); + +# Special magic boolean words +my %QUOTE = map { $_ => 1 } qw{ + null Null NULL + y Y yes Yes YES n N no No NO + true True TRUE false False FALSE + on On ON off Off OFF +}; + + + + + +##################################################################### +# Implementation + +# Create an empty ExtUtils::MakeMaker::YAML object +sub new { + my $class = shift; + bless [ @_ ], $class; +} + +# Create an object from a file +sub read { + my $class = ref $_[0] ? ref shift : shift; + + # Check the file + my $file = shift or return $class->_error( 'You did not specify a file name' ); + return $class->_error( "File '$file' does not exist" ) unless -e $file; + return $class->_error( "'$file' is a directory, not a file" ) unless -f _; + return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _; + + # Slurp in the file + local $/ = undef; + local *CFG; + unless ( open(CFG, $file) ) { + return $class->_error("Failed to open file '$file': $!"); + } + my $contents = <CFG>; + unless ( close(CFG) ) { + return $class->_error("Failed to close file '$file': $!"); + } + + $class->read_string( $contents ); +} + +# Create an object from a string +sub read_string { + my $class = ref $_[0] ? ref shift : shift; + my $self = bless [], $class; + my $string = $_[0]; + unless ( defined $string ) { + return $self->_error("Did not provide a string to load"); + } + + # Byte order marks + # NOTE: Keeping this here to educate maintainers + # my %BOM = ( + # "\357\273\277" => 'UTF-8', + # "\376\377" => 'UTF-16BE', + # "\377\376" => 'UTF-16LE', + # "\377\376\0\0" => 'UTF-32LE' + # "\0\0\376\377" => 'UTF-32BE', + # ); + if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) { + return $self->_error("Stream has a non UTF-8 BOM"); + } else { + # Strip UTF-8 bom if found, we'll just ignore it + $string =~ s/^\357\273\277//; + } + + # Try to decode as utf8 + utf8::decode($string) if HAVE_UTF8; + + # Check for some special cases + return $self unless length $string; + unless ( $string =~ /[\012\015]+\z/ ) { + return $self->_error("Stream does not end with newline character"); + } + + # Split the file into lines + my @lines = grep { ! /^\s*(?:\#.*)?\z/ } + split /(?:\015{1,2}\012|\015|\012)/, $string; + + # Strip the initial YAML header + @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines; + + # A nibbling parser + while ( @lines ) { + # Do we have a document header? + if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) { + # Handle scalar documents + shift @lines; + if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) { + push @$self, $self->_read_scalar( "$1", [ undef ], \@lines ); + next; + } + } + + if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) { + # A naked document + push @$self, undef; + while ( @lines and $lines[0] !~ /^---/ ) { + shift @lines; + } + + } elsif ( $lines[0] =~ /^\s*\-/ ) { + # An array at the root + my $document = [ ]; + push @$self, $document; + $self->_read_array( $document, [ 0 ], \@lines ); + + } elsif ( $lines[0] =~ /^(\s*)\S/ ) { + # A hash at the root + my $document = { }; + push @$self, $document; + $self->_read_hash( $document, [ length($1) ], \@lines ); + + } else { + Carp::croak("ExtUtils::MakeMaker::YAML failed to classify the line '$lines[0]'"); + } + } + + $self; +} + +# Deparse a scalar string to the actual scalar +sub _read_scalar { + my ($self, $string, $indent, $lines) = @_; + + # Trim trailing whitespace + $string =~ s/\s*\z//; + + # Explitic null/undef + return undef if $string eq '~'; + + # Single quote + if ( $string =~ /^\'(.*?)\'\z/ ) { + return '' unless defined $1; + $string = $1; + $string =~ s/\'\'/\'/g; + return $string; + } + + # Double quote. + # The commented out form is simpler, but overloaded the Perl regex + # engine due to recursion and backtracking problems on strings + # larger than 32,000ish characters. Keep it for reference purposes. + # if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) { + if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"\z/ ) { + # Reusing the variable is a little ugly, + # but avoids a new variable and a string copy. + $string = $1; + $string =~ s/\\"/"/g; + $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex; + return $string; + } + + # Special cases + if ( $string =~ /^[\'\"!&]/ ) { + Carp::croak("ExtUtils::MakeMaker::YAML does not support a feature in line '$lines->[0]'"); + } + return {} if $string eq '{}'; + return [] if $string eq '[]'; + + # Regular unquoted string + return $string unless $string =~ /^[>|]/; + + # Error + Carp::croak("ExtUtils::MakeMaker::YAML failed to find multi-line scalar content") unless @$lines; + + # Check the indent depth + $lines->[0] =~ /^(\s*)/; + $indent->[-1] = length("$1"); + if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) { + Carp::croak("ExtUtils::MakeMaker::YAML found bad indenting in line '$lines->[0]'"); + } + + # Pull the lines + my @multiline = (); + while ( @$lines ) { + $lines->[0] =~ /^(\s*)/; + last unless length($1) >= $indent->[-1]; + push @multiline, substr(shift(@$lines), length($1)); + } + + my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n"; + my $t = (substr($string, 1, 1) eq '-') ? '' : "\n"; + return join( $j, @multiline ) . $t; +} + +# Parse an array +sub _read_array { + my ($self, $array, $indent, $lines) = @_; + + while ( @$lines ) { + # Check for a new document + if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { + while ( @$lines and $lines->[0] !~ /^---/ ) { + shift @$lines; + } + return 1; + } + + # Check the indent level + $lines->[0] =~ /^(\s*)/; + if ( length($1) < $indent->[-1] ) { + return 1; + } elsif ( length($1) > $indent->[-1] ) { + Carp::croak("ExtUtils::MakeMaker::YAML found bad indenting in line '$lines->[0]'"); + } + + if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) { + # Inline nested hash + my $indent2 = length("$1"); + $lines->[0] =~ s/-/ /; + push @$array, { }; + $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines ); + + } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) { + # Array entry with a value + shift @$lines; + push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines ); + + } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) { + shift @$lines; + unless ( @$lines ) { + push @$array, undef; + return 1; + } + if ( $lines->[0] =~ /^(\s*)\-/ ) { + my $indent2 = length("$1"); + if ( $indent->[-1] == $indent2 ) { + # Null array entry + push @$array, undef; + } else { + # Naked indenter + push @$array, [ ]; + $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines ); + } + + } elsif ( $lines->[0] =~ /^(\s*)\S/ ) { + push @$array, { }; + $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines ); + + } else { + Carp::croak("ExtUtils::MakeMaker::YAML failed to classify line '$lines->[0]'"); + } + + } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) { + # This is probably a structure like the following... + # --- + # foo: + # - list + # bar: value + # + # ... so lets return and let the hash parser handle it + return 1; + + } else { + Carp::croak("ExtUtils::MakeMaker::YAML failed to classify line '$lines->[0]'"); + } + } + + return 1; +} + +# Parse an array +sub _read_hash { + my ($self, $hash, $indent, $lines) = @_; + + while ( @$lines ) { + # Check for a new document + if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { + while ( @$lines and $lines->[0] !~ /^---/ ) { + shift @$lines; + } + return 1; + } + + # Check the indent level + $lines->[0] =~ /^(\s*)/; + if ( length($1) < $indent->[-1] ) { + return 1; + } elsif ( length($1) > $indent->[-1] ) { + Carp::croak("ExtUtils::MakeMaker::YAML found bad indenting in line '$lines->[0]'"); + } + + # Get the key + unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) { + if ( $lines->[0] =~ /^\s*[?\'\"]/ ) { + Carp::croak("ExtUtils::MakeMaker::YAML does not support a feature in line '$lines->[0]'"); + } + Carp::croak("ExtUtils::MakeMaker::YAML failed to classify line '$lines->[0]'"); + } + my $key = $1; + + # Do we have a value? + if ( length $lines->[0] ) { + # Yes + $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines ); + } else { + # An indent + shift @$lines; + unless ( @$lines ) { + $hash->{$key} = undef; + return 1; + } + if ( $lines->[0] =~ /^(\s*)-/ ) { + $hash->{$key} = []; + $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines ); + } elsif ( $lines->[0] =~ /^(\s*)./ ) { + my $indent2 = length("$1"); + if ( $indent->[-1] >= $indent2 ) { + # Null hash entry + $hash->{$key} = undef; + } else { + $hash->{$key} = {}; + $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines ); + } + } + } + } + + return 1; +} + +# Save an object to a file +sub write { + my $self = shift; + my $file = shift or return $self->_error('No file name provided'); + + # Write it to the file + open( CFG, '>' . $file ) or return $self->_error( + "Failed to open file '$file' for writing: $!" + ); + print CFG $self->write_string; + close CFG; + + return 1; +} + +# Save an object to a string +sub write_string { + my $self = shift; + return '' unless @$self; + + # Iterate over the documents + my $indent = 0; + my @lines = (); + foreach my $cursor ( @$self ) { + push @lines, '---'; + + # An empty document + if ( ! defined $cursor ) { + # Do nothing + + # A scalar document + } elsif ( ! ref $cursor ) { + $lines[-1] .= ' ' . $self->_write_scalar( $cursor, $indent ); + + # version object + } elsif ( ref $cursor eq 'version' ) { + $lines[-1] .= ' ' . $self->_write_scalar( $cursor->stringify, $indent ); + + # A list at the root + } elsif ( ref $cursor eq 'ARRAY' ) { + unless ( @$cursor ) { + $lines[-1] .= ' []'; + next; + } + push @lines, $self->_write_array( $cursor, $indent, {} ); + + # A hash at the root + } elsif ( ref $cursor eq 'HASH' ) { + unless ( %$cursor ) { + $lines[-1] .= ' {}'; + next; + } + push @lines, $self->_write_hash( $cursor, $indent, {} ); + + } else { + Carp::croak("Cannot serialize " . ref($cursor)); + } + } + + join '', map { "$_\n" } @lines; +} + +sub _write_scalar { + my $string = $_[1]; + return '~' unless defined $string; + return "''" unless length $string; + if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) { + $string =~ s/\\/\\\\/g; + $string =~ s/"/\\"/g; + $string =~ s/\n/\\n/g; + $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g; + return qq|"$string"|; + } + if ( $string =~ /(?:^\W|\s)/ or $QUOTE{$string} ) { + return "'$string'"; + } + return $string; +} + +sub _write_array { + my ($self, $array, $indent, $seen) = @_; + if ( $seen->{refaddr($array)}++ ) { + die "ExtUtils::MakeMaker::YAML does not support circular references"; + } + my @lines = (); + foreach my $el ( @$array ) { + my $line = (' ' x $indent) . '-'; + my $type = ref $el; + if ( ! $type ) { + $line .= ' ' . $self->_write_scalar( $el, $indent + 1 ); + push @lines, $line; + + # version object + } elsif ( $type eq 'version' ) { + $line .= ' ' . $self->_write_scalar( $el->stringify, $indent + 1 ); + push @lines, $line; + + } elsif ( $type eq 'ARRAY' ) { + if ( @$el ) { + push @lines, $line; + push @lines, $self->_write_array( $el, $indent + 1, $seen ); + } else { + $line .= ' []'; + push @lines, $line; + } + + } elsif ( $type eq 'HASH' ) { + if ( keys %$el ) { + push @lines, $line; + push @lines, $self->_write_hash( $el, $indent + 1, $seen ); + } else { + $line .= ' {}'; + push @lines, $line; + } + + } else { + die "ExtUtils::MakeMaker::YAML does not support $type references"; + } + } + + @lines; +} + +sub _write_hash { + my ($self, $hash, $indent, $seen) = @_; + if ( $seen->{refaddr($hash)}++ ) { + die "ExtUtils::MakeMaker::YAML does not support circular references"; + } + my @lines = (); + foreach my $name ( sort keys %$hash ) { + my $el = $hash->{$name}; + my $line = (' ' x $indent) . "$name:"; + my $type = ref $el; + if ( ! $type ) { + $line .= ' ' . $self->_write_scalar( $el, $indent + 1 ); + push @lines, $line; + + # version object + } elsif ( $type eq 'version' ) { + $line .= ' ' . $self->_write_scalar( $el->stringify, $indent + 1 ); + push @lines, $line; + + } elsif ( $type eq 'ARRAY' ) { + if ( @$el ) { + push @lines, $line; + push @lines, $self->_write_array( $el, $indent + 1, $seen ); + } else { + $line .= ' []'; + push @lines, $line; + } + + } elsif ( $type eq 'HASH' ) { + if ( keys %$el ) { + push @lines, $line; + push @lines, $self->_write_hash( $el, $indent + 1, $seen ); + } else { + $line .= ' {}'; + push @lines, $line; + } + + } else { + die "ExtUtils::MakeMaker::YAML does not support $type references"; + } + } + + @lines; +} + +# Set error +sub _error { + $ExtUtils::MakeMaker::YAML::errstr = $_[1]; + undef; +} + +# Retrieve error +sub errstr { + $ExtUtils::MakeMaker::YAML::errstr; +} + + + + + +##################################################################### +# YAML Compatibility + +sub Dump { + ExtUtils::MakeMaker::YAML->new(@_)->write_string; +} + +sub Load { + my $self = ExtUtils::MakeMaker::YAML->read_string(@_); + unless ( $self ) { + Carp::croak("Failed to load YAML document from string"); + } + if ( wantarray ) { + return @$self; + } else { + # To match YAML.pm, return the last document + return $self->[-1]; + } +} + +BEGIN { + *freeze = *Dump; + *thaw = *Load; +} + +sub DumpFile { + my $file = shift; + ExtUtils::MakeMaker::YAML->new(@_)->write($file); +} + +sub LoadFile { + my $self = ExtUtils::MakeMaker::YAML->read($_[0]); + unless ( $self ) { + Carp::croak("Failed to load YAML document from '" . ($_[0] || '') . "'"); + } + if ( wantarray ) { + return @$self; + } else { + # Return only the last document to match YAML.pm, + return $self->[-1]; + } +} + + + + + +##################################################################### +# Use Scalar::Util if possible, otherwise emulate it + +BEGIN { + eval { + require Scalar::Util; + *refaddr = *Scalar::Util::refaddr; + }; + eval <<'END_PERL' if $@; +# Failed to load Scalar::Util +sub refaddr { + my $pkg = ref($_[0]) or return undef; + if (!!UNIVERSAL::can($_[0], 'can')) { + bless $_[0], 'Scalar::Util::Fake'; + } else { + $pkg = undef; + } + "$_[0]" =~ /0x(\w+)/; + my $i = do { local $^W; hex $1 }; + bless $_[0], $pkg if defined $pkg; + $i; +} +END_PERL + +} + +1; + +__END__ + +=pod + +=head1 NAME + +ExtUtils::MakeMaker::YAML - clone of YAML::Tiny + +=head1 SYNOPSIS + +See L<YAML::Tiny> + +=head1 AUTHOR + +Adam Kennedy E<lt>adamk@cpan.orgE<gt> + +=head1 SEE ALSO + +L<YAML>, L<YAML::Syck> + +=head1 COPYRIGHT + +Copyright 2006 - 2010 Adam Kennedy. + +This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +=cut diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Manifest.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Manifest.pm index df621d5f435..ce4314c419d 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Manifest.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Manifest.pm @@ -9,11 +9,11 @@ use File::Spec; use Carp; use strict; -use vars qw($VERSION @ISA @EXPORT_OK +use vars qw($VERSION @ISA @EXPORT_OK $Is_MacOS $Is_VMS $Is_VMS_mode $Is_VMS_lc $Is_VMS_nodot $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP); -$VERSION = '1.57'; +$VERSION = '1.58'; @ISA=('Exporter'); @EXPORT_OK = qw(mkmanifest manicheck filecheck fullcheck skipcheck @@ -44,7 +44,7 @@ if ($Is_VMS) { my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || ''; - $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; + $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; $vms_efs = $efs_charset =~ /^[ET1]/i; $vms_case = $efs_case =~ /^[ET1]/i; } @@ -155,7 +155,7 @@ sub mkmanifest { close M; } -# Geez, shouldn't this use File::Spec or File::Basename or something? +# Geez, shouldn't this use File::Spec or File::Basename or something? # Why so careful about dependencies? sub clean_up_filename { my $filename = shift; @@ -190,9 +190,9 @@ sub manifind { $found->{$name} = ""; }; - # We have to use "$File::Find::dir/$_" in preprocess, because + # We have to use "$File::Find::dir/$_" in preprocess, because # $File::Find::name is unavailable. - # Also, it's okay to use / here, because MANIFEST files use Unix-style + # Also, it's okay to use / here, because MANIFEST files use Unix-style # paths. find({wanted => $wanted}, $Is_MacOS ? ":" : "."); @@ -377,7 +377,7 @@ sub maniread { my $okfile = "$dir$base"; warn "Debug: Illegal name $file changed to $okfile\n" if $Debug; $file = $okfile; - } + } $file = lc($file) unless $Is_VMS_lc &&($file =~ /^MANIFEST(\.SKIP)?$/); } @@ -414,8 +414,8 @@ sub maniskip { $_ =~ qr{^\s*(?:(?:'([^\\']*(?:\\.[^\\']*)*)')|([^#\s]\S*))?(?:(?:\s*)|(?:\s+(.*?)\s*))$}; #my $comment = $3; my $filename = $2; - if ( defined($1) ) { - $filename = $1; + if ( defined($1) ) { + $filename = $1; $filename =~ s/\\(['\\])/$1/g; } next if (not defined($filename) or not $filename); @@ -514,13 +514,13 @@ typically returned by the maniread() function. manicopy( maniread(), $dest_dir ); -This function is useful for producing a directory tree identical to the -intended distribution tree. +This function is useful for producing a directory tree identical to the +intended distribution tree. $how can be used to specify a different methods of "copying". Valid values are C<cp>, which actually copies the files, C<ln> which creates hard links, and C<best> which mostly links the files but copies any -symbolic link to make a tree without any symbolic link. C<cp> is the +symbolic link to make a tree without any symbolic link. C<cp> is the default. =cut @@ -535,11 +535,11 @@ sub manicopy { $target = VMS::Filespec::unixify($target) if $Is_VMS_mode; File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755); foreach my $file (keys %$read){ - if ($Is_MacOS) { - if ($file =~ m!:!) { - my $dir = _maccat($target, $file); + if ($Is_MacOS) { + if ($file =~ m!:!) { + my $dir = _maccat($target, $file); $dir =~ s/[^:]+$//; - File::Path::mkpath($dir,1,0755); + File::Path::mkpath($dir,1,0755); } cp_if_diff($file, _maccat($target, $file), $how); } else { @@ -689,7 +689,7 @@ sub maniadd { my @needed = grep { !exists $manifest->{$_} } keys %$additions; return 1 unless @needed; - open(MANIFEST, ">>$MANIFEST") or + open(MANIFEST, ">>$MANIFEST") or die "maniadd() could not open $MANIFEST: $!"; foreach my $file (_sort @needed) { diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Miniperl.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Miniperl.pm index 493cb347e44..379eb118ed5 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Miniperl.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Miniperl.pm @@ -90,7 +90,9 @@ main(int argc, char **argv, char **env) my_vars = my_plvarsp = plvarsp; # endif #endif /* PERL_GLOBAL_STRUCT */ - (void)env; +#ifndef NO_ENV_ARRAY_IN_MAIN + PERL_UNUSED_ARG(env); +#endif #ifndef PERL_USE_SAFE_PUTENV PL_use_safe_putenv = 0; #endif /* PERL_USE_SAFE_PUTENV */ @@ -132,12 +134,14 @@ main(int argc, char **argv, char **env) if (!exitstatus) perl_run(my_perl); +#ifndef PERL_MICRO /* Unregister our signal handler before destroying my_perl */ for (i = 0; PL_sig_name[i]; i++) { if (rsignal_state(PL_sig_num[i]) == (Sighandler_t) PL_csighandlerp) { rsignal(PL_sig_num[i], (Sighandler_t) SIG_DFL); } } +#endif exitstatus = perl_destruct(my_perl); diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Mkbootstrap.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Mkbootstrap.pm index 707466a98dd..fbf24156c6a 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Mkbootstrap.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Mkbootstrap.pm @@ -3,7 +3,7 @@ package ExtUtils::Mkbootstrap; # There's just too much Dynaloader incest here to turn on strict vars. use strict 'refs'; -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; require Exporter; our @ISA = ('Exporter'); diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Mksymlists.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Mksymlists.pm index 962c67fd57f..9aac3fd74a4 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Mksymlists.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Mksymlists.pm @@ -10,7 +10,7 @@ use Config; our @ISA = qw(Exporter); our @EXPORT = qw(&Mksymlists); -our $VERSION = '6.56'; +our $VERSION = '6.57_05'; sub Mksymlists { my(%spec) = @_; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pm index 05c3e690027..79b39688492 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pm @@ -18,7 +18,7 @@ my(@XSStack); # Stack of conditionals and INCLUDEs my($XSS_work_idx, $cpp_next_tmp); use vars qw($VERSION); -$VERSION = '2.21'; +$VERSION = '2.2210'; $VERSION = eval $VERSION if $VERSION =~ /_/; use vars qw(%input_expr %output_expr $ProtoUsed @InitFileCode $FH $proto_re $Overload $errors $Fallback @@ -74,7 +74,7 @@ sub process_file { ($XSS_work_idx, $cpp_next_tmp) = (0, "XSubPPtmpAAAA"); @InitFileCode = (); $FH = Symbol::gensym(); - $proto_re = "[" . quotemeta('\$%&*@;[]') . "]" ; + $proto_re = "[" . quotemeta('\$%&*@;[]_') . "]" ; $Overload = 0; $errors = 0; $Fallback = '&PL_sv_undef'; @@ -230,9 +230,10 @@ sub process_file { # Match an XS keyword $BLOCK_re= '\s*(' . join('|', qw( - REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT - CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE - SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD FALLBACK + REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE + OUTPUT CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE + VERSIONCHECK INCLUDE INCLUDE_COMMAND SCOPE INTERFACE + INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD FALLBACK )) . "|$END)\\s*:"; @@ -448,7 +449,7 @@ EOF $xsreturn = 0; $_ = shift(@line); - while (my $kwd = check_keyword("REQUIRE|PROTOTYPES|FALLBACK|VERSIONCHECK|INCLUDE|SCOPE")) { + while (my $kwd = check_keyword("REQUIRE|PROTOTYPES|FALLBACK|VERSIONCHECK|INCLUDE(?:_COMMAND)?|SCOPE")) { &{"${kwd}_handler"}() ; next PARAGRAPH unless @line ; $_ = shift(@line); @@ -520,11 +521,11 @@ EOF next unless defined($pre) && length($pre); my $out_type = ''; my $inout_var; - if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//) { + if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\b\s*//) { my $type = $1; $out_type = $type if $type ne 'IN'; - $arg =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//; - $pre =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//; + $arg =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\b\s*//; + $pre =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\b\s*//; } my $islength; if ($name =~ /^length\( \s* (\w+) \s* \)\z/x) { @@ -554,7 +555,7 @@ EOF } else { @args = split(/\s*,\s*/, $orig_args); for (@args) { - if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|IN_OUT|OUT)\s+//) { + if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|IN_OUT|OUT)\b\s*//) { my $out_type = $1; next if $out_type eq 'IN'; $only_C_inlist{$_} = 1 if $out_type eq "OUTLIST"; @@ -679,7 +680,7 @@ EOF # Now do a block of some sort. $condnum = 0; - $cond = ''; # last CASE: condidional + $cond = ''; # last CASE: conditional push(@line, "$END:"); push(@line_no, $line_no[-1]); $_ = ''; @@ -799,7 +800,7 @@ EOF # 0: type, 1: with_size, 2: how, 3: how_size if ($t and not $t->[1] and $t->[0] eq 'p') { - # PUSHp corresponds to setpvn. Treate setpv directly + # PUSHp corresponds to setpvn. Treat setpv directly my $what = eval qq("$t->[2]"); warn $@ if $@; @@ -934,6 +935,10 @@ EOF EOF } } + elsif($newXS eq 'newXS'){ # work around P5NCI's empty newXS macro + push(@InitFileCode, + " ${newXS}(\"$pname\", XS_$Full_func_name, file$proto);\n"); + } else { push(@InitFileCode, " (void)${newXS}(\"$pname\", XS_$Full_func_name, file$proto);\n"); @@ -999,8 +1004,11 @@ EOF print Q(<<"EOF"); # PERL_UNUSED_VAR(cv); /* -W */ # PERL_UNUSED_VAR(items); /* -W */ +##ifdef XS_APIVERSION_BOOTCHECK +# XS_APIVERSION_BOOTCHECK; +##endif EOF - + print Q(<<"EOF") if $WantVersionChk ; # XS_VERSION_BOOTCHECK ; # @@ -1481,6 +1489,25 @@ sub PROTOTYPES_handler () } +sub PushXSStack + { + my %args = @_; + # Save the current file context. + push(@XSStack, { + type => 'file', + LastLine => $lastline, + LastLineNo => $lastline_no, + Line => \@line, + LineNo => \@line_no, + Filename => $filename, + Filepathname => $filepathname, + Handle => $FH, + IsPipe => scalar($filename =~ /\|\s*$/), + %args, + }) ; + + } + sub INCLUDE_handler () { # the rest of the current line should contain a valid filename @@ -1499,17 +1526,16 @@ sub INCLUDE_handler () ++ $IncludedFiles{$_} unless /\|\s*$/ ; - # Save the current file context. - push(@XSStack, { - type => 'file', - LastLine => $lastline, - LastLineNo => $lastline_no, - Line => \@line, - LineNo => \@line_no, - Filename => $filename, - Filepathname => $filepathname, - Handle => $FH, - }) ; + if (/\|\s*$/ && /^\s*perl\s/) { + Warn("The INCLUDE directive with a command is discouraged." . + " Use INCLUDE_COMMAND instead! In particular using 'perl'" . + " in an 'INCLUDE: ... |' directive is not guaranteed to pick" . + " up the correct perl. The INCLUDE_COMMAND directive allows" . + " the use of \$^X as the currently running perl, see" . + " 'perldoc perlxs' for details."); + } + + PushXSStack(); $FH = Symbol::gensym(); @@ -1523,7 +1549,7 @@ sub INCLUDE_handler () EOF $filename = $_ ; - $filepathname = "$dir/$filename"; + $filepathname = File::Spec->catfile($dir, $filename); # Prime the pump by reading the first # non-blank line @@ -1535,7 +1561,64 @@ EOF $lastline = $_ ; $lastline_no = $. ; + } + +sub QuoteArgs { + my $cmd = shift; + my @args = split /\s+/, $cmd; + $cmd = shift @args; + for (@args) { + $_ = q(").$_.q(") if !/^\"/ && length($_) > 0; + } + return join (' ', ($cmd, @args)); + } + +sub INCLUDE_COMMAND_handler () + { + # the rest of the current line should contain a valid command + + TrimWhitespace($_) ; + + $_ = QuoteArgs($_) if $^O eq 'VMS'; + + death("INCLUDE_COMMAND: command missing") + unless $_ ; + death("INCLUDE_COMMAND: pipes are illegal") + if /^\s*\|/ or /\|\s*$/ ; + + PushXSStack( IsPipe => 1 ); + + $FH = Symbol::gensym(); + + # If $^X is used in INCLUDE_COMMAND, we know it's supposed to be + # the same perl interpreter as we're currently running + s/^\s*\$\^X/$^X/; + + # open the new file + open ($FH, "-|", "$_") + or death("Cannot run command '$_' to include its output: $!") ; + + print Q(<<"EOF"); +# +#/* INCLUDE_COMMAND: Including output of '$_' from '$filename' */ +# +EOF + + $filename = $_ ; + $filepathname = $filename; + $filepathname =~ s/\"/\\"/g; + + # Prime the pump by reading the first + # non-blank line + + # skip leading blank lines + while (<$FH>) { + last unless /^\s*$/ ; + } + + $lastline = $_ ; + $lastline_no = $. ; } sub PopFile() @@ -1544,7 +1627,7 @@ sub PopFile() my $data = pop @XSStack ; my $ThisFile = $filename ; - my $isPipe = ($filename =~ /\|\s*$/) ; + my $isPipe = $data->{IsPipe}; -- $IncludedFiles{$filename} unless $isPipe ; @@ -1947,7 +2030,7 @@ sub DESTROY { } sub UNTIE { - # This sub does nothing, but is neccessary for references to be released. + # This sub does nothing, but is necessary for references to be released. } sub end_marker { @@ -2016,7 +2099,7 @@ Adds C<extern "C"> to the C code. Default is false. =item B<hiertype> -Retains C<::> in type names so that C++ hierachical types can be +Retains C<::> in type names so that C++ hierarchical types can be mapped. Default is false. =item B<except> diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/testlib.pm b/Master/tlpkg/tlperl/lib/ExtUtils/testlib.pm index fe01beb0e1e..73144109262 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/testlib.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/testlib.pm @@ -3,7 +3,7 @@ package ExtUtils::testlib; use strict; use warnings; -our $VERSION = 6.56; +our $VERSION = 6.57_05; use Cwd; use File::Spec; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/typemap b/Master/tlpkg/tlperl/lib/ExtUtils/typemap index f88858762d5..c88238a48da 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/typemap +++ b/Master/tlpkg/tlperl/lib/ExtUtils/typemap @@ -58,33 +58,57 @@ INPUT T_SV $var = $arg T_SVREF - if (SvROK($arg)) - $var = (SV*)SvRV($arg); - else - Perl_croak(aTHX_ \"%s: %s is not a reference\", - ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, - \"$var\") + STMT_START { + SV* const xsub_tmp_sv = $arg; + SvGETMAGIC(xsub_tmp_sv); + if (SvROK(xsub_tmp_sv)){ + $var = SvRV(xsub_tmp_sv); + } + else{ + Perl_croak(aTHX_ \"%s: %s is not a reference\", + ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, + \"$var\"); + } + } STMT_END T_AVREF - if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) - $var = (AV*)SvRV($arg); - else - Perl_croak(aTHX_ \"%s: %s is not an array reference\", - ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, - \"$var\") + STMT_START { + SV* const xsub_tmp_sv = $arg; + SvGETMAGIC(xsub_tmp_sv); + if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){ + $var = (AV*)SvRV(xsub_tmp_sv); + } + else{ + Perl_croak(aTHX_ \"%s: %s is not an ARRAY reference\", + ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, + \"$var\"); + } + } STMT_END T_HVREF - if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV) - $var = (HV*)SvRV($arg); - else - Perl_croak(aTHX_ \"%s: %s is not a hash reference\", - ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, - \"$var\") + STMT_START { + SV* const xsub_tmp_sv = $arg; + SvGETMAGIC(xsub_tmp_sv); + if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVHV){ + $var = (HV*)SvRV(xsub_tmp_sv); + } + else{ + Perl_croak(aTHX_ \"%s: %s is not a HASH reference\", + ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, + \"$var\"); + } + } STMT_END T_CVREF - if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVCV) - $var = (CV*)SvRV($arg); - else - Perl_croak(aTHX_ \"%s: %s is not a code reference\", - ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, - \"$var\") + STMT_START { + SV* const xsub_tmp_sv = $arg; + SvGETMAGIC(xsub_tmp_sv); + if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVCV){ + $var = (CV*)SvRV(xsub_tmp_sv); + } + else{ + Perl_croak(aTHX_ \"%s: %s is not a CODE reference\", + ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, + \"$var\"); + } + } STMT_END T_SYSRET $var NOT IMPLEMENTED T_UV |