diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/ExtUtils')
60 files changed, 2665 insertions, 1211 deletions
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder.pm index 1caba9c3df5..98a68a0b813 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder.pm @@ -6,7 +6,7 @@ use File::Basename (); use Perl::OSType qw/os_type/; use vars qw($VERSION @ISA); -$VERSION = '0.280210'; +$VERSION = '0.280217'; $VERSION = eval $VERSION; # We only use this once - don't waste a symbol table entry on it. diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Base.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Base.pm index c76489bfd06..4392b7f5dbb 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Base.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Base.pm @@ -6,13 +6,11 @@ use File::Basename; 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.280209'; +$VERSION = '0.280217'; # More details about C/C++ compilers: # http://developers.sun.com/sunstudio/documentation/product/compiler.jsp @@ -224,10 +222,23 @@ sub have_cplusplus { } sub lib_file { - my ($self, $dl_file) = @_; + my ($self, $dl_file, %args) = @_; $dl_file =~ s/\.[^.]+$//; $dl_file =~ tr/"//d; - return "$dl_file.$self->{config}{dlext}"; + + if (defined $args{module_name} and length $args{module_name}) { + # Need to create with the same name as DynaLoader will load with. + require DynaLoader; + if (defined &DynaLoader::mod2fname) { + my $lib = DynaLoader::mod2fname([split /::/, $args{module_name}]); + my ($dev, $lib_dir, undef) = File::Spec->splitpath($dl_file); + $dl_file = File::Spec->catpath($dev, $lib_dir, $lib); + } + } + + $dl_file .= ".$self->{config}{dlext}"; + + return $dl_file; } @@ -289,7 +300,7 @@ sub _do_link { my $objects = delete $args{objects}; $objects = [$objects] unless ref $objects; - my $out = $args{$type} || $self->$type($objects->[0]); + my $out = $args{$type} || $self->$type($objects->[0], %args); my @temp_files; @temp_files = diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Unix.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Unix.pm index 696badc91b5..d948bbfecb0 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.280209'; +$VERSION = '0.280217'; @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 55ce242b8d5..d296bab51c1 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/VMS.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/VMS.pm @@ -4,7 +4,7 @@ use strict; use ExtUtils::CBuilder::Base; use vars qw($VERSION @ISA); -$VERSION = '0.280209'; +$VERSION = '0.280217'; @ISA = qw(ExtUtils::CBuilder::Base); use File::Spec::Functions qw(catfile catdir); @@ -118,22 +118,6 @@ sub arg_share_object_file { return ("$self->{config}{lddlflags}=$file"); } - -sub lib_file { - my ($self, $dl_file) = @_; - $dl_file =~ s/\.[^.]+$//; - $dl_file =~ tr/"//d; - $dl_file = $dl_file .= '.' . $self->{config}{dlext}; - - # Need to create with the same name as DynaLoader will load with. - if (defined &DynaLoader::mod2fname) { - my ($dev,$dir,$file) = File::Spec->splitpath($dl_file); - $file = DynaLoader::mod2fname([$file]); - $dl_file = File::Spec->catpath($dev,$dir,$file); - } - return $dl_file; -} - # The following is reproduced almost verbatim from ExtUtils::Liblist::Kid::_vms_ext. # We can't just call that because it's tied up with the MakeMaker object hierarchy. diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm index b63a3893bce..f9e4070b965 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.280209'; +$VERSION = '0.280217'; @ISA = qw(ExtUtils::CBuilder::Base); =begin comment 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 d7876f586db..aab143791f0 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.280209'; +$VERSION = '0.280217'; sub format_compiler_cmd { my ($self, %spec) = @_; @@ -42,7 +42,7 @@ sub write_compiler_script { # XXX Borland "response files" seem to be unable to accept macro # definitions containing quoted strings. Escaping strings with # backslash doesn't work, and any level of quotes are stripped. The - # result is is a floating point number in the source file where a + # result is a floating point number in the source file where a # string is expected. So we leave the macros on the command line. print $SCRIPT join( "\n", map { ref $_ ? @{$_} : $_ } 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 e7129acccbf..b8a32a873ac 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.280209'; +$VERSION = '0.280217'; 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 ce649629c76..3d4b5abc881 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.280209'; +$VERSION = '0.280217'; 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 29334b13076..ecc14f89e27 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.280209'; +$VERSION = '0.280217'; @ISA = qw(ExtUtils::CBuilder::Platform::Unix); sub need_prelink { 1 } diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/android.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/android.pm new file mode 100644 index 00000000000..e2be516d2ca --- /dev/null +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/android.pm @@ -0,0 +1,39 @@ +package ExtUtils::CBuilder::Platform::android; + +use strict; +use Config; +use File::Spec; +use ExtUtils::CBuilder::Platform::Unix; + +use vars qw($VERSION @ISA); +$VERSION = '0.280217'; +@ISA = qw(ExtUtils::CBuilder::Platform::Unix); + +# The Android linker will not recognize symbols from +# libperl unless the module explicitly depends on it. +sub link { + my ($self, %args) = @_; + + if ($self->{config}{useshrplib} eq 'true') { + $args{extra_linker_flags} = [ + $self->split_like_shell($args{extra_linker_flags}), + '-L' . $self->perl_inc(), + '-lperl', + $self->split_like_shell($Config{perllibs}), + ]; + } + + # Several modules on CPAN rather rightfully expect being + # able to pass $so_file to DynaLoader::dl_load_file and + # have it Just Work. However, $so_file will more likely + # than not be a relative path, and unless the module + # author subclasses MakeMaker/Module::Build to modify + # LD_LIBRARY_PATH, which would be insane, Android's linker + # won't find the .so + # So we make this all work by returning an absolute path. + my($so_file, @so_tmps) = $self->SUPER::link(%args); + $so_file = File::Spec->rel2abs($so_file); + return wantarray ? ($so_file, @so_tmps) : $so_file; +} + +1; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/cygwin.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/cygwin.pm index 206b7985d98..43e6a47b6bd 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.280209'; +$VERSION = '0.280217'; @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 0518e3ebb4c..bc4f1884968 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.280209'; +$VERSION = '0.280217'; @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 14b84e92cdb..f16fc019d59 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.280209'; +$VERSION = '0.280217'; 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 c41cdfaa8c3..3d4867c2f8d 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.280209'; +$VERSION = '0.280217'; @ISA = qw(ExtUtils::CBuilder::Platform::Unix); sub need_prelink { 1 } @@ -29,18 +29,12 @@ sub _do_link { if ($how eq 'lib_file' and (defined $args{module_name} and length $args{module_name})) { - # DynaLoader::mod2fname() is a builtin func - my $lib = DynaLoader::mod2fname([split /::/, $args{module_name}]); - # Now know the basename, find directory parts via lib_file, or objects my $objs = ( (ref $args{objects}) ? $args{objects} : [$args{objects}] ); my $near_obj = $self->lib_file(@$objs); - my $ref_file = ( defined $args{lib_file} ? $args{lib_file} : $near_obj ); - my $lib_dir = ($ref_file =~ m,(.*)[/\\],s ? "$1/" : '' ); my $exp_dir = ($near_obj =~ m,(.*)[/\\],s ? "$1/" : '' ); $args{dl_file} = $1 if $near_obj =~ m,(.*)\.,s; # put ExportList near OBJ - $args{lib_file} = "$lib_dir$lib.$self->{config}{dlext}"; # DLL file # XXX _do_link does not have place to put libraries? push @$objs, $self->perl_inc() . "/libperl$self->{config}{lib_ext}"; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Command.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Command.pm index 2a4d8cdc39d..035d5ca9df7 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.17'; +$VERSION = '1.18'; my $Is_VMS = $^O eq 'VMS'; my $Is_VMS_mode = $Is_VMS; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Command/MM.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Command/MM.pm index add6b457ce6..f45d41d0323 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Command/MM.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Command/MM.pm @@ -8,12 +8,16 @@ use warnings; require Exporter; our @ISA = qw(Exporter); -our @EXPORT = qw(test_harness pod2man perllocal_install uninstall - warn_if_old_packlist); -our $VERSION = '6.66'; +our @EXPORT = qw(test_harness pod2man perllocal_install uninstall + warn_if_old_packlist test_s cp_nonempty); +our $VERSION = '6.98'; my $Is_VMS = $^O eq 'VMS'; +eval { require Time::HiRes; die unless Time::HiRes->can("stat"); }; +*mtime = $@ ? + sub { [ stat($_[0])]->[9] } : + sub { [Time::HiRes::stat($_[0])]->[9] } ; =head1 NAME @@ -108,7 +112,7 @@ sub pod2man { # our arguments into @ARGV. Should be safe. my %options = (); Getopt::Long::config ('bundling_override'); - Getopt::Long::GetOptions (\%options, + Getopt::Long::GetOptions (\%options, 'section|s=s', 'release|r=s', 'center|c=s', 'date|d=s', 'fixed=s', 'fixedbold=s', 'fixeditalic=s', 'fixedbolditalic=s', 'official|o', 'quotes|q=s', 'lax|l', @@ -131,8 +135,8 @@ sub pod2man { my ($pod, $man) = splice(@ARGV, 0, 2); next if ((-e $man) && - (-M $man < -M $pod) && - (-M $man < -M "Makefile")); + (mtime($man) > mtime($pod)) && + (mtime($man) > mtime("Makefile"))); print "Manifying $man\n"; @@ -174,7 +178,7 @@ PACKLIST_WARNING =item B<perllocal_install> - perl "-MExtUtils::Command::MM" -e perllocal_install + perl "-MExtUtils::Command::MM" -e perllocal_install <type> <module name> <key> <value> ... # VMS only, key|value pairs come on STDIN @@ -193,7 +197,7 @@ Key/value pairs are extra information about the module. Fields include: installed into which directory your module was out into LINKTYPE dynamic or static linking VERSION module version number - EXE_FILES any executables installed in a space seperated + EXE_FILES any executables installed in a space seperated list =cut @@ -209,9 +213,9 @@ sub perllocal_install { my $pod; $pod = sprintf <<POD, scalar localtime; =head2 %s: C<$type> L<$name|$name> - + =over 4 - + POD do { @@ -219,9 +223,9 @@ POD $pod .= <<POD =item * - + C<$key: $val> - + POD } while(@mod_info); @@ -268,8 +272,43 @@ WARNING } +=item B<test_s> + + perl "-MExtUtils::Command::MM" -e test_s <file> + +Tests if a file exists and is not empty (size > 0). +I<Exits> with 0 if it does, 1 if it does not. + +=cut + +sub test_s { + exit(-s $ARGV[0] ? 0 : 1); +} + +=item B<cp_nonempty> + + perl "-MExtUtils::Command::MM" -e cp_nonempty <srcfile> <dstfile> <perm> + +Tests if the source file exists and is not empty (size > 0). If it is not empty +it copies it to the given destination with the given permissions. + =back =cut +sub cp_nonempty { + my @args = @ARGV; + return 0 unless -s $args[0]; + require ExtUtils::Command; + { + local @ARGV = @args[0,1]; + ExtUtils::Command::cp(@ARGV); + } + { + local @ARGV = @args[2,1]; + ExtUtils::Command::chmod(@ARGV); + } +} + + 1; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Embed.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Embed.pm index 9710630e515..3f983c11832 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Embed.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Embed.pm @@ -1,15 +1,7 @@ -require 5.002; - package ExtUtils::Embed; require Exporter; -require FileHandle; use Config; -use Getopt::Std; -use File::Spec; - -#Only when we need them -#require ExtUtils::MakeMaker; -#require ExtUtils::Liblist; +require File::Spec; use vars qw(@ISA @EXPORT $VERSION @Extensions $Verbose $lib_ext @@ -18,17 +10,13 @@ use vars qw(@ISA @EXPORT $VERSION use strict; # This is not a dual-life module, so no need for development version numbers -$VERSION = '1.30'; +$VERSION = '1.32'; @ISA = qw(Exporter); @EXPORT = qw(&xsinit &ldopts &ccopts &ccflags &ccdlflags &perl_inc &xsi_header &xsi_protos &xsi_body); -#let's have Miniperl borrow from us instead -#require ExtUtils::Miniperl; -#*canon = \&ExtUtils::Miniperl::canon; - $Verbose = 0; $lib_ext = $Config{lib_ext} || '.a'; @@ -54,7 +42,8 @@ sub xsinit { @mods = @$mods if $mods; } else { - getopts('o:s:'); + require Getopt::Std; + Getopt::Std::getopts('o:s:'); $file = $opt_o if defined $opt_o; $std = $opt_s if defined $opt_s; @mods = @ARGV; @@ -65,14 +54,15 @@ sub xsinit { $fh = \*STDOUT; } else { - $fh = new FileHandle "> $file"; + open $fh, '>', $file + or die "Can't open '$file': $!"; } push(@mods, static_ext()) if defined $std; @mods = grep(!$seen{$_}++, @mods); print $fh &xsi_header(); - print $fh "EXTERN_C void xs_init ($xsinit_proto);\n\n"; + print $fh "\nEXTERN_C void xs_init ($xsinit_proto);\n\n"; print $fh &xsi_protos(@mods); print $fh "\nEXTERN_C void\nxs_init($xsinit_proto)\n{\n"; @@ -83,61 +73,59 @@ sub xsinit { sub xsi_header { return <<EOF; -#include <EXTERN.h> -#include <perl.h> - +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" EOF } sub xsi_protos { - my(@exts) = @_; - my(@retval,%seen); - my $boot_proto = "pTHX_ CV* cv"; - foreach $_ (@exts){ - my($pname) = canon('/', $_); - my($mname, $cname); - ($mname = $pname) =~ s!/!::!g; - ($cname = $pname) =~ s!/!__!g; - my($ccode) = "EXTERN_C void boot_${cname} ($boot_proto);\n"; - next if $seen{$ccode}++; - push(@retval, $ccode); + my @exts = @_; + my %seen; + my $retval = ''; + foreach my $cname (canon('__', @exts)) { + my $ccode = "EXTERN_C void boot_${cname} (pTHX_ CV* cv);\n"; + $retval .= $ccode + unless $seen{$ccode}++; } - return join '', @retval; + return $retval; } sub xsi_body { - my(@exts) = @_; - my($pname,@retval,%seen); - my($dl) = canon('/','DynaLoader'); - push(@retval, "\tchar *file = __FILE__;\n"); - push(@retval, "\tdXSUB_SYS;\n") if $] > 5.002; - push(@retval, "\n"); - - foreach $_ (@exts){ - my($pname) = canon('/', $_); - my($mname, $cname, $ccode); - ($mname = $pname) =~ s!/!::!g; - ($cname = $pname) =~ s!/!__!g; - if ($pname eq $dl){ + my @exts = @_; + my %seen; + my $retval; + $retval .= " static const char file[] = __FILE__;\n" + if @exts; + $retval .= <<'EOT'; + dXSUB_SYS; + PERL_UNUSED_CONTEXT; +EOT + $retval .= "\n" + if @exts; + + foreach my $pname (canon('/', @exts)) { + next + if $seen{$pname}++; + (my $mname = $pname) =~ s!/!::!g; + (my $cname = $pname) =~ s!/!__!g; + my $fname; + if ($pname eq 'DynaLoader'){ # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'! # boot_DynaLoader is called directly in DynaLoader.pm - $ccode = "\t/* DynaLoader is a special case */\n\tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n"; - push(@retval, $ccode) unless $seen{$ccode}++; + $retval .= " /* DynaLoader is a special case */\n"; + $fname = "${mname}::boot_DynaLoader"; } else { - $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n"; - push(@retval, $ccode) unless $seen{$ccode}++; + $fname = "${mname}::bootstrap"; } + $retval .= " newXS(\"$fname\", boot_${cname}, file);\n" } - return join '', @retval; + return $retval; } sub static_ext { - unless (scalar @Extensions) { - my $static_ext = $Config{static_ext}; - $static_ext =~ s/^\s+//; - @Extensions = sort split /\s+/, $static_ext; - unshift @Extensions, qw(DynaLoader); - } + @Extensions = ('DynaLoader', sort $Config{static_ext} =~ /(\S+)/g) + unless @Extensions; @Extensions; } @@ -276,12 +264,16 @@ sub ccopts { sub canon { my($as, @ext) = @_; foreach(@ext) { - # might be X::Y or lib/auto/X/Y/Y.a - next if s!::!/!g; - s:^(lib|ext)/(auto/)?::; - s:/\w+\.\w+$::; + # might be X::Y or lib/auto/X/Y/Y.a + next + if s!::!/!g; + s!^(?:lib|ext|dist|cpan)/(?:auto/)?!!; + s!/\w+\.\w+$!!; + } + if ($as ne '/') { + s!/!$as!g + foreach @ext; } - map(s:/:$as:, @ext) if ($as ne '/'); @ext; } @@ -293,21 +285,20 @@ ExtUtils::Embed - Utilities for embedding Perl in C/C++ applications =head1 SYNOPSIS - perl -MExtUtils::Embed -e xsinit perl -MExtUtils::Embed -e ccopts perl -MExtUtils::Embed -e ldopts =head1 DESCRIPTION -ExtUtils::Embed provides utility functions for embedding a Perl interpreter +C<ExtUtils::Embed> provides utility functions for embedding a Perl interpreter and extensions in your C/C++ applications. -Typically, an application B<Makefile> will invoke ExtUtils::Embed +Typically, an application F<Makefile> will invoke C<ExtUtils::Embed> functions while building your application. =head1 @EXPORT -ExtUtils::Embed exports the following functions: +C<ExtUtils::Embed> exports the following functions: xsinit(), ldopts(), ccopts(), perl_inc(), ccflags(), ccdlflags(), xsi_header(), xsi_protos(), xsi_body() @@ -346,30 +337,25 @@ B<[@modules]> is an array ref, same as additional arguments mentioned above. =item Examples - perl -MExtUtils::Embed -e xsinit -- -o xsinit.c Socket +This will generate code with an C<xs_init> function that glues the perl C<Socket::bootstrap> function +to the C C<boot_Socket> function and writes it to a file named F<xsinit.c>. -This will generate code with an B<xs_init> function that glues the perl B<Socket::bootstrap> function -to the C B<boot_Socket> function and writes it to a file named F<xsinit.c>. - -Note that B<DynaLoader> is a special case where it must call B<boot_DynaLoader> directly. +Note that L<DynaLoader> is a special case where it must call C<boot_DynaLoader> directly. perl -MExtUtils::Embed -e xsinit - -This will generate code for linking with B<DynaLoader> and -each static extension found in B<$Config{static_ext}>. -The code is written to the default file name B<perlxsi.c>. - +This will generate code for linking with C<DynaLoader> and +each static extension found in C<$Config{static_ext}>. +The code is written to the default file name F<perlxsi.c>. perl -MExtUtils::Embed -e xsinit -- -o xsinit.c -std DBI DBD::Oracle - Here, code is written for all the currently linked extensions along with code -for B<DBI> and B<DBD::Oracle>. +for C<DBI> and C<DBD::Oracle>. -If you have a working B<DynaLoader> then there is rarely any need to statically link in any +If you have a working C<DynaLoader> then there is rarely any need to statically link in any other extensions. =item ldopts() @@ -388,16 +374,16 @@ with the current Perl. B<-I> E<lt>path1:path2E<gt> Search path for ModuleName.a archives. -Default path is B<@INC>. +Default path is C<@INC>. Library archives are expected to be found as -B</some/path/auto/ModuleName/ModuleName.a> -For example, when looking for B<Socket.a> relative to a search path, -we should find B<auto/Socket/Socket.a> +F</some/path/auto/ModuleName/ModuleName.a> +For example, when looking for F<Socket.a> relative to a search path, +we should find F<auto/Socket/Socket.a> -When looking for B<DBD::Oracle> relative to a search path, -we should find B<auto/DBD/Oracle/Oracle.a> +When looking for C<DBD::Oracle> relative to a search path, +we should find F<auto/DBD/Oracle/Oracle.a> -Keep in mind that you can always supply B</my/own/path/ModuleName.a> +Keep in mind that you can always supply F</my/own/path/ModuleName.a> as an additional linker argument. B<--> E<lt>list of linker argsE<gt> @@ -426,23 +412,19 @@ rather than print it to STDOUT. =item Examples - perl -MExtUtils::Embed -e ldopts - -This will print arguments for linking with B<libperl> and -extensions found in B<$Config{static_ext}>. This includes libraries -found in B<$Config{libs}> and the first ModuleName.a library -for each extension that is found by searching B<@INC> or the path -specified by the B<-I> option. +This will print arguments for linking with C<libperl> and +extensions found in C<$Config{static_ext}>. This includes libraries +found in C<$Config{libs}> and the first ModuleName.a library +for each extension that is found by searching C<@INC> or the path +specified by the B<-I> option. In addition, when ModuleName.a is found, additional linker arguments -are picked up from the B<extralibs.ld> file in the same directory. - +are picked up from the F<extralibs.ld> file in the same directory. perl -MExtUtils::Embed -e ldopts -- -std Socket - -This will do the same as the above example, along with printing additional arguments for linking with the B<Socket> extension. +This will do the same as the above example, along with printing additional arguments for linking with the C<Socket> extension. perl -MExtUtils::Embed -e ldopts -- -std Msql -- -L/usr/msql/lib -lmsql @@ -450,7 +432,6 @@ Any arguments after the second '--' token are additional linker arguments that will be examined for potential conflict. If there is no conflict, the additional arguments will be part of the output. - =item perl_inc() For including perl header files this function simply prints: @@ -471,29 +452,29 @@ These functions simply print $Config{ccflags} and $Config{ccdlflags} =item ccopts() -This function combines perl_inc(), ccflags() and ccdlflags() into one. +This function combines C<perl_inc()>, C<ccflags()> and C<ccdlflags()> into one. =item xsi_header() -This function simply returns a string defining the same B<EXTERN_C> macro as -B<perlmain.c> along with #including B<perl.h> and B<EXTERN.h>. +This function simply returns a string defining the same C<EXTERN_C> macro as +F<perlmain.c> along with #including F<perl.h> and F<EXTERN.h>. =item xsi_protos(@modules) -This function returns a string of B<boot_$ModuleName> prototypes for each @modules. +This function returns a string of C<boot_$ModuleName> prototypes for each @modules. =item xsi_body(@modules) -This function returns a string of calls to B<newXS()> that glue the module B<bootstrap> -function to B<boot_ModuleName> for each @modules. +This function returns a string of calls to C<newXS()> that glue the module I<bootstrap> +function to I<boot_ModuleName> for each @modules. -B<xsinit()> uses the xsi_* functions to generate most of its code. +C<xsinit()> uses the xsi_* functions to generate most of its code. =back =head1 EXAMPLES -For examples on how to use B<ExtUtils::Embed> for building C/C++ applications +For examples on how to use C<ExtUtils::Embed> for building C/C++ applications with embedded perl, see L<perlembed>. =head1 SEE ALSO @@ -502,10 +483,9 @@ L<perlembed> =head1 AUTHOR -Doug MacEachern E<lt>F<dougm@osf.org>E<gt> +Doug MacEachern E<lt>C<dougm@osf.org>E<gt> -Based on ideas from Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt> and -B<minimod.pl> by Andreas Koenig E<lt>F<k@anna.in-berlin.de>E<gt> and Tim Bunce. +Based on ideas from Tim Bunce E<lt>C<Tim.Bunce@ig.co.uk>E<gt> and +F<minimod.pl> by Andreas Koenig E<lt>C<k@anna.in-berlin.de>E<gt> and Tim Bunce. =cut - diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Install.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Install.pm index 7e17121d499..eec57aa8b54 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Install.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Install.pm @@ -38,11 +38,11 @@ ExtUtils::Install - install files from here to there =head1 VERSION -1.59 +1.67 =cut -$VERSION = '1.59'; # <---- dont forget to update the POD section just above this line! +$VERSION = '1.67'; # <-- do not forget to update the POD section just above this line! $VERSION = eval $VERSION; =pod @@ -57,7 +57,7 @@ ExtUtils::MakeMaker handles the installation and deinstallation of perl modules. They are not designed as general purpose tools. On some operating systems such as Win32 installation may not be possible -until after a reboot has occured. This can have varying consequences: +until after a reboot has occurred. This can have varying consequences: removing an old DLL does not impact programs using the new one, but if a new DLL cannot be installed properly until reboot then anything depending on it must wait. The package variable @@ -66,9 +66,9 @@ depending on it must wait. The package variable is used to store this status. -If this variable is true then such an operation has occured and +If this variable is true then such an operation has occurred and anything depending on this module cannot proceed until a reboot -has occured. +has occurred. If this value is defined but false then such an operation has ocurred, but should not impact later operations. @@ -162,7 +162,7 @@ $target should be a ref to an array if the file is to be deleted otherwise it should be a filespec for a rename. If the file is existing it will be replaced. -Sets $MUST_REBOOT to 0 to indicate a deletion operation has occured +Sets $MUST_REBOOT to 0 to indicate a deletion operation has occurred and sets it to 1 to indicate that a move operation has been requested. returns 1 on success, on failure if $moan is false errors are fatal. @@ -246,8 +246,6 @@ a derivative of the original in the same directory) so that the caller can use it to install under. In all other cases of success returns $file. On failure throws a fatal error. -=back - =end _private =cut @@ -257,7 +255,14 @@ On failure throws a fatal error. sub _unlink_or_rename { #XXX OS-SPECIFIC my ( $file, $tryhard, $installing )= @_; - _chmod( 0666, $file ); + # this chmod was originally unconditional. However, its not needed on + # POSIXy systems since permission to unlink a file is specified by the + # directory rather than the file; and in fact it screwed up hard- and + # symlinked files. Keep it for other platforms in case its still + # needed there. + if ($^O =~ /^(dos|os2|MSWin32|VMS)$/) { + _chmod( 0666, $file ); + } my $unlink_count = 0; while (unlink $file) { $unlink_count++; } return $file if $unlink_count > 0; @@ -295,6 +300,8 @@ sub _unlink_or_rename { #XXX OS-SPECIFIC =pod +=back + =head2 Functions =begin _private @@ -392,7 +399,7 @@ be created first. Returns a list, containing: C<($writable, $determined_by, @create)> -C<$writable> says whether whether the directory is (hypothetically) writable +C<$writable> says whether the directory is (hypothetically) writable C<$determined_by> is the directory the status was determined from. It will be either the C<$dir>, or one of its parents. @@ -540,8 +547,12 @@ sub _chdir { =pod +=back + =end _private +=over + =item B<install> # deprecated forms @@ -606,7 +617,7 @@ As of version 1.47 the following additions were made to the install interface. Note that the new argument style and use of the %result hash is recommended. The $always_copy parameter which when true causes files to be updated -regardles as to whether they have changed, if it is defined but false then +regardless as to whether they have changed, if it is defined but false then copies are made only if the files have changed, if it is undefined then the value of the environment variable EU_INSTALL_ALWAYS_COPY is used as default. @@ -641,7 +652,7 @@ B<NEW ARGUMENT STYLE> If there is only one argument and it is a reference to an array then the array is assumed to contain a list of key-value pairs specifying the options. In this case the option "from_to" is mandatory. This style -means that you dont have to supply a cryptic list of arguments and can +means that you do not have to supply a cryptic list of arguments and can use a self documenting argument list that is easier to understand. This is now the recommended interface to install(). @@ -838,7 +849,7 @@ sub install { #XXX OS-SPECIFIC =item _do_cleanup -Standardize finish event for after another instruction has occured. +Standardize finish event for after another instruction has occurred. Handles converting $MUST_REBOOT to a die for instance. =end _private diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Installed.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Installed.pm index c267d992e2e..a62de6e377d 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Installed.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Installed.pm @@ -17,7 +17,7 @@ my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/); require VMS::Filespec if $Is_VMS; use vars qw($VERSION); -$VERSION = '1.999003'; +$VERSION = '1.999005'; $VERSION = eval $VERSION; sub _is_prefix { diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Liblist.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Liblist.pm index 3914e2f7e63..2d21e12d824 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.66'; +our $VERSION = '6.98'; 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 f0a105cca28..e39c8b27ced 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Liblist/Kid.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Liblist/Kid.pm @@ -11,7 +11,7 @@ use 5.006; use strict; use warnings; -our $VERSION = '6.66'; +our $VERSION = '6.98'; use ExtUtils::MakeMaker::Config; use Cwd 'cwd'; @@ -28,10 +28,10 @@ sub _unix_os2_ext { my ( $self, $potential_libs, $verbose, $give_libs ) = @_; $verbose ||= 0; - if ( $^O =~ 'os2' and $Config{perllibs} ) { + if ( $^O =~ /os2|android/ and $Config{perllibs} ) { # Dynamic libraries are not transitive, so we may need including - # the libraries linked against perl.dll again. + # the libraries linked against perl.dll/libperl.so again. $potential_libs .= " " if $potential_libs; $potential_libs .= $Config{perllibs}; @@ -59,7 +59,7 @@ sub _unix_os2_ext { foreach my $thislib ( split ' ', $potential_libs ) { # Handle possible linker path arguments. - if ( $thislib =~ s/^(-[LR]|-Wl,-R)// ) { # save path flag type + if ( $thislib =~ s/^(-[LR]|-Wl,-R|-Wl,-rpath,)// ) { # save path flag type my ( $ptype ) = $1; unless ( -d $thislib ) { warn "$ptype$thislib ignored, directory does not exist\n" @@ -67,8 +67,8 @@ sub _unix_os2_ext { next; } my ( $rtype ) = $ptype; - if ( ( $ptype eq '-R' ) or ( $ptype eq '-Wl,-R' ) ) { - if ( $Config{'lddlflags'} =~ /-Wl,-R/ ) { + if ( ( $ptype eq '-R' ) or ( $ptype =~ m!^-Wl,-[Rr]! ) ) { + if ( $Config{'lddlflags'} =~ /-Wl,-[Rr]/ ) { $rtype = '-Wl,-R'; } elsif ( $Config{'lddlflags'} =~ /-R/ ) { @@ -85,6 +85,12 @@ sub _unix_os2_ext { next; } + if ( $thislib =~ m!^-Wl,! ) { + push( @extralibs, $thislib ); + push( @ldloadlibs, $thislib ); + next; + } + # Handle possible library arguments. unless ( $thislib =~ s/^-l// ) { warn "Unrecognized argument in LIBS ignored: '$thislib'\n"; @@ -152,6 +158,8 @@ sub _unix_os2_ext { } elsif ( -f ( $fullname = "$thispth/lib$thislib.dll$Config_libext" ) ) { } + elsif ( $^O eq 'cygwin' && -f ( $fullname = "$thispth/$thislib.dll" ) ) { + } elsif ( -f ( $fullname = "$thispth/Slib$thislib$Config_libext" ) ) { } elsif ($^O eq 'dgux' @@ -420,11 +428,11 @@ sub _win32_try_attach_extension { } sub _win32_lib_extensions { - my %extensions; - $extensions{ $Config{'lib_ext'} } = 1 if $Config{'lib_ext'}; - $extensions{".dll.a"} = 1 if $extensions{".a"}; - $extensions{".lib"} = 1; - return [ keys %extensions ]; + my @extensions; + push @extensions, $Config{'lib_ext'} if $Config{'lib_ext'}; + push @extensions, '.dll.a' if grep { m!^\.a$! } @extensions; + push @extensions, '.lib' unless grep { m!^\.lib$! } @extensions; + return \@extensions; } sub _debug { diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM.pm index 26ed5942707..a34015f94d1 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.66'; +our $VERSION = '6.98'; 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 2fb79705888..7c600a6c2dc 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.66'; +our $VERSION = '6.98'; 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 b37ee43bd80..20663111ef1 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.66'; +our $VERSION = '6.98'; use Carp; use File::Spec; @@ -66,7 +66,7 @@ These are methods which help writing cross-platform code. my @os_flavor = $mm->os_flavor; @os_flavor is the style of operating system this is, usually -corresponding to the MM_*.pm file we're using. +corresponding to the MM_*.pm file we're using. The first element of @os_flavor is the major family (ie. Unix, Windows, VMS, OS/2, etc...) and the rest are sub families. @@ -80,7 +80,7 @@ Some examples: MacOS X ('Unix', 'Darwin', 'MacOS', 'MacOS X') OS/2 ('OS/2') -This is used to write code for styles of operating system. +This is used to write code for styles of operating system. See os_flavor_is() for use. @@ -236,7 +236,7 @@ sub echo { $opts->{allow_variables} = 0 unless defined $opts->{allow_variables}; my $ql_opts = { allow_variables => $opts->{allow_variables} }; - my @cmds = map { '$(NOECHO) $(ECHO) '.$self->quote_literal($_, $ql_opts) } + my @cmds = map { '$(NOECHO) $(ECHO) '.$self->quote_literal($_, $ql_opts) } split /\n/, $text; if( $file ) { my $redirect = $opts->{append} ? '>>' : '>'; @@ -519,7 +519,7 @@ sub clean { clean :: clean_subdirs '); - my @files = values %{$self->{XS}}; # .c files from *.xs files + my @files = sort values %{$self->{XS}}; # .c files from *.xs files my @dirs = qw(blib); # Normally these are all under blib but they might have been @@ -531,10 +531,10 @@ clean :: clean_subdirs # push @dirs, qw($(INST_ARCHLIB) $(INST_LIB) # $(INST_BIN) $(INST_SCRIPT) # $(INST_MAN1DIR) $(INST_MAN3DIR) -# $(INST_LIBDIR) $(INST_ARCHLIBDIR) $(INST_AUTODIR) -# $(INST_STATIC) $(INST_DYNAMIC) $(INST_BOOT) +# $(INST_LIBDIR) $(INST_ARCHLIBDIR) $(INST_AUTODIR) +# $(INST_STATIC) $(INST_DYNAMIC) # ); - + if( $attribs{FILES} ) { # Use @dirs because we don't know what's in here. @@ -543,7 +543,7 @@ clean :: clean_subdirs split /\s+/, $attribs{FILES} ; } - push(@files, qw[$(MAKE_APERL_FILE) + push(@files, qw[$(MAKE_APERL_FILE) MYMETA.json 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) @@ -556,7 +556,13 @@ clean :: clean_subdirs push(@files, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.ld')); # core files - push(@files, qw[core core.*perl.*.? *perl.core]); + if ($^O eq 'vos') { + push(@files, qw[perl*.kp]); + } + else { + push(@files, qw[core core.*perl.*.? *perl.core]); + } + push(@files, map { "core." . "[0-9]"x$_ } (1..5)); # OS specific things to clean up. Use @dirs since we don't know @@ -564,14 +570,15 @@ clean :: clean_subdirs push @dirs, $self->extra_clean_files; # Occasionally files are repeated several times from different sources - { my(%f) = map { ($_ => 1) } @files; @files = keys %f; } - { my(%d) = map { ($_ => 1) } @dirs; @dirs = keys %d; } + { my(%f) = map { ($_ => 1) } @files; @files = sort keys %f; } + { my(%d) = map { ($_ => 1) } @dirs; @dirs = sort keys %d; } push @m, map "\t$_\n", $self->split_command('- $(RM_F)', @files); push @m, map "\t$_\n", $self->split_command('- $(RM_RF)', @dirs); # Leave Makefile.old around for realclean push @m, <<'MAKE'; + $(NOECHO) $(RM_F) $(MAKEFILE_OLD) - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) MAKE @@ -604,7 +611,7 @@ NOOP_FRAG for my $dir (@{$self->{DIR}}) { my $subclean = $self->oneliner(sprintf <<'CODE', $dir); -chdir '%s'; system '$(MAKE) clean' if -f '$(FIRST_MAKEFILE)'; +exit 0 unless chdir '%s'; system '$(MAKE) clean' if -f '$(FIRST_MAKEFILE)'; CODE $clean .= "\t$subclean\n"; @@ -625,7 +632,7 @@ Because depending on a directory to just ensure it exists doesn't work too well (the modified time changes too often) dir_target() creates a .exists file in the created directory. It is this you should depend on. For portability purposes you should use the $(DIRFILESEP) macro rather -than a '/' to seperate the directory from the file. +than a '/' to separate the directory from the file. yourdirectory$(DIRFILESEP).exists @@ -636,7 +643,7 @@ sub dir_target { my $make = ''; foreach my $dir (@dirs) { - $make .= sprintf <<'MAKE', ($dir) x 7; + $make .= sprintf <<'MAKE', ($dir) x 4; %s$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) %s $(NOECHO) $(CHMOD) $(PERM_DIR) %s @@ -683,7 +690,7 @@ MAKE_FRAG =head3 dist_test Defines a target that produces the distribution in the -scratchdirectory, and runs 'perl Makefile.PL; make ;make test' in that +scratch directory, and runs 'perl Makefile.PL; make ;make test' in that subdirectory. =cut @@ -720,7 +727,7 @@ sub dynamic { my($self) = shift; ' -dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT) +dynamic :: $(FIRST_MAKEFILE) $(BOOTSTRAP) $(INST_DYNAMIC) $(NOECHO) $(NOOP) '; } @@ -763,7 +770,7 @@ sub manifypods_target { my $dependencies = ''; # populate manXpods & dependencies: - foreach my $name (keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}}) { + foreach my $name (sort keys %{$self->{MAN1PODS}}, sort keys %{$self->{MAN3PODS}}) { $dependencies .= " \\\n\t$name"; } @@ -774,7 +781,7 @@ END my @man_cmds; foreach my $section (qw(1 3)) { my $pods = $self->{"MAN${section}PODS"}; - push @man_cmds, $self->split_command(<<CMD, %$pods); + push @man_cmds, $self->split_command(<<CMD, map {($_,$pods->{$_})} sort keys %$pods); \$(NOECHO) \$(POD2MAN) --section=$section --perm_rw=\$(PERM_RW) CMD } @@ -799,9 +806,9 @@ sub _has_cpan_meta { Generate the metafile target. -Writes the file META.yml YAML encoded meta-data about the module in -the distdir. The format follows Module::Build's as closely as -possible. +Writes the file META.yml (YAML encoded meta-data) and META.json +(JSON encoded meta-data) about the module in the distdir. +The format follows Module::Build's as closely as possible. =cut @@ -816,13 +823,13 @@ MAKE_FRAG $self->{META_ADD} || {}, $self->{META_MERGE} || {}, ); - + _fix_metadata_before_conversion( \%metadata ); # paper over validation issues, but still complain, necessary because # there's no guarantee that the above will fix ALL errors my $meta = eval { CPAN::Meta->create( \%metadata, { lazy_validation => 1 } ) }; - warn $@ if $@ and + warn $@ if $@ and $@ !~ /encountered CODE.*, but JSON can only represent references to arrays or hashes/; # use the original metadata straight if the conversion failed @@ -919,7 +926,7 @@ sub _fix_metadata_before_conversion { my @pairs = _sort_pairs($sort_sub, \%hash); -Sorts the pairs of a hash based on keys ordered according +Sorts the pairs of a hash based on keys ordered according to C<$sort_sub>. =end private @@ -952,7 +959,8 @@ sub _hash_merge { my @metadata_pairs = $mm->metafile_data(\%meta_add, \%meta_merge); -Returns the data which MakeMaker turns into the META.yml file. +Returns the data which MakeMaker turns into the META.yml file +and the META.json file. Values of %meta_add will overwrite any existing metadata in those keys. %meta_merge will be merged with them. @@ -980,7 +988,7 @@ sub metafile_data { generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", 'meta-spec' => { - url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', + url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', version => 1.4 }, ); @@ -988,19 +996,14 @@ sub metafile_data { # The author key is required and it takes a list. $meta{author} = defined $self->{AUTHOR} ? $self->{AUTHOR} : []; - # Check the original args so we can tell between the user setting it - # to an empty hash and it just being initialized. - if( $self->{ARGS}{CONFIGURE_REQUIRES} ) { - $meta{configure_requires} - = _normalize_prereqs($self->{CONFIGURE_REQUIRES}); - } else { - $meta{configure_requires} = { - 'ExtUtils::MakeMaker' => 0, - }; + { + my $vers = _metaspec_version( $meta_add, $meta_merge ); + my $method = $vers =~ m!^2! + ? '_add_requirements_to_meta_v2' + : '_add_requirements_to_meta_v1_4'; + %meta = $self->$method( %meta ); } - %meta = $self->_add_requirements_to_meta_v1_4( %meta ); - while( my($key, $val) = each %$meta_add ) { $meta{$key} = $val; } @@ -1017,11 +1020,31 @@ sub metafile_data { =cut +sub _metaspec_version { + my ( $meta_add, $meta_merge ) = @_; + return $meta_add->{'meta-spec'}->{version} + if defined $meta_add->{'meta-spec'} + and defined $meta_add->{'meta-spec'}->{version}; + return $meta_merge->{'meta-spec'}->{version} + if defined $meta_merge->{'meta-spec'} + and defined $meta_merge->{'meta-spec'}->{version}; + return '1.4'; +} + sub _add_requirements_to_meta_v1_4 { my ( $self, %meta ) = @_; # Check the original args so we can tell between the user setting it # to an empty hash and it just being initialized. + if( $self->{ARGS}{CONFIGURE_REQUIRES} ) { + $meta{configure_requires} + = _normalize_prereqs($self->{CONFIGURE_REQUIRES}); + } else { + $meta{configure_requires} = { + 'ExtUtils::MakeMaker' => 0, + }; + } + if( $self->{ARGS}{BUILD_REQUIRES} ) { $meta{build_requires} = _normalize_prereqs($self->{BUILD_REQUIRES}); } else { @@ -1050,6 +1073,15 @@ sub _add_requirements_to_meta_v2 { # Check the original args so we can tell between the user setting it # to an empty hash and it just being initialized. + if( $self->{ARGS}{CONFIGURE_REQUIRES} ) { + $meta{prereqs}{configure}{requires} + = _normalize_prereqs($self->{CONFIGURE_REQUIRES}); + } else { + $meta{prereqs}{configure}{requires} = { + 'ExtUtils::MakeMaker' => 0, + }; + } + if( $self->{ARGS}{BUILD_REQUIRES} ) { $meta{prereqs}{build}{requires} = _normalize_prereqs($self->{BUILD_REQUIRES}); } else { @@ -1063,7 +1095,7 @@ sub _add_requirements_to_meta_v2 { } $meta{prereqs}{runtime}{requires} = _normalize_prereqs($self->{PREREQ_PM}) - if defined $self->{PREREQ_PM}; + if $self->{ARGS}{PREREQ_PM}; $meta{prereqs}{runtime}{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION}) if $self->{MIN_PERL_VERSION}; @@ -1103,24 +1135,24 @@ sub _normalize_version { Implements a fake YAML dumper for a hash given as a list of pairs. No quoting/escaping is done. Keys -are supposed to be strings. Values are undef, strings, +are supposed to be strings. Values are undef, strings, hash refs or array refs of strings. Supported options are: delta => STR - indentation delta use_header => BOOL - whether to include a YAML header - indent => STR - a string of spaces + indent => STR - a string of spaces default: '' max_key_length => INT - maximum key length used to align keys and values of the same hash default: 20 - key_sort => CODE - a sort sub + key_sort => CODE - a sort sub It may be undef, which means no sorting by keys default: sub { lc $a cmp lc $b } - customs => HASH - special options for certain keys + customs => HASH - special options for certain keys (whose values are hashes themselves) may contain: max_key_length, key_sort, customs @@ -1136,8 +1168,8 @@ sub _dump_hash { # Use a list to preserve order. my @pairs; - my $k_sort - = exists $options->{key_sort} ? $options->{key_sort} + my $k_sort + = exists $options->{key_sort} ? $options->{key_sort} : sub { lc $a cmp lc $b }; if ($k_sort) { croak "'key_sort' should be a coderef" unless ref $k_sort eq 'CODE'; @@ -1173,7 +1205,7 @@ sub _dump_hash { $k_options{$k} = $k_custom{$k} if exists $k_custom{$k}; } } - $yaml .= $indent . "$key:\n" + $yaml .= $indent . "$key:\n" . _dump_hash(\%k_options, %$val); } else { @@ -1233,8 +1265,8 @@ sub metafile_file { my $self = shift; my %dump_options = ( - use_header => 1, - delta => ' ' x 4, + use_header => 1, + delta => ' ' x 4, key_sort => undef, ); return _dump_hash(\%dump_options, @_); @@ -1246,8 +1278,8 @@ sub metafile_file { my $make_frag = $mm->distmeta_target; -Generates the distmeta target to add META.yml to the MANIFEST in the -distdir. +Generates the distmeta target to add META.yml and META.json to the MANIFEST +in the distdir. =cut @@ -1283,8 +1315,8 @@ MAKE my $mymeta = $mm->mymeta; -Generate MYMETA information as a hash either from an existing META.yml -or from internal data. +Generate MYMETA information as a hash either from an existing CPAN Meta file +(META.json or META.yml) or from internal data. =cut @@ -1352,9 +1384,7 @@ sub _mymeta_from_meta { $self->write_mymeta( $mymeta ); -Write MYMETA information to MYMETA.yml. - -This will probably be refactored into a more generic YAML dumping method. +Write MYMETA information to MYMETA.json and MYMETA.yml. =cut @@ -1365,7 +1395,7 @@ sub write_mymeta { return unless _has_cpan_meta(); _fix_metadata_before_conversion( $mymeta ); - + # this can still blow up # not sure if i should just eval this and skip file creation if it # blows up @@ -1411,9 +1441,9 @@ sub realclean { { my(%f) = map { ($_ => 1) } @files; @files = keys %f; } { my(%d) = map { ($_ => 1) } @dirs; @dirs = keys %d; } - my $rm_cmd = join "\n\t", map { "$_" } + my $rm_cmd = join "\n\t", map { "$_" } $self->split_command('- $(RM_F)', @files); - my $rmf_cmd = join "\n\t", map { "$_" } + my $rmf_cmd = join "\n\t", map { "$_" } $self->split_command('- $(RM_RF)', @dirs); my $m = sprintf <<'MAKE', $rm_cmd, $rmf_cmd; @@ -1499,7 +1529,7 @@ sub distsignature_target { my $self = shift; my $add_sign = $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']); -eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } +eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } or print "Could not add SIGNATURE to MANIFEST: $${'@'}\n" CODE @@ -1574,6 +1604,13 @@ sub init_ABSTRACT { carp "WARNING: Setting ABSTRACT via file ". "'$self->{ABSTRACT_FROM}' failed\n"; } + + if ($self->{ABSTRACT} && $self->{ABSTRACT} =~ m![[:cntrl:]]+!) { + warn "WARNING: ABSTRACT contains control character(s),". + " they will be removed\n"; + $self->{ABSTRACT} =~ s![[:cntrl:]]+!!g; + return; + } } =head3 init_INST @@ -1596,14 +1633,7 @@ sub init_INST { # you to build directly into, say $Config{privlibexp}. unless ($self->{INST_LIB}){ if ($self->{PERL_CORE}) { - if (defined $Cross::platform) { - $self->{INST_LIB} = $self->{INST_ARCHLIB} = - $self->catdir($self->{PERL_LIB},"..","xlib", - $Cross::platform); - } - else { - $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB}; - } + $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB}; } else { $self->{INST_LIB} = $self->catdir($Curdir,"blib","lib"); } @@ -1612,7 +1642,7 @@ sub init_INST { my @parentdir = split(/::/, $self->{PARENT_NAME}); $self->{INST_LIBDIR} = $self->catdir('$(INST_LIB)', @parentdir); $self->{INST_ARCHLIBDIR} = $self->catdir('$(INST_ARCHLIB)', @parentdir); - $self->{INST_AUTODIR} = $self->catdir('$(INST_LIB)', 'auto', + $self->{INST_AUTODIR} = $self->catdir('$(INST_LIB)', 'auto', '$(FULLEXT)'); $self->{INST_ARCHAUTODIR} = $self->catdir('$(INST_ARCHLIB)', 'auto', '$(FULLEXT)'); @@ -1662,7 +1692,7 @@ sub init_INSTALL_from_PREFIX { $self->init_lib2arch; - # There are often no Config.pm defaults for these new man variables so + # There are often no Config.pm defaults for these new man variables so # we fall back to the old behavior which is to use installman*dir foreach my $num (1, 3) { my $k = 'installsiteman'.$num.'dir'; @@ -1687,7 +1717,7 @@ sub init_INSTALL_from_PREFIX { unless $Config{installsitescript}; unless( $Config{installvendorbin} ) { - $self->{INSTALLVENDORBIN} ||= $Config{usevendorprefix} + $self->{INSTALLVENDORBIN} ||= $Config{usevendorprefix} ? $Config{installbin} : ''; } @@ -1698,7 +1728,7 @@ sub init_INSTALL_from_PREFIX { } - my $iprefix = $Config{installprefixexp} || $Config{installprefix} || + my $iprefix = $Config{installprefixexp} || $Config{installprefix} || $Config{prefixexp} || $Config{prefix} || ''; my $vprefix = $Config{usevendorprefix} ? $Config{vendorprefixexp} : ''; my $sprefix = $Config{siteprefixexp} || ''; @@ -1742,7 +1772,7 @@ sub init_INSTALL_from_PREFIX { unless $Config{'installman'.$num.'dir'}; } - my %bin_layouts = + my %bin_layouts = ( bin => { s => $iprefix, t => 'perl', @@ -1763,7 +1793,7 @@ sub init_INSTALL_from_PREFIX { t => 'site', d => 'bin' }, ); - + my %man_layouts = ( man1dir => { s => $iprefix, @@ -1807,7 +1837,7 @@ sub init_INSTALL_from_PREFIX { t => 'site', d => 'site_perl', style => $libstyle, }, - + archlib => { s => $iprefix, t => 'perl', d => "$version/$arch", @@ -1829,7 +1859,7 @@ sub init_INSTALL_from_PREFIX { my $Installvar = uc "install$var"; if( $var =~ /arch/ ) { - $self->{$Installvar} ||= + $self->{$Installvar} ||= $self->catdir($self->{LIB}, $Config{archname}); } else { @@ -1857,7 +1887,7 @@ sub init_INSTALL_from_PREFIX { $d = "$style/$d" if $style; $self->prefixify($installvar, $s, $r, $d); - warn " $Installvar == $self->{$Installvar}\n" + warn " $Installvar == $self->{$Installvar}\n" if $Verbose >= 2; } @@ -1887,7 +1917,7 @@ $map{script} = $map{bin}; sub init_INSTALL_from_INSTALL_BASE { my $self = shift; - @{$self}{qw(PREFIX VENDORPREFIX SITEPREFIX PERLPREFIX)} = + @{$self}{qw(PREFIX VENDORPREFIX SITEPREFIX PERLPREFIX)} = '$(INSTALL_BASE)'; my %install; @@ -1896,7 +1926,7 @@ sub init_INSTALL_from_INSTALL_BASE { my $uc_thing = uc $thing; my $key = "INSTALL".$dir.$uc_thing; - $install{$key} ||= + $install{$key} ||= $self->catdir('$(INSTALL_BASE)', @{$map{$thing}}); } } @@ -1923,7 +1953,7 @@ MAKEMAKER: path to the MakeMaker module. MM_VERSION: ExtUtils::MakeMaker Version -MM_REVISION: ExtUtils::MakeMaker version control revision (for backwards +MM_REVISION: ExtUtils::MakeMaker version control revision (for backwards compat) VERSION: version of your module @@ -1960,8 +1990,12 @@ sub init_VERSION { } } - # strip blanks if (defined $self->{VERSION}) { + if ( $self->{VERSION} !~ /^\s*v?[\d_\.]+\s*$/ ) { + require version; + my $normal = eval { version->parse( $self->{VERSION} ) }; + $self->{VERSION} = $normal if defined $normal; + } $self->{VERSION} =~ s/^\s+//; $self->{VERSION} =~ s/\s+$//; } @@ -1977,7 +2011,7 @@ sub init_VERSION { # Graham Barr and Paul Marquess had some ideas how to ensure # version compatibility between the *.pm file and the - # corresponding *.xs file. The bottomline was, that we need an + # corresponding *.xs file. The bottom line was, that we need an # XS_VERSION macro that defaults to VERSION: $self->{XS_VERSION} ||= $self->{VERSION}; @@ -2006,12 +2040,14 @@ Defines at least these macros. SHELL Program used to run shell commands ECHO Print text adding a newline on the end - RM_F Remove a file - RM_RF Remove a directory - TOUCH Update a file's timestamp - TEST_F Test for a file's existence - CP Copy a file - MV Move a file + RM_F Remove a file + RM_RF Remove a directory + TOUCH Update a file's timestamp + TEST_F Test for a file's existence + TEST_S Test the size of a file + CP Copy a file + CP_NONEMPTY Copy a file if it is not empty + MV Move a file CHMOD Change permissions on a file FALSE Exit with non-zero TRUE Exit with zero @@ -2032,6 +2068,8 @@ sub init_tools { $self->{RM_F} ||= $self->oneliner('rm_f', ["-MExtUtils::Command"]); $self->{RM_RF} ||= $self->oneliner('rm_rf', ["-MExtUtils::Command"]); $self->{TEST_F} ||= $self->oneliner('test_f', ["-MExtUtils::Command"]); + $self->{TEST_S} ||= $self->oneliner('test_s', ["-MExtUtils::Command::MM"]); + $self->{CP_NONEMPTY} ||= $self->oneliner('cp_nonempty', ["-MExtUtils::Command::MM"]); $self->{FALSE} ||= $self->oneliner('exit 1'); $self->{TRUE} ||= $self->oneliner('exit 0'); @@ -2040,13 +2078,13 @@ sub init_tools { $self->{CP} ||= $self->oneliner('cp', ["-MExtUtils::Command"]); $self->{MV} ||= $self->oneliner('mv', ["-MExtUtils::Command"]); - $self->{MOD_INSTALL} ||= + $self->{MOD_INSTALL} ||= $self->oneliner(<<'CODE', ['-MExtUtils::Install']); install([ from_to => {@ARGV}, verbose => '$(VERBINST)', uninstall_shadows => '$(UNINST)', dir_mode => '$(PERM_DIR)' ]); CODE $self->{DOC_INSTALL} ||= $self->oneliner('perllocal_install', ["-MExtUtils::Command::MM"]); $self->{UNINSTALL} ||= $self->oneliner('uninstall', ["-MExtUtils::Command::MM"]); - $self->{WARN_IF_OLD_PACKLIST} ||= + $self->{WARN_IF_OLD_PACKLIST} ||= $self->oneliner('warn_if_old_packlist', ["-MExtUtils::Command::MM"]); $self->{FIXIN} ||= $self->oneliner('MY->fixin(shift)', ["-MExtUtils::MY"]); $self->{EQUALIZE_TIMESTAMP} ||= $self->oneliner('eqtime', ["-MExtUtils::Command"]); @@ -2074,7 +2112,7 @@ CODE # Not everybody uses -f to indicate "use this Makefile instead" $self->{USEMAKEFILE} ||= '-f'; - # Some makes require a wrapper around macros passed in on the command + # Some makes require a wrapper around macros passed in on the command # line. $self->{MACROSTART} ||= ''; $self->{MACROEND} ||= ''; @@ -2108,13 +2146,17 @@ sub init_others { my(@libs) = $self->extliblist($libs); if ($libs[0] or $libs[1] or $libs[2]){ # LD_RUN_PATH now computed by ExtUtils::Liblist - ($self->{EXTRALIBS}, $self->{BSLOADLIBS}, + ($self->{EXTRALIBS}, $self->{BSLOADLIBS}, $self->{LDLOADLIBS}, $self->{LD_RUN_PATH}) = @libs; last; } } if ( $self->{OBJECT} ) { + $self->{OBJECT} = join(" ", @{$self->{OBJECT}}) if ref $self->{OBJECT}; + $self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g; + } elsif ( $self->{MAGICXS} && @{$self->{O_FILES}||[]} ) { + $self->{OBJECT} = join(" ", @{$self->{O_FILES}}); $self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g; } else { # init_dirscan should have found out, if we have C files @@ -2146,7 +2188,7 @@ sub init_others { sub _fix_libs { my($self, $libs) = @_; - return !defined $libs ? [''] : + return !defined $libs ? [''] : !ref $libs ? [$libs] : !defined $libs->[0] ? [''] : $libs ; @@ -2157,7 +2199,7 @@ sub _fix_libs { my $make_frag = $MM->tools_other; -Returns a make fragment containing definitions for the macros init_others() +Returns a make fragment containing definitions for the macros init_others() initializes. =cut @@ -2168,7 +2210,7 @@ sub tools_other { # We set PM_FILTER as late as possible so it can see all the earlier # on macro-order sensitive makes such as nmake. - for my $tool (qw{ SHELL CHMOD CP MV NOOP NOECHO RM_F RM_RF TEST_F TOUCH + for my $tool (qw{ SHELL CHMOD CP MV NOOP NOECHO RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL MKPATH EQUALIZE_TIMESTAMP FALSE TRUE ECHO ECHO_N @@ -2179,7 +2221,8 @@ sub tools_other { USEMAKEFILE PM_FILTER FIXIN - } ) + CP_NONEMPTY + } ) { next unless defined $self->{$tool}; push @m, "$tool = $self->{$tool}\n"; @@ -2194,7 +2237,7 @@ sub tools_other { $MM->init_DIRFILESEP; my $dirfilesep = $MM->{DIRFILESEP}; -Initializes the DIRFILESEP macro which is the seperator between the +Initializes the DIRFILESEP macro which is the separator between the directory and filename in a filepath. ie. / on Unix, \ on Win32 and nothing on VMS. @@ -2206,8 +2249,8 @@ For example: Something of a hack but it prevents a lot of code duplication between MM_* variants. -Do not use this as a seperator between directories. Some operating -systems use different seperators between subdirectories as between +Do not use this as a separator between directories. Some operating +systems use different separators between subdirectories as between directories and filenames (for example: VOLUME:[dir1.dir2]file on VMS). =head3 init_linker I<Abstract> @@ -2236,7 +2279,7 @@ Some OSes do not need these in which case leave it blank. Initialize any macros which are for platform specific use only. -A typical one is the version number of your OS specific mocule. +A typical one is the version number of your OS specific module. (ie. MM_Unix_VERSION or MM_VMS_VERSION). =cut @@ -2309,7 +2352,7 @@ sub POD2MAN_macro { my $self = shift; # Need the trailing '--' so perl stops gobbling arguments and - happens -# to be an alternative end of line seperator on VMS so we quote it +# to be an alternative end of line separator on VMS so we quote it return <<'END_OF_DEF'; POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" POD2MAN = $(POD2MAN_EXE) @@ -2331,8 +2374,8 @@ Used on the t/*.t files. sub test_via_harness { my($self, $perl, $tests) = @_; - return qq{\t$perl "-MExtUtils::Command::MM" }. - qq{"-e" "test_harness(\$(TEST_VERBOSE), '\$(INST_LIB)', '\$(INST_ARCHLIB)')" $tests\n}; + return qq{\t$perl "-MExtUtils::Command::MM" "-MTest::Harness" }. + qq{"-e" "undef *Test::Harness::Switches; test_harness(\$(TEST_VERBOSE), '\$(INST_LIB)', '\$(INST_ARCHLIB)')" $tests\n}; } =head3 test_via_script @@ -2364,7 +2407,7 @@ pm_to_blib soon. sub tool_autosplit { my($self, %attribs) = @_; - my $maxlen = $attribs{MAXLEN} ? '$$AutoSplit::Maxlen=$attribs{MAXLEN};' + my $maxlen = $attribs{MAXLEN} ? '$$AutoSplit::Maxlen=$attribs{MAXLEN};' : ''; my $asplit = $self->oneliner(sprintf <<'PERL_CODE', $maxlen); @@ -2421,11 +2464,11 @@ sub arch_check { my $arch = (grep length, $self->splitdir($pthinks))[-1]; print <<END unless $self->{UNINSTALLED_PERL}; -Your perl and your Config.pm seem to have different ideas about the +Your perl and your Config.pm seem to have different ideas about the architecture they are running on. Perl thinks: [$arch] Config says: [$Config{archname}] -This may or may not cause problems. Please check your installation of perl +This may or may not cause problems. Please check your installation of perl if you have problems building this extension. END } @@ -2475,6 +2518,44 @@ sub find_tests { return -d 't' ? 't/*.t' : ''; } +=head3 find_tests_recursive + + my $tests = $mm->find_tests_recursive; + +Returns a string suitable for feeding to the shell to return all +tests in t/ but recursively. + +=cut + +sub find_tests_recursive { + my($self) = shift; + return '' unless -d 't'; + + require File::Find; + + my %testfiles; + + my $wanted = sub { + return unless m!\.t$!; + my ($volume,$directories,$file) = + File::Spec->splitpath( $File::Find::name ); + my @dirs = File::Spec->splitdir( $directories ); + for ( @dirs ) { + next if $_ eq 't'; + unless ( $_ ) { + $_ = '*.t'; + next; + } + $_ = '*'; + } + my $testfile = join '/', @dirs; + $testfiles{ $testfile } = 1; + }; + + File::Find::find( $wanted, 't' ); + + return join ' ', sort keys %testfiles; +} =head3 extra_clean_files @@ -2486,7 +2567,7 @@ addition to the usual set. =cut # An empty method here tickled a perl 5.8.1 bug and would return its object. -sub extra_clean_files { +sub extra_clean_files { return; } @@ -2527,7 +2608,7 @@ installation. sub libscan { my($self,$path) = @_; my($dirs,$file) = ($self->splitpath($path))[1,2]; - return '' if grep /^(?:RCS|CVS|SCCS|\.svn|_darcs)$/, + return '' if grep /^(?:RCS|CVS|SCCS|\.svn|_darcs)$/, $self->splitdir($dirs), $file; return $path; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_BeOS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_BeOS.pm index 74d3105ca15..060ce36837b 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.66'; +our $VERSION = '6.98'; =item os_flavor @@ -48,7 +48,7 @@ libperl.a equivalent to be linked to dynamic extensions. sub init_linker { my($self) = shift; - $self->{PERL_ARCHIVE} ||= + $self->{PERL_ARCHIVE} ||= File::Spec->catdir('$(PERL_INC)',$Config{libperl}); $self->{PERL_ARCHIVE_AFTER} ||= ''; $self->{EXPORT_LIST} ||= ''; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Cygwin.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Cygwin.pm index 643682e6119..d8f3e3a88fa 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.66'; +our $VERSION = '6.98'; =head1 NAME @@ -90,7 +90,7 @@ sub init_linker { } $self->{PERL_ARCHIVE} = $libperl; } else { - $self->{PERL_ARCHIVE} = + $self->{PERL_ARCHIVE} = '$(PERL_INC)' .'/'. ("$Config{libperl}" or "libperl.a"); } @@ -100,20 +100,22 @@ sub init_linker { =item maybe_command -If our path begins with F</cygdrive/> then we use C<ExtUtils::MM_Win32> -to determine if it may be a command. Otherwise we use the tests -from C<ExtUtils::MM_Unix>. +Determine whether a file is native to Cygwin by checking whether it +resides inside the Cygwin installation (using Windows paths). If so, +use C<ExtUtils::MM_Unix> to determine if it may be a command. +Otherwise use the tests from C<ExtUtils::MM_Win32>. =cut sub maybe_command { my ($self, $file) = @_; - if ($file =~ m{^/cygdrive/}i) { - return ExtUtils::MM_Win32->maybe_command($file); - } + my $cygpath = Cygwin::posix_to_win_path('/', 1); + my $filepath = Cygwin::posix_to_win_path($file, 1); - return $self->SUPER::maybe_command($file); + return (substr($filepath,0,length($cygpath)) eq $cygpath) + ? $self->SUPER::maybe_command($file) # Unix + : ExtUtils::MM_Win32->maybe_command($file); # Win32 } =item dynamic_lib diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_DOS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_DOS.pm index 4f0eca3ce8e..4f52a9859db 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.66'; +our $VERSION = '6.98'; 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 96ec6fbc2c6..861a544172a 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.66'; +our $VERSION = '6.98'; =head1 NAME @@ -20,7 +20,7 @@ ExtUtils::MM_Darwin - special behaviors for OS X =head1 DESCRIPTION -See L<ExtUtils::MM_Unix> for L<ExtUtils::MM_Any> for documention on the +See L<ExtUtils::MM_Unix> for L<ExtUtils::MM_Any> for documentation on the methods overridden here. =head2 Overriden Methods @@ -33,14 +33,14 @@ Turn off Apple tar's tendency to copy resource forks as "._foo" files. sub init_dist { my $self = shift; - + # Thank you, Apple, for breaking tar and then breaking the work around. # 10.4 wants COPY_EXTENDED_ATTRIBUTES_DISABLE while 10.5 wants # COPYFILE_DISABLE. I'm not going to push my luck and instead just # set both. - $self->{TAR} ||= + $self->{TAR} ||= 'COPY_EXTENDED_ATTRIBUTES_DISABLE=1 COPYFILE_DISABLE=1 tar'; - + $self->SUPER::init_dist(@_); } diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_MacOS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_MacOS.pm index daba1166c3a..cd3a12a38c0 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.66'; +our $VERSION = '6.98'; 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 94531a72e7a..f6b0b5bd3a7 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_NW5.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_NW5.pm @@ -16,13 +16,13 @@ the semantics. =over -=cut +=cut use strict; use ExtUtils::MakeMaker::Config; use File::Basename; -our $VERSION = '6.66'; +our $VERSION = '6.98'; require ExtUtils::MM_Win32; our @ISA = qw(ExtUtils::MM_Win32); @@ -66,7 +66,7 @@ sub init_platform { # To get Win32's setup. $self->SUPER::init_platform; - # incpath is copied to makefile var INCLUDE in constants sub, here just + # incpath is copied to makefile var INCLUDE in constants sub, here just # make it empty my $libpth = $Config{'libpth'}; $libpth =~ s( )(;); @@ -78,7 +78,7 @@ sub init_platform { if($self->{'base_import'}) { $self->{'BASE_IMPORT'} .= ', ' . $self->{'base_import'}; } - + $self->{'NLM_VERSION'} = $Config{'nlm_version'}; $self->{'MPKTOOL'} = $Config{'mpktool'}; $self->{'TOOLPATH'} = $Config{'toolpath'}; @@ -110,7 +110,7 @@ sub platform_constants { # Setup Win32's constants. $make_frag .= $self->SUPER::platform_constants; - foreach my $macro (qw(LIBPTH BASE_IMPORT NLM_VERSION MPKTOOL + foreach my $macro (qw(LIBPTH BASE_IMPORT NLM_VERSION MPKTOOL TOOLPATH BOOT_SYMBOL NLM_SHORT_NAME INCLUDE PATH MM_NW5_VERSION )) @@ -231,7 +231,7 @@ MAKE_FRAG # Taking care of long names like FileHandle, ByteLoader, SDBM_File etc if($self->{NLM_SHORT_NAME}) { - # In case of nlms with names exceeding 8 chars, build nlm in the + # In case of nlms with names exceeding 8 chars, build nlm in the # current dir, rename and move to auto\lib. $m .= q{ -o $(NLM_SHORT_NAME).$(DLEXT)} } else { @@ -245,7 +245,7 @@ MAKE_FRAG if($self->{NLM_SHORT_NAME}) { $m .= <<'MAKE_FRAG'; - if exist $(INST_AUTODIR)\$(NLM_SHORT_NAME).$(DLEXT) del $(INST_AUTODIR)\$(NLM_SHORT_NAME).$(DLEXT) + if exist $(INST_AUTODIR)\$(NLM_SHORT_NAME).$(DLEXT) del $(INST_AUTODIR)\$(NLM_SHORT_NAME).$(DLEXT) move $(NLM_SHORT_NAME).$(DLEXT) $(INST_AUTODIR) MAKE_FRAG } @@ -264,6 +264,6 @@ __END__ =back -=cut +=cut diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_OS2.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_OS2.pm index 55d6c448c08..52bc4d1f108 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.66'; +our $VERSION = '6.98'; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; @@ -81,12 +81,12 @@ $self->{BASEEXT}.def: Makefile.PL } close $imp or die "Can't close tmpimp.imp"; # print "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp\n"; - system "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp" + system "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp" and die "Cannot make import library: $!, \$?=$?"; # May be running under miniperl, so have no glob... eval { unlink <tmp_imp/*>; 1 } or system "rm tmp_imp/*"; - system "cd tmp_imp; $Config::Config{ar} x ../tmpimp$Config::Config{lib_ext}" - and die "Cannot extract import objects: $!, \$?=$?"; + system "cd tmp_imp; $Config::Config{ar} x ../tmpimp$Config::Config{lib_ext}" + and die "Cannot extract import objects: $!, \$?=$?"; } join('',@m); } @@ -95,7 +95,7 @@ sub static_lib { my($self) = @_; my $old = $self->ExtUtils::MM_Unix::static_lib(); return $old unless $self->{IMPORTS} && %{$self->{IMPORTS}}; - + my @chunks = split /\n{2,}/, $old; shift @chunks unless length $chunks[0]; # Empty lines at the start $chunks[0] .= <<'EOC'; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_QNX.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_QNX.pm index 16169399c89..7b74bf41d56 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.66'; +our $VERSION = '6.98'; 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 7c28520f486..5b9730025fd 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.66'; +our $VERSION = '6.98'; 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 1629b273699..4140432bc8a 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Unix.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Unix.pm @@ -15,14 +15,14 @@ use ExtUtils::MakeMaker qw($Verbose neatvalue); # If we make $VERSION an our variable parse_version() breaks use vars qw($VERSION); -$VERSION = '6.66'; +$VERSION = '6.98'; $VERSION = eval $VERSION; ## no critic [BuiltinFunctions::ProhibitStringyEval] require ExtUtils::MM_Any; our @ISA = qw(ExtUtils::MM_Any); my %Is; -BEGIN { +BEGIN { $Is{OS2} = $^O eq 'os2'; $Is{Win32} = $^O eq 'MSWin32' || $Config{osname} eq 'NetWare'; $Is{Dos} = $^O eq 'dos'; @@ -37,6 +37,7 @@ BEGIN { $Is{BSD} = ($^O =~ /^(?:free|net|open)bsd$/ or grep( $^O eq $_, qw(bsdos interix dragonfly) ) ); + $Is{Android} = $^O =~ /android/; } BEGIN { @@ -129,10 +130,10 @@ sub c_o { my($self) = shift; return '' unless $self->needs_linking(); my(@m); - + my $command = '$(CCCMD)'; my $flags = '$(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE)'; - + if (my $cpp = $Config{cpprun}) { my $cpp_cmd = $self->const_cccmd; $cpp_cmd =~ s/^CCCMD\s*=\s*\$\(CC\)/$cpp/; @@ -372,7 +373,7 @@ sub constants { for my $macro (qw( AR_STATIC_ARGS DIRFILESEP DFSEP - NAME NAME_SYM + NAME NAME_SYM VERSION VERSION_MACRO VERSION_SYM DEFINE_VERSION XS_VERSION XS_VERSION_MACRO XS_DEFINE_VERSION INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB @@ -385,18 +386,18 @@ sub constants { "DESTINSTALL".$_) } $self->installvars), qw( - PERL_LIB + PERL_LIB PERL_ARCHLIB LIBPERL_A MYEXTLIB - FIRST_MAKEFILE MAKEFILE_OLD MAKE_APERL_FILE - PERLMAINCC PERL_SRC PERL_INC + FIRST_MAKEFILE MAKEFILE_OLD MAKE_APERL_FILE + PERLMAINCC PERL_SRC PERL_INC PERL FULLPERL ABSPERL PERLRUN FULLPERLRUN ABSPERLRUN PERLRUNINST FULLPERLRUNINST ABSPERLRUNINST PERL_CORE PERM_DIR PERM_RW PERM_RWX - ) ) + ) ) { next unless defined $self->{$macro}; @@ -423,7 +424,7 @@ MM_REVISION = $self->{MM_REVISION} MAKE FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT LDFROM LINKTYPE BOOTDEP - / ) + / ) { next unless defined $self->{$macro}; push @m, "$macro = $self->{$macro}\n"; @@ -443,7 +444,7 @@ MAN3PODS = ".$self->wraplist(sort keys %{$self->{MAN3PODS}})." push @m, q{ # Where is the Config information that we are using/depend on CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h -}; +} if -e File::Spec->catfile( $self->{PERL_INC}, 'config.h' ); push @m, qq{ @@ -471,7 +472,7 @@ PERL_ARCHIVE_AFTER = $self->{PERL_ARCHIVE_AFTER} TO_INST_PM = ".$self->wraplist(sort keys %{$self->{PM}})." -PM_TO_BLIB = ".$self->wraplist(%{$self->{PM}})." +PM_TO_BLIB = ".$self->wraplist(map { ($_ => $self->{PM}->{$_}) } sort keys %{$self->{PM}})." "; join('',@m); @@ -533,18 +534,18 @@ Defines a lot of macros for distribution support. COMPRESS compression command to gzip --best use for tarfiles - SUFFIX suffix to put on .gz + SUFFIX suffix to put on .gz compressed files SHAR shar command to use shar PREOP extra commands to run before - making the archive + making the archive POSTOP extra commands to run after making the archive TO_UNIX a command to convert linefeeds - to Unix style in your archive + to Unix style in your archive CI command to checkin your ci -u sources to version control @@ -583,7 +584,6 @@ sub init_dist { ($self->{DISTNAME} = $self->{NAME}) =~ s{::}{-}g unless $self->{DISTNAME}; $self->{DISTVNAME} ||= $self->{DISTNAME}.'-'.$self->{VERSION}; - } =item dist (o) @@ -601,7 +601,10 @@ sub dist { my($self, %attribs) = @_; my $make = ''; - foreach my $key (qw( + if ( $attribs{SUFFIX} && $attribs{SUFFIX} !~ m!^\.! ) { + $attribs{SUFFIX} = '.' . $attribs{SUFFIX}; + } + foreach my $key (qw( TAR TARFLAGS ZIP ZIPFLAGS COMPRESS SUFFIX SHAR PREOP POSTOP TO_UNIX CI RCS_LABEL DIST_CP DIST_DEFAULT @@ -638,7 +641,7 @@ manifest : $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest veryclean : realclean - $(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old + $(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old MAKE_FRAG @@ -674,7 +677,7 @@ sub dist_core { my($self) = shift; my $make_frag = ''; - foreach my $target (qw(dist tardist uutardist tarfile zipdist zipfile + foreach my $target (qw(dist tardist uutardist tarfile zipdist zipfile shdist)) { my $method = $target.'_target'; @@ -768,6 +771,7 @@ $(DISTVNAME).tar$(SUFFIX) : distdir $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) $(RM_RF) $(DISTVNAME) $(COMPRESS) $(DISTVNAME).tar + $(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)' $(POSTOP) MAKE_FRAG } @@ -790,6 +794,7 @@ $(DISTVNAME).zip : distdir $(PREOP) $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) $(RM_RF) $(DISTVNAME) + $(NOECHO) $(ECHO) 'Created $(DISTVNAME).zip' $(POSTOP) MAKE_FRAG } @@ -808,6 +813,7 @@ sub uutardist_target { return <<'MAKE_FRAG'; uutardist : $(DISTVNAME).tar$(SUFFIX) uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu + $(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)_uu' MAKE_FRAG } @@ -828,6 +834,7 @@ shdist : distdir $(PREOP) $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar $(RM_RF) $(DISTVNAME) + $(NOECHO) $(ECHO) 'Created $(DISTVNAME).shar' $(POSTOP) MAKE_FRAG } @@ -860,7 +867,7 @@ BOOTSTRAP = my $target = $Is{VMS} ? '$(MMS$TARGET)' : '$@'; - return sprintf <<'MAKE_FRAG', ($target) x 5; + return sprintf <<'MAKE_FRAG', ($target) x 2; BOOTSTRAP = $(BASEEXT).bs # As Mkbootstrap might not write a file (if none is required) @@ -873,11 +880,6 @@ $(BOOTSTRAP) : $(FIRST_MAKEFILE) $(BOOTDEP) $(INST_ARCHAUTODIR)$(DFSEP).exists -e "Mkbootstrap('$(BASEEXT)','$(BSLOADLIBS)');" $(NOECHO) $(TOUCH) %s $(CHMOD) $(PERM_RW) %s - -$(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists - $(NOECHO) $(RM_RF) %s - - $(CP) $(BOOTSTRAP) %s - $(CHMOD) $(PERM_RW) %s MAKE_FRAG } @@ -909,7 +911,7 @@ OTHERLDFLAGS = '.$ld_opt.$otherldflags.' INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' INST_DYNAMIC_FIX = '.$ld_fix.' -$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP) +$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP) '); if ($armaybe ne ':'){ $ldfrom = 'tmp$(LIB_EXT)'; @@ -919,7 +921,7 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP). $ldfrom = "-all $ldfrom -none" if $Is{OSF}; # The IRIX linker doesn't use LD_RUN_PATH - my $ldrun = $Is{IRIX} && $self->{LD_RUN_PATH} ? + my $ldrun = $Is{IRIX} && $self->{LD_RUN_PATH} ? qq{-rpath "$self->{LD_RUN_PATH}"} : ''; # For example in AIX the shared objects/libraries from previous builds @@ -932,7 +934,7 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP). my $libs = '$(LDLOADLIBS)'; - if (($Is{NetBSD} || $Is{Interix}) && $Config{'useshrplib'} eq 'true') { + if (($Is{NetBSD} || $Is{Interix} || $Is{Android}) && $Config{'useshrplib'} eq 'true') { # Use nothing on static perl platforms, and to the flags needed # to link against the shared libperl library on shared perl # platforms. We peek at lddlflags to see if we need -Wl,-R @@ -941,6 +943,10 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP). $libs .= ' -L$(PERL_INC) -Wl,-R$(INSTALLARCHLIB)/CORE -Wl,-R$(PERL_ARCHLIB)/CORE -lperl'; } elsif ($Config{'lddlflags'} =~ /-R/) { $libs .= ' -L$(PERL_INC) -R$(INSTALLARCHLIB)/CORE -R$(PERL_ARCHLIB)/CORE -lperl'; + } elsif ( $Is{Android} ) { + # The Android linker will not recognize symbols from + # libperl unless the module explicitly depends on it. + $libs .= ' -L$(PERL_INC) -lperl'; } } @@ -957,6 +963,8 @@ MAKE push @m, <<'MAKE'; $(CHMOD) $(PERM_RWX) $@ + $(NOECHO) $(RM_RF) $(BOOTSTRAP) + - $(CP_NONEMPTY) $(BOOTSTRAP) $(INST_BOOT) $(PERM_RW) MAKE return join('',@m); @@ -1025,7 +1033,7 @@ WARNING my ($abs, $val); if ($self->file_name_is_absolute($name)) { # /foo/bar $abs = $name; - } elsif ($self->canonpath($name) eq + } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # foo $abs = $self->catfile($dir, $name); } else { # foo/bar @@ -1036,8 +1044,6 @@ WARNING print "Executing $abs\n" if ($trace >= 2); my $version_check = qq{$abs -le "require $ver; print qq{VER_OK}"}; - $version_check = "$Config{run} $version_check" - if defined $Config{run} and length $Config{run}; # To avoid using the unportable 2>&1 to suppress STDERR, # we close it before running the command. @@ -1087,7 +1093,7 @@ sub fixin { # stolen from the pink Camel book, more or less open( my $fixin, '<', $file ) or croak "Can't process '$file': $!"; local $/ = "\n"; chomp( my $line = <$fixin> ); - next unless $line =~ s/^\s*\#!\s*//; # Not a shbang file. + next unless $line =~ s/^\s*\#!\s*//; # Not a shebang file. my $shb = $self->_fixin_replace_shebang( $file, $line ); next unless defined $shb; @@ -1162,7 +1168,7 @@ sub _fixin_replace_shebang { 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" @@ -1173,7 +1179,7 @@ sub _fixin_replace_shebang { } # Figure out how to invoke interpreter on this machine. - + my ($does_shbang) = $Config{'sharpbang'} =~ /^\s*\#\!/; my ($shb) = ""; if ($interpreter) { @@ -1263,7 +1269,7 @@ Called by init_main. sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) my($self) = @_; - my(%dir, %xs, %c, %h, %pl_files, %pm); + my(%dir, %xs, %c, %o, %h, %pl_files, %pm); my %ignore = map {( $_ => 1 )} qw(Makefile.PL Build.PL test.pl t); @@ -1271,10 +1277,21 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) $Is{VMS} ? $ignore{"$self->{DISTVNAME}.dir"} = 1 : $ignore{$self->{DISTVNAME}} = 1; + my $distprefix = $Is{VMS} ? qr/^\Q$self->{DISTNAME}\E-v?[\d\.]+\.dir$/i + : qr/^\Q$self->{DISTNAME}\E-v?[\d\.]+$/; + @ignore{map lc, keys %ignore} = values %ignore if $Is{VMS}; + if ( defined $self->{XS} and !defined $self->{C} ) { + my @c_files = grep { m/\.c(pp|xx)?\z/i } values %{$self->{XS}}; + my @o_files = grep { m/(?:.(?:o(?:bj)?)|\$\(OBJ_EXT\))\z/i } values %{$self->{XS}}; + %c = map { $_ => 1 } @c_files; + %o = map { $_ => 1 } @o_files; + } + foreach my $name ($self->lsdir($Curdir)){ next if $name =~ /\#/; + next if $name =~ $distprefix && -d $name; $name = lc($name) if $Is{VMS}; next if $name eq $Curdir or $name eq $Updir or $ignore{$name}; next unless $self->libscan($name); @@ -1301,7 +1318,7 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) ($pl_files{$name} = $name) =~ s/[._]pl\z//i ; } else { - $pm{$name} = $self->catfile($self->{INST_LIBDIR},$name); + $pm{$name} = $self->catfile($self->{INST_LIBDIR},$name); } } elsif ($name =~ /\.(p[ml]|pod)\z/){ $pm{$name} = $self->catfile($self->{INST_LIBDIR},$name); @@ -1316,7 +1333,8 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) $self->{PM} ||= \%pm; my @o_files = @{$self->{C}}; - $self->{O_FILES} = [grep s/\.c(pp|xx|c)?\z/$self->{OBJ_EXT}/i, @o_files]; + %o = (%o, map { $_ => 1 } grep s/\.c(pp|xx|c)?\z/$self->{OBJ_EXT}/i, @o_files); + $self->{O_FILES} = [sort keys %o]; } @@ -1380,7 +1398,7 @@ sub init_MAN1PODS { next unless $self->_has_pod($name); $self->{MAN1PODS}->{$name} = - $self->catfile("\$(INST_MAN1DIR)", + $self->catfile("\$(INST_MAN1DIR)", basename($name).".\$(MAN1EXT)"); } } @@ -1412,7 +1430,7 @@ sub init_MAN3PODS { my $parentlibs_re = join '|', @{$self->{PMLIBPARENTDIRS}}; # Remove "Configure.pm" and similar, if it's not the only pod listed - # To force inclusion, just name it "Configure.pod", or override + # To force inclusion, just name it "Configure.pod", or override # MAN3PODS foreach my $name (keys %manifypods) { if ($self->{PERL_CORE} and $name =~ /(config|setup).*\.pm/is) { @@ -1517,7 +1535,7 @@ sub init_PM { my $striplibpath; my $parentlibs_re = join '|', @{$self->{PMLIBPARENTDIRS}}; - $prefix = $self->{INST_LIB} + $prefix = $self->{INST_LIB} if ($striplibpath = $path) =~ s{^(\W*)($parentlibs_re)\W} {$1}i; @@ -1543,7 +1561,7 @@ sub init_DIRFILESEP { $self->{DIRFILESEP} = '/'; } - + =item init_main @@ -1579,6 +1597,8 @@ sub init_main { # Some systems have restrictions on files names for DLL's etc. # mod2fname returns appropriate file base name (typically truncated) # It may also edit @modparts if required. + # We require DynaLoader to make sure that mod2fname is loaded + eval { require DynaLoader }; if (defined &DynaLoader::mod2fname) { $modfname = &DynaLoader::mod2fname(\@modparts); } @@ -1620,18 +1640,9 @@ sub init_main { if ($self->{PERL_SRC}){ $self->{PERL_LIB} ||= $self->catdir("$self->{PERL_SRC}","lib"); - if (defined $Cross::platform) { - $self->{PERL_ARCHLIB} = - $self->catdir("$self->{PERL_SRC}","xlib",$Cross::platform); - $self->{PERL_INC} = - $self->catdir("$self->{PERL_SRC}","xlib",$Cross::platform, - $Is{Win32}?("CORE"):()); - } - else { - $self->{PERL_ARCHLIB} = $self->{PERL_LIB}; - $self->{PERL_INC} = ($Is{Win32}) ? - $self->catdir($self->{PERL_LIB},"CORE") : $self->{PERL_SRC}; - } + $self->{PERL_ARCHLIB} = $self->{PERL_LIB}; + $self->{PERL_INC} = ($Is{Win32}) ? + $self->catdir($self->{PERL_LIB},"CORE") : $self->{PERL_SRC}; # catch a situation that has occurred a few times in the past: unless ( @@ -1688,7 +1699,18 @@ from the perl source tree. EOP } } - } + } + } + + if ($Is{Android}) { + # Android fun times! + # ../../perl -I../../lib -MFile::Glob -e1 works + # ../../../perl -I../../../lib -MFile::Glob -e1 fails to find + # the .so for File::Glob. + # This always affects core perl, but may also affect an installed + # perl built with -Duserelocatableinc. + $self->{PERL_LIB} = File::Spec->rel2abs($self->{PERL_LIB}); + $self->{PERL_ARCHLIB} = File::Spec->rel2abs($self->{PERL_ARCHLIB}); } # We get SITELIBEXP and SITEARCHEXP directly via @@ -1755,6 +1777,7 @@ sub init_tools { $self->{RM_RF} ||= "rm -rf"; $self->{TOUCH} ||= "touch"; $self->{TEST_F} ||= "test -f"; + $self->{TEST_S} ||= "test -s"; $self->{CP} ||= "cp"; $self->{MV} ||= "mv"; $self->{CHMOD} ||= "chmod"; @@ -1806,7 +1829,7 @@ sub init_lib2arch { # architecture. If not we take it as a sign that it should be the # same as the requested installation directory. Otherwise we take # the found one. - for my $libpair ({l=>"privlib", a=>"archlib"}, + for my $libpair ({l=>"privlib", a=>"archlib"}, {l=>"sitelib", a=>"sitearch"}, {l=>"vendorlib", a=>"vendorarch"}, ) @@ -1820,7 +1843,7 @@ sub init_lib2arch { $self->prefixify($Arch,$ilib,$self->{$Lib}); unless (-d $self->{$Arch}) { - print "Directory $self->{$Arch} not found\n" + print "Directory $self->{$Arch} not found\n" if $Verbose; $self->{$Arch} = $self->{$Lib}; } @@ -1854,15 +1877,15 @@ sub init_PERL { my($self) = shift; my @defpath = (); - foreach my $component ($self->{PERL_SRC}, $self->path(), - $Config{binexp}) + foreach my $component ($self->{PERL_SRC}, $self->path(), + $Config{binexp}) { push @defpath, $component if defined $component; } # Build up a set of file names (not command names). my $thisperl = $self->canonpath($^X); - $thisperl .= $Config{exe_ext} unless + $thisperl .= $Config{exe_ext} unless # VMS might have a file version # at the end $Is{VMS} ? $thisperl =~ m/$Config{exe_ext}(;\d+)?$/i : $thisperl =~ m/$Config{exe_ext}$/i; @@ -1872,9 +1895,9 @@ sub init_PERL { my @perls = ($thisperl); push @perls, map { "$_$Config{exe_ext}" } - ('perl', 'perl5', "perl$Config{version}"); + ("perl$Config{version}", 'perl5', 'perl'); - # miniperl has priority over all but the cannonical perl when in the + # miniperl has priority over all but the canonical perl when in the # core. Otherwise its a last resort. my $miniperl = "miniperl$Config{exe_ext}"; if( $self->{PERL_CORE} ) { @@ -1891,13 +1914,13 @@ sub init_PERL { # When built for debugging, VMS doesn't create perl.exe but ndbgperl.exe. my $perl_name = 'perl'; - $perl_name = 'ndbgperl' if $Is{VMS} && + $perl_name = 'ndbgperl' if $Is{VMS} && defined $Config{usevmsdebug} && $Config{usevmsdebug} eq 'define'; # XXX This logic is flawed. If "miniperl" is anywhere in the path # it will get confused. It should be fixed to work only on the filename. # Define 'FULLPERL' to be a non-miniperl (used in test: target) - ($self->{FULLPERL} = $self->{PERL}) =~ s/miniperl/$perl_name/i + ($self->{FULLPERL} = $self->{PERL}) =~ s/\Q$miniperl\E$/$perl_name$Config{exe_ext}/i unless $self->{FULLPERL}; # Little hack to get around VMS's find_perl putting "MCR" in front @@ -1928,10 +1951,10 @@ sub init_PERL { $self->{$run} = "\$($perl)"; # Make sure perl can find itself before it's installed. - $self->{$run} .= q{ "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)"} + $self->{$run} .= q{ "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)"} if $self->{UNINSTALLED_PERL} || $self->{PERL_CORE}; - $self->{$perl.'RUNINST'} = + $self->{$perl.'RUNINST'} = sprintf q{$(%sRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"}, $perl; } @@ -2003,18 +2026,18 @@ sub init_xs { my $self = shift; if ($self->has_link_code()) { - $self->{INST_STATIC} = + $self->{INST_STATIC} = $self->catfile('$(INST_ARCHAUTODIR)', '$(BASEEXT)$(LIB_EXT)'); - $self->{INST_DYNAMIC} = + $self->{INST_DYNAMIC} = $self->catfile('$(INST_ARCHAUTODIR)', '$(DLBASE).$(DLEXT)'); - $self->{INST_BOOT} = + $self->{INST_BOOT} = $self->catfile('$(INST_ARCHAUTODIR)', '$(BASEEXT).bs'); } else { $self->{INST_STATIC} = ''; $self->{INST_DYNAMIC} = ''; $self->{INST_BOOT} = ''; } -} +} =item install (o) @@ -2053,9 +2076,15 @@ doc__install : doc_site_install pure_perl_install :: all $(NOECHO) $(MOD_INSTALL) \ - read }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \ +}; + + push @m, +q{ read }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \ write }.$self->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \ - $(INST_LIB) $(DESTINSTALLPRIVLIB) \ +} unless $self->{NO_PACKLIST}; + + push @m, +q{ $(INST_LIB) $(DESTINSTALLPRIVLIB) \ $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \ $(INST_BIN) $(DESTINSTALLBIN) \ $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \ @@ -2067,9 +2096,14 @@ pure_perl_install :: all pure_site_install :: all $(NOECHO) $(MOD_INSTALL) \ - read }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \ +}; + push @m, +q{ read }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \ write }.$self->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q{ \ - $(INST_LIB) $(DESTINSTALLSITELIB) \ +} unless $self->{NO_PACKLIST}; + + push @m, +q{ $(INST_LIB) $(DESTINSTALLSITELIB) \ $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \ $(INST_BIN) $(DESTINSTALLSITEBIN) \ $(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \ @@ -2080,15 +2114,35 @@ pure_site_install :: all pure_vendor_install :: all $(NOECHO) $(MOD_INSTALL) \ - read }.$self->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \ +}; + push @m, +q{ read }.$self->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \ write }.$self->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').q{ \ - $(INST_LIB) $(DESTINSTALLVENDORLIB) \ +} unless $self->{NO_PACKLIST}; + + push @m, +q{ $(INST_LIB) $(DESTINSTALLVENDORLIB) \ $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \ $(INST_BIN) $(DESTINSTALLVENDORBIN) \ $(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \ $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \ $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) +}; + + push @m, q{ +doc_perl_install :: all + $(NOECHO) $(NOOP) + +doc_site_install :: all + $(NOECHO) $(NOOP) + +doc_vendor_install :: all + $(NOECHO) $(NOOP) + +} if $self->{NO_PERLLOCAL}; + + push @m, q{ doc_perl_install :: all $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) @@ -2122,7 +2176,7 @@ doc_vendor_install :: all EXE_FILES "$(EXE_FILES)" \ >> }.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{ -}; +} unless $self->{NO_PERLLOCAL}; push @m, q{ uninstall :: uninstall_from_$(INSTALLDIRS)dirs @@ -2332,7 +2386,7 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib # Skip perl's libraries. return if m/^libperl/ or m/^perl\Q$self->{LIB_EXT}\E$/; - # Skip purified versions of libraries + # Skip purified versions of libraries # (e.g., DynaLoader_pure_p1_c0_032.a) return if m/_pure_\w+_\w+_\w+\.\w+$/ and -f "$File::Find::dir/.pure"; @@ -2367,7 +2421,7 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib # don't include the installed version of this extension. I # leave this line here, although it is not necessary anymore: # I patched minimod.PL instead, so that Miniperl.pm won't - # enclude duplicates + # include duplicates # Once the patch to minimod.PL is in the distribution, I can # drop it @@ -2518,8 +2572,12 @@ $(OBJECT) : $(FIRST_MAKEFILE) my $newer_than_target = $Is{VMS} ? '$(MMS$SOURCE_LIST)' : '$?'; my $mpl_args = join " ", map qq["$_"], @ARGV; - - $m .= sprintf <<'MAKE_FRAG', $newer_than_target, $mpl_args; + my $cross = ''; + if (defined $::Cross::platform) { + # Inherited from win32/buildext.pl + $cross = "-MCross=$::Cross::platform "; + } + $m .= sprintf <<'MAKE_FRAG', $newer_than_target, $cross, $mpl_args; # We take a very conservative approach here, but it's worth it. # We move Makefile to Makefile.old here to avoid gnu make looping. $(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) @@ -2528,7 +2586,7 @@ $(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) -$(NOECHO) $(RM_F) $(MAKEFILE_OLD) -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL) - $(PERLRUN) Makefile.PL %s + $(PERLRUN) %sMakefile.PL %s $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <==" $(FALSE) @@ -2563,7 +2621,7 @@ sub needs_linking { my($self) = shift; my $caller = (caller(0))[3]; - confess("needs_linking called too early") if + confess("needs_linking called too early") if $caller =~ /^ExtUtils::MakeMaker::/; return $self->{NEEDS_LINKING} if defined $self->{NEEDS_LINKING}; if ($self->has_link_code or $self->{MAKEAPERL}){ @@ -2599,9 +2657,15 @@ sub parse_abstract { $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; next if !$inpod; chop; - next unless /^($package(?:\.pm)? \s+ -+ \s+)(.*)/x; - $result = $2; - last; + if ( /^($package(?:\.pm)? \s+ -+ \s+)(.*)/x ) { + $result = $2; + next; + } + next unless $result; + if ( $result && ( /^\s*$/ || /^\=/ ) ) { + last; + } + $result = join ' ', $result, $_; } close $fh; @@ -2645,29 +2709,8 @@ sub parse_version { local $^W = 0; $result = $1; } - elsif ( m{(?<!\\) ([\$*]) (([\w\:\']*) \bVERSION)\b .* =}x ) { - my $eval = qq{ - package ExtUtils::MakeMaker::_version; - no strict; - BEGIN { eval { - # Ensure any version() routine which might have leaked - # into this package has been deleted. Interferes with - # version->import() - undef *version; - require version; - "version"->import; - } } - - local $1$2; - \$$2=undef; - do { - $_ - }; - \$$2; - }; - local $^W = 0; - $result = eval($eval); ## no critic - warn "Could not eval '$eval' in $parsefile: $@" if $@; + elsif ( m{(?<!\\) ([\$*]) (([\w\:\']*) \bVERSION)\b .* (?<![<>=!])\=[^=]}x ) { + $result = $self->get_version($parsefile, $1, $2); } else { next; @@ -2676,10 +2719,44 @@ sub parse_version { } close $fh; + if ( defined $result && $result !~ /^v?[\d_\.]+$/ ) { + require version; + my $normal = eval { version->parse( $result ) }; + $result = $normal if defined $normal; + } $result = "undef" unless defined $result; return $result; } +sub get_version +{ + my ($self, $parsefile, $sigil, $name) = @_; + my $eval = qq{ + package ExtUtils::MakeMaker::_version; + no strict; + BEGIN { eval { + # Ensure any version() routine which might have leaked + # into this package has been deleted. Interferes with + # version->import() + undef *version; + require version; + "version"->import; + } } + + local $sigil$name; + \$$name=undef; + do { + $_ + }; + \$$name; + }; + $eval = $1 if $eval =~ m{^(.+)}s; + local $^W = 0; + my $result = eval($eval); ## no critic + warn "Could not eval '$eval' in $parsefile: $@" if $@; + $result; +} + =item pasthru (o) @@ -2698,7 +2775,7 @@ sub pasthru { foreach my $key (qw(LIB LIBPERL_A LINKTYPE OPTIMIZE PREFIX INSTALL_BASE) - ) + ) { next unless defined $self->{$key}; push @pasthru, "$key=\"\$($key)\""; @@ -2785,7 +2862,8 @@ pm_to_blib : $(FIRST_MAKEFILE) $(TO_INST_PM) pm_to_blib({\@ARGV}, '$autodir', q[\$(PM_FILTER)], '\$(PERM_DIR)') CODE - my @cmds = $self->split_command($pm_to_blib, %{$self->{PM}}); + my @cmds = $self->split_command($pm_to_blib, + map { ($_, $self->{PM}->{$_}) } sort keys %{$self->{PM}}); $r .= join '', map { "\t\$(NOECHO) $_\n" } @cmds; $r .= qq{\t\$(NOECHO) \$(TOUCH) pm_to_blib\n}; @@ -2907,11 +2985,22 @@ PPD_OUT $self->{PPM_INSTALL_EXEC}, $self->{PPM_INSTALL_SCRIPT}; } else { - $ppd_xml .= sprintf qq{ <INSTALL>%s</INSTALL>\n}, + $ppd_xml .= sprintf qq{ <INSTALL>%s</INSTALL>\n}, $self->{PPM_INSTALL_SCRIPT}; } } + if ($self->{PPM_UNINSTALL_SCRIPT}) { + if ($self->{PPM_UNINSTALL_EXEC}) { + $ppd_xml .= sprintf qq{ <UNINSTALL EXEC="%s">%s</UNINSTALL>\n}, + $self->{PPM_UNINSTALL_EXEC}, $self->{PPM_UNINSTALL_SCRIPT}; + } + else { + $ppd_xml .= sprintf qq{ <UNINSTALL>%s</UNINSTALL>\n}, + $self->{PPM_UNINSTALL_SCRIPT}; + } + } + my ($bin_location) = $self->{BINARY_LOCATION} || ''; $bin_location =~ s/\\/\\\\/g; @@ -2936,7 +3025,7 @@ PPD_OUT $MM->prefixify($var, $prefix, $new_prefix, $default); Using either $MM->{uc $var} || $Config{lc $var}, it will attempt to -replace it's $prefix with a $new_prefix. +replace it's $prefix with a $new_prefix. Should the $prefix fail to match I<AND> a PREFIX was given as an argument to WriteMakefile() it will set it to the $new_prefix + @@ -2960,7 +3049,7 @@ simply use '/home/foo/man/man1'. sub prefixify { my($self,$var,$sprefix,$rprefix,$default) = @_; - my $path = $self->{uc $var} || + my $path = $self->{uc $var} || $Config_Override{lc $var} || $Config{lc $var} || ''; $rprefix .= '/' if $sprefix =~ m|/$|; @@ -2969,7 +3058,7 @@ sub prefixify { warn " from $sprefix to $rprefix\n" if $Verbose >= 2; if( $self->{ARGS}{PREFIX} && - $path !~ s{^\Q$sprefix\E\b}{$rprefix}s ) + $path !~ s{^\Q$sprefix\E\b}{$rprefix}s ) { warn " cannot prefix, using default.\n" if $Verbose >= 2; @@ -3103,7 +3192,7 @@ sub oneliner { $switches = join ' ', @$switches; - return qq{\$(ABSPERLRUN) $switches -e $cmd --}; + return qq{\$(ABSPERLRUN) $switches -e $cmd --}; } @@ -3201,10 +3290,10 @@ END $(CP) $(MYEXTLIB) $@ MAKE_FRAG - my $ar; + my $ar; if (exists $self->{FULL_AR} && -x $self->{FULL_AR}) { # Prefer the absolute pathed ar if available so that PATH - # doesn't confuse us. Perl itself is built with the full_ar. + # doesn't confuse us. Perl itself is built with the full_ar. $ar = 'FULL_AR'; } else { $ar = 'AR'; @@ -3274,7 +3363,7 @@ Helper subroutine for subdirs sub subdir_x { my($self, $subdir) = @_; - my $subdir_cmd = $self->cd($subdir, + my $subdir_cmd = $self->cd($subdir, '$(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) all $(PASTHRU)' ); return sprintf <<'EOT', $subdir_cmd; @@ -3325,7 +3414,10 @@ sub test { my($self, %attribs) = @_; my $tests = $attribs{TESTS} || ''; - if (!$tests && -d 't') { + if (!$tests && -d 't' && defined $attribs{RECURSIVE_TEST_FILES}) { + $tests = $self->find_tests_recursive; + } + elsif (!$tests && -d 't') { $tests = $self->find_tests; } # note: 'test.pl' name is also hardcoded in init_dirscan() @@ -3361,14 +3453,14 @@ END push(@m, "\n"); push(@m, "test_dynamic :: pure_all\n"); - push(@m, $self->test_via_harness('$(FULLPERLRUN)', '$(TEST_FILES)')) + push(@m, $self->test_via_harness('$(FULLPERLRUN)', '$(TEST_FILES)')) if $tests; - push(@m, $self->test_via_script('$(FULLPERLRUN)', '$(TEST_FILE)')) + push(@m, $self->test_via_script('$(FULLPERLRUN)', '$(TEST_FILE)')) if -f "test.pl"; push(@m, "\n"); push(@m, "testdb_dynamic :: pure_all\n"); - push(@m, $self->test_via_script('$(FULLPERLRUN) $(TESTDB_SW)', + push(@m, $self->test_via_script('$(FULLPERLRUN) $(TESTDB_SW)', '$(TEST_FILE)')); push(@m, "\n"); @@ -3430,12 +3522,15 @@ sub tool_xsubpp { # Make sure we pick up the new xsubpp if we're building perl. unshift @xsubpp_dirs, $self->{PERL_LIB} if $self->{PERL_CORE}; + my $foundxsubpp = 0; foreach my $dir (@xsubpp_dirs) { $xsdir = $self->catdir($dir, 'ExtUtils'); if( -r $self->catfile($xsdir, "xsubpp") ) { + $foundxsubpp = 1; last; } } + die "ExtUtils::MM_Unix::tool_xsubpp : Can't find xsubpp" if !$foundxsubpp; my $tmdir = File::Spec->catdir($self->{PERL_LIB},"ExtUtils"); my(@tmdeps) = $self->catfile($tmdir,'typemap'); @@ -3456,10 +3551,10 @@ sub tool_xsubpp { } if ($Is{VMS} && - $Config{'ldflags'} && + $Config{'ldflags'} && $Config{'ldflags'} =~ m!/Debug!i && (!exists($self->{XSOPT}) || $self->{XSOPT} !~ /linenumbers/) - ) + ) { unshift(@tmargs,'-nolinenumbers'); } @@ -3474,7 +3569,7 @@ XSUBPPRUN = \$(PERLRUN) \$(XSUBPP) XSPROTOARG = $self->{XSPROTOARG} XSUBPPDEPS = @tmdeps \$(XSUBPP) XSUBPPARGS = @tmargs -XSUBPP_EXTRA_ARGS = +XSUBPP_EXTRA_ARGS = }; }; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm index 13a3b94b692..331cbcd0fa0 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.66'; +our $VERSION = '6.98'; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; @@ -120,10 +120,10 @@ sub guess_name { if (@pm == 1) { ($defpm = $pm[0]) =~ s/.pm$//; } elsif (@pm) { %xs = map { s/.xs$//; ($_,1) } glob('*.xs'); ## no critic - if (keys %xs) { - foreach my $pm (@pm) { - $defpm = $pm, last if exists $xs{$pm}; - } + if (keys %xs) { + foreach my $pm (@pm) { + $defpm = $pm, last if exists $xs{$pm}; + } } } } @@ -200,8 +200,8 @@ sub find_perl { $inabs++ if $self->file_name_is_absolute($dir); if ($inabs == 1) { # We've covered relative dirs; everything else is an absolute - # dir (probably an installed location). First, we'll try - # potential command names, to see whether we can avoid a long + # dir (probably an installed location). First, we'll try + # potential command names, to see whether we can avoid a long # MCR expression. foreach my $name (@snames) { push(@cand,$name) if $name =~ /^[\w\-\$]+$/; @@ -217,7 +217,7 @@ sub find_perl { print "Checking $name\n" if $trace >= 2; # If it looks like a potential command, try it without the MCR if ($name =~ /^[\w\-\$]+$/) { - open(my $tcf, ">", "temp_mmvms.com") + open(my $tcf, ">", "temp_mmvms.com") or die('unable to open temp file'); print $tcf "\$ set message/nofacil/nosever/noident/notext\n"; print $tcf "\$ $name -e \"require $ver; print \"\"VER_OK\\n\"\"\"\n"; @@ -251,7 +251,7 @@ sub find_perl { =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 +actual shebang line that will be interpreted by the shell, so we just prepend $Config{startperl} and preserve the shebang line argument for any switches it may contain. @@ -396,7 +396,7 @@ sub init_DEST { =item init_DIRFILESEP -No seperator between a directory path and a filename on VMS. +No separator between a directory path and a filename on VMS. =cut @@ -438,11 +438,11 @@ sub init_main { } $self->{DEFINE} = ''; - if (@defs) { - $self->{DEFINE} = '/Define=(' . join(',',@defs) . ')'; + if (@defs) { + $self->{DEFINE} = '/Define=(' . join(',',@defs) . ')'; } - if (@udefs) { - $self->{DEFINE} .= '/Undef=(' . join(',',@udefs) . ')'; + if (@udefs) { + $self->{DEFINE} .= '/Undef=(' . join(',',@udefs) . ')'; } } } @@ -487,7 +487,7 @@ sub init_tools { $self->{EQUALIZE_TIMESTAMP} ||= '$(ABSPERLRUN) -we "open F,qq{>>$ARGV[1]};close F;utime(0,(stat($ARGV[0]))[9]+1,$ARGV[1])"'; - $self->{MOD_INSTALL} ||= + $self->{MOD_INSTALL} ||= $self->oneliner(<<'CODE', ['-MExtUtils::Install']); install([ from_to => {split(' ', <STDIN>)}, verbose => '$(VERBINST)', uninstall_shadows => '$(UNINST)', dir_mode => '$(PERM_DIR)' ]); CODE @@ -578,11 +578,11 @@ sub constants { # Cleanup paths for directories in MMS macros. foreach my $macro ( qw [ - INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB + INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB PERL_LIB PERL_ARCHLIB PERL_INC PERL_SRC ], (map { 'INSTALL'.$_ } $self->installvars) - ) + ) { next unless defined $self->{$macro}; next if $macro =~ /MAN/ && $self->{$macro} eq 'none'; @@ -590,8 +590,8 @@ sub constants { } # Cleanup paths for files in MMS macros. - foreach my $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKEFILE_OLD - MAKE_APERL_FILE MYEXTLIB] ) + foreach my $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKEFILE_OLD + MAKE_APERL_FILE MYEXTLIB] ) { next unless defined $self->{$macro}; $self->{$macro} = $self->fixpath($self->{$macro},0); @@ -630,7 +630,7 @@ sub constants { next unless $self ne " " && defined $self->{$macro}; my %tmp = (); for my $key (keys %{$self->{$macro}}) { - $tmp{$self->fixpath($key,0)} = + $tmp{$self->fixpath($key,0)} = $self->fixpath($self->{$macro}{$key},0); } $self->{$macro} = \%tmp; @@ -843,7 +843,7 @@ VMSish defaults for some values. COMPRESS compression command to gzip use for tarfiles - SUFFIX suffix to put on -gz + SUFFIX suffix to put on -gz compressed files SHAR shar command to use vms_share @@ -930,7 +930,7 @@ sub xs_o { # many makes are too dumb to use xs_c then c_o =item dlsyms (override) Create VMS linker options files specifying universal symbols for this -extension's shareable image, and listing other shareable images or +extension's shareable image, and listing other shareable images or libraries to which it should be linked. =cut @@ -969,7 +969,7 @@ $(BASEEXT).opt : Makefile.PL push @m, ' $(PERL) -e "print ""$(INST_STATIC)/Include='; if ($self->{OBJECT} =~ /\bBASEEXT\b/ or - $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) { + $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) { push @m, ($Config{d_vms_case_sensitive_symbols} ? uc($self->{BASEEXT}) :'$(BASEEXT)'); } @@ -1080,7 +1080,7 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) } else { push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n"); } - + push @m, "\t\$(NOECHO) \$(PERL) -e 1 >\$(INST_ARCHAUTODIR)extralibs.ld\n"; foreach my $lib (split ' ', $self->{EXTRALIBS}) { push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n"); @@ -1190,9 +1190,14 @@ doc__install : doc_site_install # This hack brought to you by DCL's 255-character command line limit pure_perl_install :: - $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp +]; + push @m, +q[ $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp - $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLPRIVLIB) " >>.MM_tmp +] unless $self->{NO_PACKLIST}; + + push @m, +q[ $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLPRIVLIB) " >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLARCHLIB) " >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLBIN) " >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp @@ -1204,9 +1209,14 @@ pure_perl_install :: # Likewise pure_site_install :: - $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp +]; + push @m, +q[ $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp - $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLSITELIB) " >>.MM_tmp +] unless $self->{NO_PACKLIST}; + + push @m, +q[ $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLSITELIB) " >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLSITEARCH) " >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLSITEBIN) " >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp @@ -1217,9 +1227,14 @@ pure_site_install :: $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[ pure_vendor_install :: - $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp +]; + push @m, +q[ $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp - $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLVENDORLIB) " >>.MM_tmp +] unless $self->{NO_PACKLIST}; + + push @m, +q[ $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLVENDORLIB) " >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) " >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLVENDORBIN) " >>.MM_tmp $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp @@ -1228,6 +1243,23 @@ pure_vendor_install :: $(NOECHO) $(MOD_INSTALL) <.MM_tmp $(NOECHO) $(RM_F) .MM_tmp +]; + + push @m, q[ +# Ditto +doc_perl_install :: + $(NOECHO) $(NOOP) + +# And again +doc_site_install :: + $(NOECHO) $(NOOP) + +doc_vendor_install :: + $(NOECHO) $(NOOP) + +] if $self->{NO_PERLLOCAL}; + + push @m, q[ # Ditto doc_perl_install :: $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q[" @@ -1254,7 +1286,7 @@ doc_vendor_install :: $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[ $(NOECHO) $(RM_F) .MM_tmp -]; +] unless $self->{NO_PERLLOCAL}; push @m, q[ uninstall :: uninstall_from_$(INSTALLDIRS)dirs @@ -1347,7 +1379,7 @@ our %olbs; # needs to be localized sub makeaperl { my($self, %attribs) = @_; - my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmpdir, $libperl) = + my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmpdir, $libperl) = @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)}; my(@m); push @m, " @@ -1428,7 +1460,7 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE) # We trust that what has been handed in as argument will be buildable $static = [] unless $static; @olbs{@{$static}} = (1) x @{$static}; - + $extra = [] unless $extra && ref $extra eq 'ARRAY'; # Sort the object libraries in inverse order of # filespec length to try to insure that dependent extensions @@ -1621,12 +1653,12 @@ sub prefixify { $rprefix = vmspath($rprefix) if $rprefix; $sprefix = vmspath($sprefix) if $sprefix; - $default = vmsify($default) + $default = vmsify($default) unless $default =~ /\[.*\]/; (my $var_no_install = $var) =~ s/^install//; - my $path = $self->{uc $var} || - $ExtUtils::MM_Unix::Config_Override{lc $var} || + my $path = $self->{uc $var} || + $ExtUtils::MM_Unix::Config_Override{lc $var} || $Config{lc $var} || $Config{lc $var_no_install}; if( !$path ) { @@ -1764,7 +1796,7 @@ sub echo { my $ql_opts = { allow_variables => $opts->{allow_variables} }; my @cmds = ("\$(NOECHO) $opencmd MMECHOFILE $file "); - push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_, $ql_opts) } + push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_, $ql_opts) } split /\n/, $text; push @cmds, '$(NOECHO) Close MMECHOFILE'; return @cmds; @@ -1931,7 +1963,7 @@ sub eliminate_macros { my($head,$macro,$tail); # perform m##g in scalar context so it acts as an iterator - while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { + while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { if (defined $self->{$2}) { ($head,$macro,$tail) = ($1,$2,$3); if (ref $self->{$macro}) { @@ -1987,7 +2019,7 @@ sub fixpath { split /[ \t]+/, $path; } - if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { + if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) { $fixedpath = vmspath($self->eliminate_macros($path)); } diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_VOS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VOS.pm index feeca59728b..648ba5401b6 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.66'; +our $VERSION = '6.98'; 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 34499d30b1a..e056d2eacc5 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win32.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win32.pm @@ -17,7 +17,7 @@ See ExtUtils::MM_Unix for a documentation of the methods provided there. This package overrides the implementation of these methods, not the semantics. -=cut +=cut use ExtUtils::MakeMaker::Config; use File::Basename; @@ -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.66'; +our $VERSION = '6.98'; $ENV{EMXSHELL} = 'sh'; # to run `commands` @@ -153,8 +153,8 @@ sub init_tools { $self->{NOOP} ||= 'rem'; $self->{DEV_NULL} ||= '> NUL'; - $self->{FIXIN} ||= $self->{PERL_CORE} ? - "\$(PERLRUN) $self->{PERL_SRC}/win32/bin/pl2bat.pl" : + $self->{FIXIN} ||= $self->{PERL_CORE} ? + "\$(PERLRUN) $self->{PERL_SRC}/win32/bin/pl2bat.pl" : 'pl2bat.bat'; $self->SUPER::init_tools; @@ -251,7 +251,7 @@ sub constants { # # This has to come here before all the constants and not in # platform_constants which is after constants. - my $size = $self->{MAXLINELENGTH} || 64 * 1024; + my $size = $self->{MAXLINELENGTH} || 800000; my $prefix = qq{ # Get dmake to read long commands like PM_TO_BLIB MAXLINELENGTH = $size @@ -349,7 +349,7 @@ INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) '); if ($GCC) { - push(@m, + push(@m, q{ }.$DLLTOOL.q{ --def $(EXPORT_LIST) --output-exp dll.exp $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp }.$DLLTOOL.q{ --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp @@ -513,7 +513,7 @@ sub quote_literal { # $(MACRO)s in makefiles. s{([<>|&^@!])}{^$1}g foreach grep { !/^"[^"]*"$/ } @text; $text = join('', @text); - + # dmake expands {{ to { and }} to }. if( $self->is_make_type('dmake') ) { $text =~ s/{/{{/g; @@ -632,6 +632,6 @@ __END__ =back -=cut +=cut diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win95.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_Win95.pm index 9b3b3b85ba8..9c7958058c2 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.66'; +our $VERSION = '6.98'; require ExtUtils::MM_Win32; our @ISA = qw(ExtUtils::MM_Win32); @@ -62,7 +62,7 @@ sub xs_cpp { '; } -=item xs_o +=item xs_o The && problem. @@ -116,7 +116,7 @@ Currently maintained by Michael G Schwern C<schwern@pobox.com>. Send patches and ideas to C<makemaker@perl.org>. -See http://www.makemaker.org. +See https://metacpan.org/release/ExtUtils-MakeMaker. =cut diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MY.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MY.pm index 2f01658a545..37f0e9e29d1 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.66'; +our $VERSION = '6.98'; our @ISA = qw(ExtUtils::MM); { diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker.pm index f271ef79282..d2fabf6b282 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.66'; +our $VERSION = '6.98'; $VERSION = eval $VERSION; ## no critic [BuiltinFunctions::ProhibitStringyEval] # Emulate something resembling CVS $Revision$ @@ -32,7 +32,7 @@ our @EXPORT = qw(&WriteMakefile &writeMakefile $Verbose &prompt); our @EXPORT_OK = qw($VERSION &neatvalue &mkbootstrap &mksymlists &WriteEmptyMakefile); -# These will go away once the last of the Win32 & VMS specific code is +# These will go away once the last of the Win32 & VMS specific code is # purged. my $Is_VMS = $^O eq 'VMS'; my $Is_Win32 = $^O eq 'MSWin32'; @@ -54,7 +54,7 @@ sub WriteMakefile { my %att = @_; _convert_compat_attrs(\%att); - + _verify_att(\%att); my $mm = MM->new(\%att); @@ -87,6 +87,7 @@ my %Special_Sigs = ( MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', + OBJECT => ['ARRAY', ''], PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', @@ -168,7 +169,7 @@ sub _is_of_type { sub _format_att { my $given = shift; - + return $given eq '' ? "string/number" : uc $given eq $given ? "$given reference" : "$given object" @@ -178,7 +179,7 @@ sub _format_att { sub prompt ($;$) { ## no critic my($mess, $def) = @_; - confess("prompt function called without an argument") + confess("prompt function called without an argument") unless defined $mess; my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ; @@ -197,7 +198,7 @@ sub prompt ($;$) { ## no critic else { $ans = <STDIN>; if( defined $ans ) { - chomp $ans; + $ans =~ s{\015?\012$}{}; } else { # user hit ctrl-D print "\n"; @@ -269,19 +270,19 @@ sub full_setup { INSTALLSITEMAN1DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN1DIR INSTALLVENDORMAN3DIR INSTALLSCRIPT INSTALLSITESCRIPT INSTALLVENDORSCRIPT - PERL_LIB PERL_ARCHLIB - SITELIBEXP SITEARCHEXP + PERL_LIB PERL_ARCHLIB + SITELIBEXP SITEARCHEXP 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 NO_MYMETA + MYEXTLIB NAME NEEDS_LINKING NOECHO NO_META NO_MYMETA NO_PACKLIST NO_PERLLOCAL 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 - SIGN SKIP TEST_REQUIRES TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG + PERL_SRC PERM_DIR PERM_RW PERM_RWX MAGICXS + PL_FILES PM PM_FILTER PMLIBDIRS PMLIBPARENTDIRS POLLUTE PPM_INSTALL_EXEC PPM_UNINSTALL_EXEC + PPM_INSTALL_SCRIPT PPM_UNINSTALL_SCRIPT PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ + SIGN SKIP TEST_REQUIRES TYPEMAPS UNINST VERSION VERSION_FROM XS XSOPT XSPROTOARG XS_VERSION clean depend dist dynamic_lib linkext macro realclean tool_autosplit @@ -300,11 +301,11 @@ sub full_setup { # in Overridable we have subroutines that are used indirectly - @MM_Sections = + @MM_Sections = qw( - post_initialize const_config constants platform_constants - tool_autosplit tool_xsubpp tools_other + post_initialize const_config constants platform_constants + tool_autosplit tool_xsubpp tools_other makemakerdflt @@ -315,10 +316,10 @@ sub full_setup { special_targets c_o xs_c xs_o - top_targets blibdirs linkext dlsyms dynamic dynamic_bs + top_targets blibdirs linkext dlsyms dynamic_bs dynamic dynamic_lib static static_lib manifypods processPL installbin subdirs - clean_subdirs clean realclean_subdirs realclean + clean_subdirs clean realclean_subdirs realclean metafile signature dist_basics dist_core distdir dist_test dist_ci distmeta distsignature install force perldepend makefile staticmake test ppd @@ -329,7 +330,7 @@ sub full_setup { push @Overridable, qw[ libscan makeaperl needs_linking - subdir_x test_via_harness test_via_script + subdir_x test_via_harness test_via_script init_VERSION init_dist init_INST init_INSTALL init_DEST init_dirscan init_PM init_MANPODS init_xs init_PERL init_DIRFILESEP init_linker @@ -349,10 +350,10 @@ sub full_setup { @Recognized_Att_Keys{@MM_Sections} = (1) x @MM_Sections; # we will use all these variables in the Makefile - @Get_from_Config = + @Get_from_Config = qw( - ar cc cccdlflags ccdlflags dlext dlsrc exe_ext full_ar ld - lddlflags ldflags libc lib_ext obj_ext osname osvers ranlib + ar cc cccdlflags ccdlflags dlext dlsrc exe_ext full_ar ld + lddlflags ldflags libc lib_ext obj_ext osname osvers ranlib sitelibexp sitearchexp so ); @@ -440,14 +441,27 @@ sub new { check_hints($self); + if ( defined $self->{MIN_PERL_VERSION} + && $self->{MIN_PERL_VERSION} !~ /^v?[\d_\.]+$/ ) { + require version; + my $normal = eval { + local $SIG{__WARN__} = sub { + # simulate "use warnings FATAL => 'all'" for vintage perls + die @_; + }; + version->parse( $self->{MIN_PERL_VERSION} ) + }; + $self->{MIN_PERL_VERSION} = $normal if defined $normal && !$@; + } + # Translate X.Y.Z to X.00Y00Z if( defined $self->{MIN_PERL_VERSION} ) { - $self->{MIN_PERL_VERSION} =~ s{ ^ (\d+) \. (\d+) \. (\d+) $ } + $self->{MIN_PERL_VERSION} =~ s{ ^v? (\d+) \. (\d+) \. (\d+) $ } {sprintf "%d.%03d%03d", $1, $2, $3}ex; } my $perl_version_ok = eval { - local $SIG{__WARN__} = sub { + local $SIG{__WARN__} = sub { # simulate "use warnings FATAL => 'all'" for vintage perls die @_; }; @@ -481,16 +495,30 @@ END foreach my $prereq (sort keys %$prereqs) { my $required_version = $prereqs->{$prereq}; - my $installed_file = MM->_installed_file_for_module($prereq); my $pr_version = 0; - $pr_version = MM->parse_version($installed_file) if $installed_file; - $pr_version = 0 if $pr_version eq 'undef'; + my $installed_file; + + if ( $prereq eq 'perl' ) { + if ( defined $required_version && $required_version =~ /^v?[\d_\.]+$/ + || $required_version !~ /^v?[\d_\.]+$/ ) { + require version; + my $normal = eval { version->parse( $required_version ) }; + $required_version = $normal if defined $normal; + } + $installed_file = $prereq; + $pr_version = $]; + } + else { + $installed_file = MM->_installed_file_for_module($prereq); + $pr_version = MM->parse_version($installed_file) if $installed_file; + $pr_version = 0 if $pr_version eq 'undef'; + } # convert X.Y_Z alpha version #s to X.YZ for easier comparisons $pr_version =~ s/(\d+)\.(\d+)_(\d+)/$1.$2$3/; if (!$installed_file) { - warn sprintf "Warning: prerequisite %s %s not found.\n", + warn sprintf "Warning: prerequisite %s %s not found.\n", $prereq, $required_version unless $self->{PREREQ_FATAL} or $ENV{PERL_CORE}; @@ -499,7 +527,7 @@ END } elsif ($pr_version < $required_version ){ warn sprintf "Warning: prerequisite %s %s not found. We have %s.\n", - $prereq, $required_version, ($pr_version || 'unknown version') + $prereq, $required_version, ($pr_version || 'unknown version') unless $self->{PREREQ_FATAL} or $ENV{PERL_CORE}; @@ -508,7 +536,7 @@ END } if (%unsatisfied && $self->{PREREQ_FATAL}){ - my $failedprereqs = join "\n", map {" $_ $unsatisfied{$_}"} + my $failedprereqs = join "\n", map {" $_ $unsatisfied{$_}"} sort { $a cmp $b } keys %unsatisfied; die <<"END"; MakeMaker FATAL: prerequisites not found. @@ -517,7 +545,7 @@ $failedprereqs Please install these modules first and rerun 'perl Makefile.PL'. END } - + if (defined $self->{CONFIGURE}) { if (ref $self->{CONFIGURE} eq 'CODE') { %configure_att = %{&{$self->{CONFIGURE}}}; @@ -574,7 +602,7 @@ END } if ($self->{PARENT}) { $self->{PARENT}->{CHILDREN}->{$newclass} = $self; - foreach my $opt (qw(POLLUTE PERL_CORE LINKTYPE)) { + foreach my $opt (qw(POLLUTE PERL_CORE LINKTYPE LD OPTIMIZE)) { if (exists $self->{PARENT}->{$opt} and not exists $self->{$opt}) { @@ -585,13 +613,28 @@ END } my @fm = grep /^FIRST_MAKEFILE=/, @ARGV; parse_args($self,@fm) if @fm; - } else { - parse_args($self,split(' ', $ENV{PERL_MM_OPT} || ''),@ARGV); + } + else { + parse_args($self, _shellwords($ENV{PERL_MM_OPT} || ''),@ARGV); } + # RT#91540 PREREQ_FATAL not recognized on command line + if (%unsatisfied && $self->{PREREQ_FATAL}){ + my $failedprereqs = join "\n", map {" $_ $unsatisfied{$_}"} + sort { $a cmp $b } keys %unsatisfied; + die <<"END"; +MakeMaker FATAL: prerequisites not found. +$failedprereqs + +Please install these modules first and rerun 'perl Makefile.PL'. +END + } $self->{NAME} ||= $self->guess_name; + warn "Warning: NAME must be a package name\n" + unless $self->{NAME} =~ m!^[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*$!; + ($self->{NAME_SYM} = $self->{NAME}) =~ s/\W+/_/g; $self->init_MAKE; @@ -799,6 +842,83 @@ END return @result; } +# _shellwords and _parseline borrowed from Text::ParseWords +sub _shellwords { + my (@lines) = @_; + my @allwords; + + foreach my $line (@lines) { + $line =~ s/^\s+//; + my @words = _parse_line('\s+', 0, $line); + pop @words if (@words and !defined $words[-1]); + return() unless (@words || !length($line)); + push(@allwords, @words); + } + return(@allwords); +} + +sub _parse_line { + my($delimiter, $keep, $line) = @_; + my($word, @pieces); + + no warnings 'uninitialized'; # we will be testing undef strings + + while (length($line)) { + # This pattern is optimised to be stack conservative on older perls. + # Do not refactor without being careful and testing it on very long strings. + # See Perl bug #42980 for an example of a stack busting input. + $line =~ s/^ + (?: + # double quoted string + (") # $quote + ((?>[^\\"]*(?:\\.[^\\"]*)*))" # $quoted + | # --OR-- + # singe quoted string + (') # $quote + ((?>[^\\']*(?:\\.[^\\']*)*))' # $quoted + | # --OR-- + # unquoted string + ( # $unquoted + (?:\\.|[^\\"'])*? + ) + # followed by + ( # $delim + \Z(?!\n) # EOL + | # --OR-- + (?-x:$delimiter) # delimiter + | # --OR-- + (?!^)(?=["']) # a quote + ) + )//xs or return; # extended layout + my ($quote, $quoted, $unquoted, $delim) = (($1 ? ($1,$2) : ($3,$4)), $5, $6); + + + return() unless( defined($quote) || length($unquoted) || length($delim)); + + if ($keep) { + $quoted = "$quote$quoted$quote"; + } + else { + $unquoted =~ s/\\(.)/$1/sg; + if (defined $quote) { + $quoted =~ s/\\(.)/$1/sg if ($quote eq '"'); + #$quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'"); + } + } + $word .= substr($line, 0, 0); # leave results tainted + $word .= defined $quote ? $quoted : $unquoted; + + if (length($delim)) { + push(@pieces, $word); + push(@pieces, $delim) if ($keep eq 'delimiters'); + undef $word; + } + if (!length($line)) { + push(@pieces, $word); + } + } + return(@pieces); +} sub check_manifest { print "Checking if your kit is complete...\n"; @@ -941,9 +1061,9 @@ sub mv_all_methods { # still trying to reduce the list to some reasonable minimum -- # because I want to make it easier for the user. A.K. - local $SIG{__WARN__} = sub { + local $SIG{__WARN__} = sub { # can't use 'no warnings redefined', 5.6 only - warn @_ unless $_[0] =~ /^Subroutine .* redefined/ + warn @_ unless $_[0] =~ /^Subroutine .* redefined/ }; foreach my $method (@Overridable) { @@ -978,7 +1098,7 @@ sub mv_all_methods { # We have to clean out %INC also, because the current directory is # changed frequently and Graham Barr prefers to get his version - # out of a History.pl file which is "required" so woudn't get + # out of a History.pl file which is "required" so wouldn't get # loaded again in another extension requiring a History.pl # With perl5.002_01 the deletion of entries in %INC caused Tk-b11 @@ -1023,7 +1143,20 @@ sub skipcheck { sub flush { my $self = shift; + # This needs a bit more work for more wacky OSen + my $type = 'Unix-style'; + if ( $self->os_flavor_is('Win32') ) { + my $make = $self->make; + $make = +( File::Spec->splitpath( $make ) )[-1]; + $make =~ s!\.exe$!!i; + $type = $make . '-style'; + } + elsif ( $Is_VMS ) { + $type = $Config{make} . '-style'; + } + my $finalname = $self->{MAKEFILE}; + print "Generating a $type $finalname\n"; print "Writing $finalname for $self->{NAME}\n"; unlink($finalname, "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : ()); @@ -1127,7 +1260,7 @@ sub clean_versions { for my $module (keys %$reqs) { my $version = $reqs->{$module}; - if( !defined $version or $version !~ /^[\d_\.]+$/ ) { + if( !defined $version or $version !~ /^v?[\d_\.]+$/ ) { carp "Unparsable version '$version' for prerequisite $module"; $reqs->{$module} = 0; } @@ -1237,6 +1370,11 @@ C<TEST_VERBOSE> variable to true. make test TEST_VERBOSE=1 +If you want to run particular test files, set the C<TEST_FILES> variable. +It is possible to use globbing with this mechanism. + + make test TEST_FILES='t/foobar.t t/dagobah*.t' + =head2 make testdb A useful variation of the above is the target C<testdb>. It runs the @@ -1291,7 +1429,7 @@ searched by perl, run perl -le 'print join $/, @INC' Sometimes older versions of the module you're installing live in other -directories in @INC. Because Perl loads the first version of a module it +directories in @INC. Because Perl loads the first version of a module it finds, not the newest, you might accidentally get one of these older versions even after installing a brand new version. To delete I<all other versions of the module you're installing> (not simply older ones) set the @@ -1379,8 +1517,8 @@ relatives, then the defaults for INSTALLPRIVLIB, INSTALLARCHLIB, INSTALLSCRIPT, etc. will be appropriate, and this incantation will be the best: - perl Makefile.PL; - make; + perl Makefile.PL; + make; make test make install @@ -1520,7 +1658,11 @@ recommends it (or you know what you're doing). =head2 Using Attributes and Parameters The following attributes may be specified as arguments to WriteMakefile() -or as NAME=VALUE pairs on the command line. +or as NAME=VALUE pairs on the command line. Attributes that became +available with later versions of MakeMaker are indicated. + +In order to maintain portability of attributes with older versions of +MakeMaker you may want to use L<App::EUMM::Upgrade> with your C<Makefile.PL>. =over 2 @@ -1553,10 +1695,13 @@ located in the C<x86> directory relative to the PPD itself. =item BUILD_REQUIRES +Available in version 6.5503 and above. + A hash of modules that are needed to build your module but not run it. -This will go into the C<build_requires> field of your CPAN Meta file. -(F<META.yml> or F<META.json>). +This will go into the C<build_requires> field of your F<META.yml> and the C<build> of the C<prereqs> field of your F<META.json>. + +Defaults to C<<< { "ExtUtils::MakeMaker" => 0 } >>> if this attribute is not specified. The format is the same as PREREQ_PM. @@ -1600,13 +1745,14 @@ be determined by some evaluation method. =item CONFIGURE_REQUIRES +Available in version 6.52 and above. + A hash of modules that are required to run Makefile.PL itself, but not to run your distribution. -This will go into the C<configure_requires> field of your CPAN Meta file -(F<META.yml> or F<META.json>) +This will go into the C<configure_requires> field of your F<META.yml> and the C<configure> of the C<prereqs> field of your F<META.json>. -Defaults to C<<< { "ExtUtils::MakeMaker" => 0 } >>> +Defaults to C<<< { "ExtUtils::MakeMaker" => 0 } >>> if this attribute is not specified. The format is the same as PREREQ_PM. @@ -1633,7 +1779,7 @@ in ext/SDBM_File =item DISTNAME -A safe filename for the package. +A safe filename for the package. Defaults to NAME below but with :: replaced with -. @@ -1652,6 +1798,18 @@ For example, version 1.04 of Foo::Bar becomes Foo-Bar-1.04. On some OS's where . has special meaning VERSION_SYM may be used in place of VERSION. +=item DLEXT + +Specifies the extension of the module's loadable object. For example: + + DLEXT => 'unusual_ext', # Default value is $Config{so} + +NOTE: When using this option to alter the extension of a module's +loadable object, it is also necessary that the module's pm file +specifies the same change: + + local $DynaLoader::dl_dlext = 'unusual_ext'; + =item DL_FUNCS Hashref of symbol names for routines to be made available as universal @@ -1812,7 +1970,7 @@ directory if INSTALLDIRS is set to site (default). =item INSTALLSITEMAN3DIR These directories get the man pages at 'make install' time if -INSTALLDIRS=site (default). Defaults to +INSTALLDIRS=site (default). Defaults to $(SITEPREFIX)/man/man$(MAN*EXT). If set to 'none', no man pages will be installed. @@ -1936,10 +2094,12 @@ MakeMaker will turn it into an array with one element. =item LICENSE -The licensing terms of your distribution. Generally it's "perl" for the +Available in version 6.31 and above. + +The licensing terms of your distribution. Generally it's "perl_5" for the same license as Perl itself. -See L<Module::Build::API> for the list of options. +See L<CPAN::Meta::Spec> for the list of options. Defaults to "unknown". @@ -1949,6 +2109,10 @@ Defaults to "unknown". config.sh). Should only be used to force static linking (also see linkext below). +=item MAGICXS + +When this is set to C<1>, C<OBJECT> will be automagically derived from C<XS>. + =item MAKE Variant of make you intend to run the generated Makefile with. This @@ -2019,6 +2183,8 @@ may hold a name for that binary. Defaults to perl =item META_MERGE +Available in version 6.46 and above. + A hashref of items to add to the CPAN Meta file (F<META.yml> or F<META.json>). @@ -2029,8 +2195,30 @@ own. META_MERGE will merge its value with the default. Unless you want to override the defaults, prefer META_MERGE so as to get the advantage of any future defaults. +By default CPAN Meta specification C<1.4> is used. In order to use +CPAN Meta specification C<2.0>, indicate with C<meta-spec> the version +you want to use. + + META_MERGE => { + + "meta-spec" => { version => 2 }, + + resources => { + + repository => { + type => 'git', + url => 'git://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker.git', + web => 'https://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker', + }, + + }, + + }, + =item MIN_PERL_VERSION +Available in version 6.48 and above. + The minimum required version of Perl for this distribution. Either the 5.006001 or the 5.6.1 format is acceptable. @@ -2089,6 +2277,18 @@ meta-data files during 'perl Makefile.PL'. Defaults to false. +=item NO_PACKLIST + +When true, suppresses the writing of C<packlist> files for installs. + +Defaults to false. + +=item NO_PERLLOCAL + +When true, suppresses the appending of installations to C<perllocal>. + +Defaults to false. + =item NO_VC In general, any generated Makefile checks for the current version of @@ -2099,8 +2299,8 @@ Makefile.PL, use it interactively instead. =item OBJECT List of object files, defaults to '$(BASEEXT)$(OBJ_EXT)', but can be a long -string containing all object files, e.g. "tkpBind.o -tkpButton.o tkpCanvas.o" +string or an array containing all object files, e.g. "tkpBind.o +tkpButton.o tkpCanvas.o" or ["tkpBind.o", "tkpButton.o", "tkpCanvas.o"] (Where BASEEXT is the last component of NAME, and OBJ_EXT is $Config{obj_ext}.) @@ -2245,7 +2445,7 @@ is there for backwards compatibility (and it's somewhat DWIM). Hashref of .pm files and *.pl files to be installed. e.g. - {'name_of_file.pm' => '$(INST_LIBDIR)/install_as.pm'} + {'name_of_file.pm' => '$(INST_LIB)/install_as.pm'} By default this will include *.pm and *.pl and the files found in the PMLIBDIRS directories. Defining PM in the @@ -2305,6 +2505,15 @@ Name of the executable used to run C<PPM_INSTALL_SCRIPT> below. (e.g. perl) Name of the script that gets executed by the Perl Package Manager after the installation of a package. +=item PPM_UNINSTALL_EXEC + +Name of the executable used to run C<PPM_UNINSTALL_SCRIPT> below. (e.g. perl) + +=item PPM_UNINSTALL_SCRIPT + +Name of the script that gets executed by the Perl Package Manager before +the removal of a package. + =item PREFIX This overrides all the default install locations. Man pages, @@ -2325,6 +2534,9 @@ 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. +For dependencies that are required in order to run C<Makefile.PL>, +see C<CONFIGURE_REQUIRES>. + Module installation tools have ways of resolving unmet dependencies but to do that they need a F<Makefile>. Using C<PREREQ_FATAL> breaks this. That's bad. @@ -2342,8 +2554,7 @@ A hash of modules that are needed to run your module. The keys are the module names ie. Test::More, and the minimum version is the value. If the required version number is 0 any version will do. -This will go into the C<requires> field of your CPAN Meta file -(F<META.yml> or F<META.json>). +This will go into the C<requires> field of your F<META.yml> and the C<runtime> of the C<prereqs> field of your F<META.json>. PREREQ_PM => { # Require Test::More at least 0.47 @@ -2412,11 +2623,12 @@ if you really need it. =item TEST_REQUIRES +Available in version 6.64 and above. + A hash of modules that are needed to test your module but not run or build it. -This will go into the C<test_requires> field of your CPAN Meta file. -(F<META.yml> or F<META.json>). +This will go into the C<build_requires> field of your F<META.yml> and the C<test> of the C<prereqs> field of your F<META.json>. The format is the same as PREREQ_PM. @@ -2470,6 +2682,8 @@ but these will fail: local $VERSION = '1.02'; local $FOO::VERSION = '1.30'; +(Putting C<my> or C<local> on the preceding line will work o.k.) + "Version strings" are incompatible and should not be used. # Bad @@ -2478,14 +2692,12 @@ but these will fail: L<version> objects are fine. As of MakeMaker 6.35 version.pm will be automatically loaded, but you must declare the dependency on version.pm. -For compatibility with older MakeMaker you should load on the same line +For compatibility with older MakeMaker you should load on the same line as $VERSION is declared. # All on one line use version; our $VERSION = qv(1.2.3); -(Putting C<my> or C<local> on the preceding line will work o.k.) - The file named in VERSION_FROM is not added as a dependency to Makefile. This is not really correct, but it would be a major pain during development to have to rewrite the Makefile for any smallish @@ -2519,8 +2731,9 @@ that purpose. =item XSPROTOARG -May be set to an empty string, which is identical to C<-prototypes>, or -C<-noprototypes>. See the xsubpp documentation for details. MakeMaker +May be set to C<-protoypes>, C<-noprototypes> or the empty string. The +empty string is equivalent to the xsubpp default, or C<-noprototypes>. +See the xsubpp documentation for details. MakeMaker defaults to the empty string. =item XS_VERSION @@ -2591,8 +2804,16 @@ Anything put here will be passed to MY::postamble() if you have one. =item test +Specify the targets for testing. + {TESTS => 't/*.t'} +C<RECURSIVE_TEST_FILES> can be used to include all directories +recursively under C<t> that contain C<.t> files. It will be ignored if +you provide your own C<TESTS> attribute, defaults to false. + + {RECURSIVE_TEST_FILES=>1} + =item tool_autosplit {MAXLEN => 8} @@ -2707,6 +2928,11 @@ does a realclean first and then the distcheck. Note that this is not needed to build a new distribution as long as you are sure that the MANIFEST file is ok. +=item make veryclean + +does a realclean first and then removes backup files such as C<*~>, +C<*.bak>, C<*.old> and C<*.orig> + =item make manifest rewrites the MANIFEST file, adding all remaining files found (See @@ -2860,7 +3086,7 @@ function returns the $value selected by the user. If C<prompt()> detects that it is not running interactively and there is nothing on STDIN or if the PERL_MM_USE_DEFAULT environment variable is set to true, the $default will be used without prompting. This -prevents automated processes from blocking on user input. +prevents automated processes from blocking on user input. If no $default is provided an empty string will be used instead. @@ -2874,9 +3100,11 @@ If no $default is provided an empty string will be used instead. =item PERL_MM_OPT Command line options used by C<MakeMaker-E<gt>new()>, and thus by -C<WriteMakefile()>. The string is split on whitespace, and the result +C<WriteMakefile()>. The string is split as the shell would, and the result is processed before any actual command line arguments are processed. + PERL_MM_OPT='CCFLAGS="-Wl,-rpath -Wl,/foo/bar/lib" LIBS="-lwibble -lwobble"' + =item PERL_MM_USE_DEFAULT If set to a true value then MakeMaker's prompt function will @@ -2916,13 +3144,13 @@ Send patches and ideas to C<makemaker@perl.org>. Send bug reports via http://rt.cpan.org/. Please send your generated Makefile along with your report. -For more up-to-date information, see L<http://www.makemaker.org>. +For more up-to-date information, see L<https://metacpan.org/release/ExtUtils-MakeMaker>. Repository available at L<https://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker>. =head1 LICENSE -This program is free software; you can redistribute it and/or +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L<http://www.perl.com/perl/misc/Artistic.html> diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Config.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Config.pm index 6f5e541b810..5c703f08080 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.66'; +our $VERSION = '6.98'; use Config (); diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/FAQ.pod b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/FAQ.pod new file mode 100644 index 00000000000..e5acb6a0706 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/FAQ.pod @@ -0,0 +1,464 @@ +package ExtUtils::MakeMaker::FAQ; + +our $VERSION = '6.98'; + +1; +__END__ + +=head1 NAME + +ExtUtils::MakeMaker::FAQ - Frequently Asked Questions About MakeMaker + +=head1 DESCRIPTION + +FAQs, tricks and tips for C<ExtUtils::MakeMaker>. + + +=head2 Module Installation + +=over 4 + +=item How do I install a module into my home directory? + +If you're not the Perl administrator you probably don't have +permission to install a module to its default location. Then you +should install it for your own use into your home directory like so: + + # Non-unix folks, replace ~ with /path/to/your/home/dir + perl Makefile.PL INSTALL_BASE=~ + +This will put modules into F<~/lib/perl5>, man pages into F<~/man> and +programs into F<~/bin>. + +To ensure your Perl programs can see these newly installed modules, +set your C<PERL5LIB> environment variable to F<~/lib/perl5> or tell +each of your programs to look in that directory with the following: + + use lib "$ENV{HOME}/lib/perl5"; + +or if $ENV{HOME} isn't set and you don't want to set it for some +reason, do it the long way. + + use lib "/path/to/your/home/dir/lib/perl5"; + + +=item How do I get MakeMaker and Module::Build to install to the same place? + +Module::Build, as of 0.28, supports two ways to install to the same +location as MakeMaker. + +We highly recommend the install_base method, its the simplest and most +closely approximates the expected behavior of an installation prefix. + +1) Use INSTALL_BASE / C<--install_base> + +MakeMaker (as of 6.31) and Module::Build (as of 0.28) both can install +to the same locations using the "install_base" concept. See +L<ExtUtils::MakeMaker/INSTALL_BASE> for details. To get MM and MB to +install to the same location simply set INSTALL_BASE in MM and +C<--install_base> in MB to the same location. + + perl Makefile.PL INSTALL_BASE=/whatever + perl Build.PL --install_base /whatever + +This works most like other language's behavior when you specify a +prefix. We recommend this method. + +2) Use PREFIX / C<--prefix> + +Module::Build 0.28 added support for C<--prefix> which works like +MakeMaker's PREFIX. + + perl Makefile.PL PREFIX=/whatever + perl Build.PL --prefix /whatever + +We highly discourage this method. It should only be used if you know +what you're doing and specifically need the PREFIX behavior. The +PREFIX algorithm is complicated and focused on matching the system +installation. + +=item How do I keep from installing man pages? + +Recent versions of MakeMaker will only install man pages on Unix-like +operating systems. + +For an individual module: + + perl Makefile.PL INSTALLMAN1DIR=none INSTALLMAN3DIR=none + +If you want to suppress man page installation for all modules you have +to reconfigure Perl and tell it 'none' when it asks where to install +man pages. + + +=item How do I use a module without installing it? + +Two ways. One is to build the module normally... + + perl Makefile.PL + make + make test + +...and then set the PERL5LIB environment variable to point at the +blib/lib and blib/arch directories. + +The other is to install the module in a temporary location. + + perl Makefile.PL INSTALL_BASE=~/tmp + make + make test + make install + +And then set PERL5LIB to F<~/tmp/lib/perl5>. This works well when you +have multiple modules to work with. It also ensures that the module +goes through its full installation process which may modify it. + +=item PREFIX vs INSTALL_BASE from Module::Build::Cookbook + +The behavior of PREFIX is complicated and depends closely on how your +Perl is configured. The resulting installation locations will vary from +machine to machine and even different installations of Perl on the same machine. +Because of this, its difficult to document where prefix will place your modules. + +In contrast, INSTALL_BASE has predictable, easy to explain installation locations. +Now that Module::Build and MakeMaker both have INSTALL_BASE there is little reason +to use PREFIX other than to preserve your existing installation locations. If you +are starting a fresh Perl installation we encourage you to use INSTALL_BASE. If +you have an existing installation installed via PREFIX, consider moving it to an +installation structure matching INSTALL_BASE and using that instead. + +=back + +=head2 Common errors and problems + +=over 4 + +=item "No rule to make target `/usr/lib/perl5/CORE/config.h', needed by `Makefile'" + +Just what it says, you're missing that file. MakeMaker uses it to +determine if perl has been rebuilt since the Makefile was made. It's +a bit of a bug that it halts installation. + +Some operating systems don't ship the CORE directory with their base +perl install. To solve the problem, you likely need to install a perl +development package such as perl-devel (CentOS, Fedora and other +Redhat systems) or perl (Ubuntu and other Debian systems). + +=back + +=head2 Philosophy and History + +=over 4 + +=item Why not just use <insert other build config tool here>? + +Why did MakeMaker reinvent the build configuration wheel? Why not +just use autoconf or automake or ppm or Ant or ... + +There are many reasons, but the major one is cross-platform +compatibility. + +Perl is one of the most ported pieces of software ever. It works on +operating systems I've never even heard of (see perlport for details). +It needs a build tool that can work on all those platforms and with +any wacky C compilers and linkers they might have. + +No such build tool exists. Even make itself has wildly different +dialects. So we have to build our own. + + +=item What is Module::Build and how does it relate to MakeMaker? + +Module::Build is a project by Ken Williams to supplant MakeMaker. +Its primary advantages are: + +=over 8 + +=item * pure perl. no make, no shell commands + +=item * easier to customize + +=item * cleaner internals + +=item * less cruft + +=back + +Module::Build was long the official heir apparent to MakeMaker. The rate of +both its development and adoption has slowed in recent years, though, and it is +unclear what the future holds for it. That said, Module::Build set the stage +for I<something> to become the heir to MakeMaker. MakeMaker's maintainers have +long said that it is a dead end and should be kept functioning, but not +extended with new features. It's complicated enough as it is! + +=back + + +=head2 Module Writing + +=over 4 + +=item How do I keep my $VERSION up to date without resetting it manually? + +Often you want to manually set the $VERSION in the main module +distribution because this is the version that everybody sees on CPAN +and maybe you want to customize it a bit. But for all the other +modules in your dist, $VERSION is really just bookkeeping and all that's +important is it goes up every time the module is changed. Doing this +by hand is a pain and you often forget. + +Simplest way to do it automatically is to use your version control +system's revision number (you are using version control, right?). + +In CVS, RCS and SVN you use $Revision$ (see the documentation of your +version control system for details). Every time the file is checked +in the $Revision$ will be updated, updating your $VERSION. + +SVN uses a simple integer for $Revision$ so you can adapt it for your +$VERSION like so: + + ($VERSION) = q$Revision$ =~ /(\d+)/; + +In CVS and RCS version 1.9 is followed by 1.10. Since CPAN compares +version numbers numerically we use a sprintf() to convert 1.9 to 1.009 +and 1.10 to 1.010 which compare properly. + + $VERSION = sprintf "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/g; + +If branches are involved (ie. $Revision: 1.5.3.4$) it's a little more +complicated. + + # must be all on one line or MakeMaker will get confused. + $VERSION = do { my @r = (q$Revision$ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r }; + +In SVN, $Revision$ should be the same for every file in the project so +they would all have the same $VERSION. CVS and RCS have a different +$Revision$ per file so each file will have a different $VERSION. +Distributed version control systems, such as SVK, may have a different +$Revision$ based on who checks out the file, leading to a different $VERSION +on each machine! Finally, some distributed version control systems, such +as darcs, have no concept of revision number at all. + + +=item What's this F<META.yml> thing and how did it get in my F<MANIFEST>?! + +F<META.yml> is a module meta-data file pioneered by Module::Build and +automatically generated as part of the 'distdir' target (and thus +'dist'). See L<ExtUtils::MakeMaker/"Module Meta-Data">. + +To shut off its generation, pass the C<NO_META> flag to C<WriteMakefile()>. + + +=item How do I delete everything not in my F<MANIFEST>? + +Some folks are surprised that C<make distclean> does not delete +everything not listed in their MANIFEST (thus making a clean +distribution) but only tells them what they need to delete. This is +done because it is considered too dangerous. While developing your +module you might write a new file, not add it to the MANIFEST, then +run a C<distclean> and be sad because your new work was deleted. + +If you really want to do this, you can use +C<ExtUtils::Manifest::manifind()> to read the MANIFEST and File::Find +to delete the files. But you have to be careful. Here's a script to +do that. Use at your own risk. Have fun blowing holes in your foot. + + #!/usr/bin/perl -w + + use strict; + + use File::Spec; + use File::Find; + use ExtUtils::Manifest qw(maniread); + + my %manifest = map {( $_ => 1 )} + grep { File::Spec->canonpath($_) } + keys %{ maniread() }; + + if( !keys %manifest ) { + 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; + }, + no_chdir => 1 + }, + "." + ); + + +=item Which tar should I use on Windows? + +We recommend ptar from Archive::Tar not older than 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> + + +=back + +=head2 XS + +=over 4 + +=item How do I prevent "object version X.XX does not match bootstrap parameter Y.YY" errors? + +XS code is very sensitive to the module version number and will +complain if the version number in your Perl module doesn't match. If +you change your module's version # without rerunning Makefile.PL the old +version number will remain in the Makefile, causing the XS code to be built +with the wrong number. + +To avoid this, you can force the Makefile to be rebuilt whenever you +change the module containing the version number by adding this to your +WriteMakefile() arguments. + + depend => { '$(FIRST_MAKEFILE)' => '$(VERSION_FROM)' } + + +=item How do I make two or more XS files coexist in the same directory? + +Sometimes you need to have two and more XS files in the same package. +One way to go is to put them into separate directories, but sometimes +this is not the most suitable solution. The following technique allows +you to put two (and more) XS files in the same directory. + +Let's assume that we have a package C<Cool::Foo>, which includes +C<Cool::Foo> and C<Cool::Bar> modules each having a separate XS +file. First we use the following I<Makefile.PL>: + + use ExtUtils::MakeMaker; + + WriteMakefile( + NAME => 'Cool::Foo', + VERSION_FROM => 'Foo.pm', + OBJECT => q/$(O_FILES)/, + # ... other attrs ... + ); + +Notice the C<OBJECT> attribute. MakeMaker generates the following +variables in I<Makefile>: + + # Handy lists of source code files: + XS_FILES= Bar.xs \ + Foo.xs + C_FILES = Bar.c \ + Foo.c + O_FILES = Bar.o \ + Foo.o + +Therefore we can use the C<O_FILES> variable to tell MakeMaker to use +these objects into the shared library. + +That's pretty much it. Now write I<Foo.pm> and I<Foo.xs>, I<Bar.pm> +and I<Bar.xs>, where I<Foo.pm> bootstraps the shared library and +I<Bar.pm> simply loading I<Foo.pm>. + +The only issue left is to how to bootstrap I<Bar.xs>. This is done +from I<Foo.xs>: + + MODULE = Cool::Foo PACKAGE = Cool::Foo + + BOOT: + # boot the second XS file + boot_Cool__Bar(aTHX_ cv); + +If you have more than two files, this is the place where you should +boot extra XS files from. + +The following four files sum up all the details discussed so far. + + Foo.pm: + ------- + package Cool::Foo; + + require DynaLoader; + + our @ISA = qw(DynaLoader); + our $VERSION = '0.01'; + bootstrap Cool::Foo $VERSION; + + 1; + + Bar.pm: + ------- + package Cool::Bar; + + use Cool::Foo; # bootstraps Bar.xs + + 1; + + Foo.xs: + ------- + #include "EXTERN.h" + #include "perl.h" + #include "XSUB.h" + + MODULE = Cool::Foo PACKAGE = Cool::Foo + + BOOT: + # boot the second XS file + boot_Cool__Bar(aTHX_ cv); + + MODULE = Cool::Foo PACKAGE = Cool::Foo PREFIX = cool_foo_ + + void + cool_foo_perl_rules() + + CODE: + fprintf(stderr, "Cool::Foo says: Perl Rules\n"); + + Bar.xs: + ------- + #include "EXTERN.h" + #include "perl.h" + #include "XSUB.h" + + MODULE = Cool::Bar PACKAGE = Cool::Bar PREFIX = cool_bar_ + + void + cool_bar_perl_rules() + + CODE: + fprintf(stderr, "Cool::Bar says: Perl Rules\n"); + +And of course a very basic test: + + t/cool.t: + -------- + use Test; + BEGIN { plan tests => 1 }; + use Cool::Foo; + use Cool::Bar; + Cool::Foo::perl_rules(); + Cool::Bar::perl_rules(); + ok 1; + +This tip has been brought to you by Nick Ing-Simmons and Stas Bekman. + +=back + +=head1 PATCHING + +If you have a question you'd like to see added to the FAQ (whether or +not you have the answer) please send it to makemaker@perl.org. + +=head1 AUTHOR + +The denizens of makemaker@perl.org. + +=head1 SEE ALSO + +L<ExtUtils::MakeMaker> + +=cut diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Tutorial.pod b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Tutorial.pod new file mode 100644 index 00000000000..5d43d40c39f --- /dev/null +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MakeMaker/Tutorial.pod @@ -0,0 +1,180 @@ +package ExtUtils::MakeMaker::Tutorial; + +our $VERSION = '6.98'; + + +=head1 NAME + +ExtUtils::MakeMaker::Tutorial - Writing a module with MakeMaker + +=head1 SYNOPSIS + + use ExtUtils::MakeMaker; + + WriteMakefile( + NAME => 'Your::Module', + VERSION_FROM => 'lib/Your/Module.pm' + ); + +=head1 DESCRIPTION + +This is a short tutorial on writing a simple module with MakeMaker. +It's really not that hard. + + +=head2 The Mantra + +MakeMaker modules are installed using this simple mantra + + perl Makefile.PL + make + make test + make install + +There are lots more commands and options, but the above will do it. + + +=head2 The Layout + +The basic files in a module look something like this. + + Makefile.PL + MANIFEST + lib/Your/Module.pm + +That's all that's strictly necessary. There's additional files you might +want: + + lib/Your/Other/Module.pm + t/some_test.t + t/some_other_test.t + Changes + README + INSTALL + MANIFEST.SKIP + bin/some_program + +=over 4 + +=item Makefile.PL + +When you run Makefile.PL, it makes a Makefile. That's the whole point of +MakeMaker. The Makefile.PL is a simple program which loads +ExtUtils::MakeMaker and runs the WriteMakefile() function to generate a +Makefile. + +Here's an example of what you need for a simple module: + + use ExtUtils::MakeMaker; + + WriteMakefile( + NAME => 'Your::Module', + VERSION_FROM => 'lib/Your/Module.pm' + ); + +NAME is the top-level namespace of your module. VERSION_FROM is the file +which contains the $VERSION variable for the entire distribution. Typically +this is the same as your top-level module. + + +=item MANIFEST + +A simple listing of all the files in your distribution. + + Makefile.PL + MANIFEST + lib/Your/Module.pm + +File paths in a MANIFEST always use Unix conventions (ie. /) even if you're +not on Unix. + +You can write this by hand or generate it with 'make manifest'. + +See L<ExtUtils::Manifest> for more details. + + +=item lib/ + +This is the directory where the .pm and .pod files you wish to have +installed go. They are laid out according to namespace. So Foo::Bar +is F<lib/Foo/Bar.pm>. + + +=item t/ + +Tests for your modules go here. Each test filename ends with a .t. +So F<t/foo.t>/ 'make test' will run these tests. The directory is flat, +you cannot, for example, have t/foo/bar.t run by 'make test'. + +Tests are run from the top level of your distribution. So inside a test +you would refer to ./lib to enter the lib directory, for example. + + +=item Changes + +A log of changes you've made to this module. The layout is free-form. +Here's an example: + + 1.01 Fri Apr 11 00:21:25 PDT 2003 + - thing() does some stuff now + - fixed the wiggy bug in withit() + + 1.00 Mon Apr 7 00:57:15 PDT 2003 + - "Rain of Frogs" now supported + + +=item README + +A short description of your module, what it does, why someone would use it +and its limitations. CPAN automatically pulls your README file out of +the archive and makes it available to CPAN users, it is the first thing +they will read to decide if your module is right for them. + + +=item INSTALL + +Instructions on how to install your module along with any dependencies. +Suggested information to include here: + + any extra modules required for use + the minimum version of Perl required + if only works on certain operating systems + + +=item MANIFEST.SKIP + +A file full of regular expressions to exclude when using 'make +manifest' to generate the MANIFEST. These regular expressions +are checked against each file path found in the distribution (so +you're matching against "t/foo.t" not "foo.t"). + +Here's a sample: + + ~$ # ignore emacs and vim backup files + .bak$ # ignore manual backups + \# # ignore CVS old revision files and emacs temp files + +Since # can be used for comments, # must be escaped. + +MakeMaker comes with a default MANIFEST.SKIP to avoid things like +version control directories and backup files. Specifying your own +will override this default. + + +=item bin/ + + +=back + +=head1 SEE ALSO + +L<perlmodstyle> gives stylistic help writing a module. + +L<perlnewmod> gives more information about how to write a module. + +There are modules to help you through the process of writing a module: +L<ExtUtils::ModuleMaker>, L<Module::Install>, L<PAR> + +=cut + +1; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Miniperl.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Miniperl.pm index 04bdb6d7e38..cede3180f8a 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Miniperl.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Miniperl.pm @@ -1,18 +1,41 @@ -# This File keeps the contents of miniperlmain.c. -# -# It was generated automatically by minimod.PL from the contents -# of miniperlmain.c. Don't edit this file! -# -# ANY CHANGES MADE HERE WILL BE LOST! -# - - +#!./perl -w package ExtUtils::Miniperl; +use strict; require Exporter; +use ExtUtils::Embed 1.31, qw(xsi_header xsi_protos xsi_body); + +use vars qw($VERSION @ISA @EXPORT); + @ISA = qw(Exporter); -@EXPORT = qw(&writemain); +@EXPORT = qw(writemain); +$VERSION = '1.01'; + +# blead will run this with miniperl, hence we can't use autodie or File::Temp +my $temp; -$head= <<'EOF!HEAD'; +END { + return if !defined $temp || !-e $temp; + unlink $temp or warn "Can't unlink '$temp': $!"; +} + +sub writemain{ + my ($fh, $real); + + if (ref $_[0] eq 'SCALAR') { + $real = ${+shift}; + $temp = $real; + $temp =~ s/(?:.c)?\z/.new/; + open $fh, '>', $temp + or die "Can't open '$temp' for writing: $!"; + } elsif (ref $_[0]) { + $fh = shift; + } else { + $fh = \*STDOUT; + } + + my(@exts) = @_; + + printf $fh <<'EOF!HEAD', xsi_header(); /* miniperlmain.c * * Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003, @@ -49,12 +72,8 @@ $head= <<'EOF!HEAD'; #endif #endif - -#include "EXTERN.h" #define PERL_IN_MINIPERLMAIN_C -#include "perl.h" -#include "XSUB.h" - +%s static void xs_init (pTHX); static PerlInterpreter *my_perl; @@ -76,12 +95,13 @@ int main(int argc, char **argv, char **env) #endif { - dVAR; int exitstatus, i; #ifdef PERL_GLOBAL_STRUCT - struct perl_vars *plvarsp = init_global_struct(); + struct perl_vars *my_vars = init_global_struct(); # ifdef PERL_GLOBAL_STRUCT_PRIVATE - my_vars = my_plvarsp = plvarsp; + int veto; + + my_plvarsp = my_vars; # endif #endif /* PERL_GLOBAL_STRUCT */ #ifndef NO_ENV_ARRAY_IN_MAIN @@ -157,7 +177,17 @@ main(int argc, char **argv, char **env) PERL_SYS_TERM(); #ifdef PERL_GLOBAL_STRUCT - free_global_struct(plvarsp); +# ifdef PERL_GLOBAL_STRUCT_PRIVATE + veto = my_plvarsp->Gveto_cleanup; +# endif + free_global_struct(my_vars); +# ifdef PERL_GLOBAL_STRUCT_PRIVATE + if (!veto) + my_plvarsp = NULL; + /* Remember, functions registered with atexit() can run after this point, + and may access "global" variables, and hence end up calling + Perl_GetVarsPrivate() */ +#endif #endif /* PERL_GLOBAL_STRUCT */ exit(exitstatus); @@ -167,78 +197,18 @@ main(int argc, char **argv, char **env) /* Register any extra external extensions */ EOF!HEAD -$tail=<<'EOF!TAIL'; + + print $fh xsi_protos(@exts), <<'EOT', xsi_body(@exts), "}\n"; static void xs_init(pTHX) { - PERL_UNUSED_CONTEXT; -} - -/* - * Local variables: - * c-indentation-style: bsd - * c-basic-offset: 4 - * indent-tabs-mode: nil - * End: - * - * ex: set ts=8 sts=4 sw=4 et: - */ -EOF!TAIL - -sub writemain{ - my(@exts) = @_; +EOT - my($pname); - my($dl) = canon('/','DynaLoader'); - print $head; - - foreach $_ (@exts){ - my($pname) = canon('/', $_); - my($mname, $cname); - ($mname = $pname) =~ s!/!::!g; - ($cname = $pname) =~ s!/!__!g; - print "EXTERN_C void boot_${cname} (pTHX_ CV* cv);\n"; + if ($real) { + close $fh or die "Can't close '$temp': $!"; + rename $temp, $real or die "Can't rename '$temp' to '$real': $!"; } - - my ($tail1,$tail2,$tail3) = ( $tail =~ /\A(.*{\s*\n)(.*\n)(\s*\}.*)\Z/s ); - - print $tail1; - print "\tstatic const char file[] = __FILE__;\n"; - print "\tdXSUB_SYS;\n" if $] > 5.002; - print $tail2; - - foreach $_ (@exts){ - my($pname) = canon('/', $_); - my($mname, $cname, $ccode); - ($mname = $pname) =~ s!/!::!g; - ($cname = $pname) =~ s!/!__!g; - print "\t{\n"; - if ($pname eq $dl){ - # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'! - # boot_DynaLoader is called directly in DynaLoader.pm - $ccode = "\t/* DynaLoader is a special case */\n -\tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n"; - print $ccode unless $SEEN{$ccode}++; - } else { - $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n"; - print $ccode unless $SEEN{$ccode}++; - } - print "\t}\n"; - } - print $tail3; -} - -sub canon{ - my($as, @ext) = @_; - foreach(@ext){ - # might be X::Y or lib/auto/X/Y/Y.a - next if s!::!/!g; - s:^(lib|ext)/(auto/)?::; - s:/\w+\.\w+$::; - } - grep(s:/:$as:, @ext) if ($as ne '/'); - @ext; } 1; @@ -246,28 +216,29 @@ __END__ =head1 NAME -ExtUtils::Miniperl, writemain - write the C code for perlmain.c +ExtUtils::Miniperl - write the C code for perlmain.c =head1 SYNOPSIS -C<use ExtUtils::Miniperl;> - -C<writemain(@directories);> + use ExtUtils::Miniperl; + writemain(@directories); + # or + writemain($fh, @directories); + # or + writemain(\$filename, @directories); =head1 DESCRIPTION -This whole module is written when perl itself is built from a script -called minimod.PL. In case you want to patch it, please patch -minimod.PL in the perl distribution instead. - -writemain() takes an argument list of directories containing archive +C<writemain()> takes an argument list of directories containing archive libraries that relate to perl modules and should be linked into a new -perl binary. It writes to STDOUT a corresponding perlmain.c file that +perl binary. It writes a corresponding F<perlmain.c> file that is a plain C file containing all the bootstrap code to make the -modules associated with the libraries available from within perl. +If the first argument to C<writemain()> is a reference to a scalar it is +used as the filename to open for ouput. Any other reference is used as +the filehandle to write to. Otherwise output defaults to C<STDOUT>. The typical usage is from within a Makefile generated by -ExtUtils::MakeMaker. So under normal circumstances you won't have to +L<ExtUtils::MakeMaker>. So under normal circumstances you won't have to deal with this module directly. =head1 SEE ALSO @@ -276,3 +247,10 @@ L<ExtUtils::MakeMaker> =cut +# Local variables: +# c-indentation-style: bsd +# c-basic-offset: 4 +# indent-tabs-mode: nil +# End: +# +# ex: set ts=8 sts=4 sw=4 et: diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Mkbootstrap.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Mkbootstrap.pm index f71655d6355..bb85e85cec2 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.66'; +our $VERSION = '6.98'; require Exporter; our @ISA = ('Exporter'); diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Mksymlists.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Mksymlists.pm index a99d19840a4..176faf17529 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.66'; +our $VERSION = '6.98'; sub Mksymlists { my(%spec) = @_; @@ -86,7 +86,7 @@ sub _write_os2 { my $distname = $data->{DISTNAME} || $data->{NAME}; $distname = "Distribution $distname"; my $patchlevel = " pl$Config{perl_patchlevel}" || ''; - my $comment = sprintf "Perl (v%s%s%s) module %s", + my $comment = sprintf "Perl (v%s%s%s) module %s", $Config::Config{version}, $threaded, $patchlevel, $data->{NAME}; chomp $comment; if ($data->{INSTALLDIRS} and $data->{INSTALLDIRS} eq 'perl') { @@ -197,7 +197,7 @@ sub _write_vms { if ($isvax) { print $opt "UNIVERSAL=$safe\n" } else { print $opt "SYMBOL_VECTOR=($safe=DATA)\n"; } } - + close $opt; } diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Packlist.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Packlist.pm index a268e300d3c..8323725c644 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Packlist.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Packlist.pm @@ -5,7 +5,7 @@ use strict; use Carp qw(); use Config; use vars qw($VERSION $Relocations); -$VERSION = '1.46'; +$VERSION = '1.48'; $VERSION = eval $VERSION; # Used for generating filehandle globs. IO::File might not be available! diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pm index d50b5010cd0..25d3175ec33 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pm @@ -4,28 +4,27 @@ use strict; use 5.006001; use Cwd; use Config; -use Exporter; +use Exporter 'import'; use File::Basename; use File::Spec; use Symbol; our $VERSION; BEGIN { - $VERSION = '3.18'; + $VERSION = '3.24'; } use ExtUtils::ParseXS::Constants $VERSION; use ExtUtils::ParseXS::CountLines $VERSION; use ExtUtils::ParseXS::Utilities $VERSION; +use ExtUtils::ParseXS::Eval $VERSION; $VERSION = eval $VERSION if $VERSION =~ /_/; use ExtUtils::ParseXS::Utilities qw( standard_typemap_locations trim_whitespace - tidy_type C_string valid_proto_string process_typemaps - make_targetable map_type standard_XS_defs assign_func_args @@ -40,26 +39,53 @@ use ExtUtils::ParseXS::Utilities qw( report_typemap_failure ); -our @ISA = qw(Exporter); our @EXPORT_OK = qw( process_file report_error_count ); -# The scalars in the line below remain as 'our' variables because pulling -# them into $self led to build problems. In most cases, strings being -# 'eval'-ed contain the variables' names hard-coded. -our ( - $Package, $func_name, $Full_func_name, $pname, $ALIAS, -); +############################## +# A number of "constants" + +our ($C_group_rex, $C_arg); +# Group in C (no support for comments or literals) +$C_group_rex = qr/ [({\[] + (?: (?> [^()\[\]{}]+ ) | (??{ $C_group_rex }) )* + [)}\]] /x; +# Chunk in C without comma at toplevel (no comments): +$C_arg = qr/ (?: (?> [^()\[\]{},"']+ ) + | (??{ $C_group_rex }) + | " (?: (?> [^\\"]+ ) + | \\. + )* " # String literal + | ' (?: (?> [^\\']+ ) | \\. )* ' # Char literal + )* /xs; + +# "impossible" keyword (multiple newline) +my $END = "!End!\n\n"; +# Match an XS Keyword +my $BLOCK_regexp = '\s*(' . $ExtUtils::ParseXS::Constants::XSKeywordsAlternation . "|$END)\\s*:"; -our $self = bless {} => __PACKAGE__; -sub process_file { - # Allow for $package->process_file(%hash) in the future - my ($pkg, %options) = @_ % 2 ? @_ : (__PACKAGE__, @_); +sub new { + return bless {} => shift; +} + +our $Singleton = __PACKAGE__->new; +sub process_file { + my $self; + # Allow for $package->process_file(%hash), $obj->process_file, and process_file() + if (@_ % 2) { + my $invocant = shift; + $self = ref($invocant) ? $invocant : $invocant->new; + } + else { + $self = $Singleton; + } + + my %options = @_; $self->{ProtoUsed} = exists $options{prototypes}; # Set defaults. @@ -92,15 +118,15 @@ sub process_file { } @{ $self->{XSStack} } = ({type => 'none'}); $self->{InitFileCode} = [ @ExtUtils::ParseXS::Constants::InitFileCode ]; - $self->{Overload} = 0; - $self->{errors} = 0; + $self->{Overload} = 0; # bool + $self->{errors} = 0; # count $self->{Fallback} = '&PL_sv_undef'; # Most of the 1500 lines below uses these globals. We'll have to # clean this up sometime, probably. For now, we just pull them out # of %args. -Ken - $self->{hiertype} = $args{hiertype}; + $self->{RetainCplusplusHierarchicalTypes} = $args{hiertype}; $self->{WantPrototypes} = $args{prototypes}; $self->{WantVersionChk} = $args{versioncheck}; $self->{WantLineNumbers} = $args{linenumbers}; @@ -148,39 +174,11 @@ sub process_file { $self->{typemap} = process_typemaps( $args{typemap}, $pwd ); - my $END = "!End!\n\n"; # "impossible" keyword (multiple newline) - - # Match an XS keyword - $self->{BLOCK_re} = '\s*(' . - join('|' => @ExtUtils::ParseXS::Constants::XSKeywords) . - "|$END)\\s*:"; - - our ($C_group_rex, $C_arg); - # Group in C (no support for comments or literals) - $C_group_rex = qr/ [({\[] - (?: (?> [^()\[\]{}]+ ) | (??{ $C_group_rex }) )* - [)}\]] /x; - # Chunk in C without comma at toplevel (no comments): - $C_arg = qr/ (?: (?> [^()\[\]{},"']+ ) - | (??{ $C_group_rex }) - | " (?: (?> [^\\"]+ ) - | \\. - )* " # String literal - | ' (?: (?> [^\\']+ ) | \\. )* ' # Char literal - )* /xs; - - # Since at this point we're ready to begin printing to the output file and - # reading from the input file, I want to get as much data as possible into - # the proto-object $self. That means assigning to $self and elements of - # %args referenced below this point. - # HOWEVER: This resulted in an error when I tried: - # $args{'s'} ---> $self->{s}. - # Use of uninitialized value in quotemeta at - # .../blib/lib/ExtUtils/ParseXS.pm line 733 - + # Move more settings from parameters to object foreach my $datum ( qw| argtypes except inout optimize | ) { $self->{$datum} = $args{$datum}; } + $self->{strip_c_func_prefix} = $args{s}; # Identify the version of xsubpp used print <<EOM; @@ -202,7 +200,7 @@ EOM # is a basename'd $args{filename} due to chdir above) open($self->{FH}, '<', $self->{filename}) or die "cannot open $self->{filename}: $!\n"; - firstmodule: + FIRSTMODULE: while (readline($self->{FH})) { if (/^=/) { my $podstartline = $.; @@ -224,7 +222,7 @@ EOM print("#if 0\n \"Skipped embedded POD.\"\n#endif\n"); printf("#line %d \"%s\"\n", $. + 1, escape_file_for_line_directive($self->{filepathname})) if $self->{WantLineNumbers}; - next firstmodule + next FIRSTMODULE; } } while (readline($self->{FH})); @@ -234,7 +232,7 @@ EOM die ("Error: Unterminated pod in $self->{filename}, line $podstartline\n") unless $self->{lastline}; } - last if ($Package, $self->{Prefix}) = + last if ($self->{Package}, $self->{Prefix}) = /^MODULE\s*=\s*[\w:]+(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/; print $_; @@ -294,14 +292,14 @@ EOM $self->{$member} = {}; } $self->{proto_arg} = []; - $self->{processing_arg_with_types} = undef; - $self->{proto_in_this_xsub} = undef; - $self->{scope_in_this_xsub} = undef; - $self->{interface} = undef; + $self->{processing_arg_with_types} = 0; # bool + $self->{proto_in_this_xsub} = 0; # counter & bool + $self->{scope_in_this_xsub} = 0; # counter & bool + $self->{interface} = 0; # bool $self->{interface_macro} = 'XSINTERFACE_FUNC'; $self->{interface_macro_set} = 'XSINTERFACE_FUNC_SET'; - $self->{ProtoThisXSUB} = $self->{WantPrototypes}; - $self->{ScopeThisXSUB} = 0; + $self->{ProtoThisXSUB} = $self->{WantPrototypes}; # states 0 (none), 1 (yes), 2 (empty prototype) + $self->{ScopeThisXSUB} = 0; # bool my $xsreturn = 0; @@ -323,7 +321,7 @@ EOM } # extract return type, function name and arguments - ($self->{ret_type}) = tidy_type($_); + ($self->{ret_type}) = ExtUtils::Typemaps::tidy_type($_); my $RETVAL_no_return = 1 if $self->{ret_type} =~ s/^NO_OUTPUT\s+//; # Allow one-line ANSI-like declaration @@ -343,25 +341,25 @@ EOM unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*(const)?\s*(;\s*)?$/s; my ($class, $orig_args); - ($class, $func_name, $orig_args) = ($1, $2, $3); + ($class, $self->{func_name}, $orig_args) = ($1, $2, $3); $class = "$4 $class" if $4; - ($pname = $func_name) =~ s/^($self->{Prefix})?/$self->{Packprefix}/; + ($self->{pname} = $self->{func_name}) =~ s/^($self->{Prefix})?/$self->{Packprefix}/; my $clean_func_name; - ($clean_func_name = $func_name) =~ s/^$self->{Prefix}//; - $Full_func_name = "$self->{Packid}_$clean_func_name"; + ($clean_func_name = $self->{func_name}) =~ s/^$self->{Prefix}//; + $self->{Full_func_name} = "$self->{Packid}_$clean_func_name"; if ($Is_VMS) { - $Full_func_name = $SymSet->addsym($Full_func_name); + $self->{Full_func_name} = $SymSet->addsym( $self->{Full_func_name} ); } # Check for duplicate function definition for my $tmp (@{ $self->{XSStack} }) { - next unless defined $tmp->{functions}{$Full_func_name}; + next unless defined $tmp->{functions}{ $self->{Full_func_name} }; Warn( $self, "Warning: duplicate function definition '$clean_func_name' detected"); last; } - $self->{XSStack}->[$XSS_work_idx]{functions}{$Full_func_name}++; - %{ $self->{XsubAliases} } = (); - %{ $self->{XsubAliasValues} } = (); + $self->{XSStack}->[$XSS_work_idx]{functions}{ $self->{Full_func_name} }++; + delete $self->{XsubAliases}; + delete $self->{XsubAliasValues}; %{ $self->{Interfaces} } = (); @{ $self->{Attributes} } = (); $self->{DoSetMagic} = 1; @@ -374,8 +372,10 @@ EOM my $only_C_inlist_ref = {}; # Not in the signature of Perl function if ($self->{argtypes} and $orig_args =~ /\S/) { my $args = "$orig_args ,"; + use re 'eval'; if ($args =~ /^( (??{ $C_arg }) , )* $ /x) { @args = ($args =~ /\G ( (??{ $C_arg }) ) , /xg); + no re 'eval'; for ( @args ) { s/^\s+//; s/\s+$//; @@ -416,6 +416,7 @@ EOM } } else { + no re 'eval'; @args = split(/\s*,\s*/, $orig_args); Warn( $self, "Warning: cannot parse argument list '$orig_args', fallback to split"); } @@ -435,7 +436,7 @@ EOM } } if (defined($class)) { - my $arg0 = ((defined($static) or $func_name eq 'new') + my $arg0 = ((defined($static) or $self->{func_name} eq 'new') ? "CLASS" : "THIS"); unshift(@args, $arg0); } @@ -481,20 +482,7 @@ EOM my $EXPLICIT_RETURN = ($CODE && ("@{ $self->{line} }" =~ /(\bST\s*\([^;]*=) | (\bXST_m\w+\s*\()/x )); - # The $ALIAS which follows is only explicitly called within the scope of - # process_file(). In principle, it ought to be a lexical, i.e., 'my - # $ALIAS' like the other nearby variables. However, implementing that - # change produced a slight difference in the resulting .c output in at - # least two distributions: B/BD/BDFOY/Crypt-Rijndael and - # G/GF/GFUJI/Hash-FieldHash. The difference is, arguably, an improvement - # in the resulting C code. Example: - # 388c388 - # < GvNAME(CvGV(cv)), - # --- - # > "Crypt::Rijndael::encrypt", - # But at this point we're committed to generating the *same* C code that - # the current version of ParseXS.pm does. So we're declaring it as 'our'. - $ALIAS = grep(/^\s*ALIAS\s*:/, @{ $self->{line} }); + $self->{ALIAS} = grep(/^\s*ALIAS\s*:/, @{ $self->{line} }); my $INTERFACE = grep(/^\s*INTERFACE\s*:/, @{ $self->{line} }); @@ -505,12 +493,12 @@ EOM # print function header print Q(<<"EOF"); #$externC -#XS_EUPXS(XS_${Full_func_name}); /* prototype to pass -Wmissing-prototypes */ -#XS_EUPXS(XS_${Full_func_name}) +#XS_EUPXS(XS_$self->{Full_func_name}); /* prototype to pass -Wmissing-prototypes */ +#XS_EUPXS(XS_$self->{Full_func_name}) #[[ # dVAR; dXSARGS; EOF - print Q(<<"EOF") if $ALIAS; + print Q(<<"EOF") if $self->{ALIAS}; # dXSI32; EOF print Q(<<"EOF") if $INTERFACE; @@ -580,10 +568,10 @@ EOF EOF if (!$self->{thisdone} && defined($class)) { - if (defined($static) or $func_name eq 'new') { + if (defined($static) or $self->{func_name} eq 'new') { print "\tchar *"; $self->{var_types}->{"CLASS"} = "char *"; - generate_init( { + $self->generate_init( { type => "char *", num => 1, var => "CLASS", @@ -593,7 +581,7 @@ EOF else { print "\t$class *"; $self->{var_types}->{"THIS"} = "$class *"; - generate_init( { + $self->generate_init( { type => "$class *", num => 1, var => "THIS", @@ -608,7 +596,7 @@ EOF my ($wantRETVAL); # do code if (/^\s*NOT_IMPLEMENTED_YET/) { - print "\n\tPerl_croak(aTHX_ \"$pname: not implemented yet\");\n"; + print "\n\tPerl_croak(aTHX_ \"$self->{pname}: not implemented yet\");\n"; $_ = ''; } else { @@ -644,7 +632,7 @@ EOF $self->{have_CODE_with_RETVAL} = 1; } } - elsif (defined($class) and $func_name eq "DESTROY") { + elsif (defined($class) and $self->{func_name} eq "DESTROY") { print "\n\t"; print "delete THIS;\n"; } @@ -655,25 +643,26 @@ EOF $wantRETVAL = 1; } if (defined($static)) { - if ($func_name eq 'new') { - $func_name = "$class"; + if ($self->{func_name} eq 'new') { + $self->{func_name} = "$class"; } else { print "${class}::"; } } elsif (defined($class)) { - if ($func_name eq 'new') { - $func_name .= " $class"; + if ($self->{func_name} eq 'new') { + $self->{func_name} .= " $class"; } else { print "THIS->"; } } - $func_name =~ s/^\Q$args{'s'}// - if exists $args{'s'}; - $func_name = 'XSFUNCTION' if $self->{interface}; - print "$func_name($self->{func_args});\n"; + my $strip = $self->{strip_c_func_prefix}; + $self->{func_name} =~ s/^\Q$strip// + if defined $strip; + $self->{func_name} = 'XSFUNCTION' if $self->{interface}; + print "$self->{func_name}($self->{func_args});\n"; } } @@ -691,7 +680,7 @@ EOF $self->Warn("Warning: Found a 'CODE' section which seems to be using 'RETVAL' but no 'OUTPUT' section."); } - generate_output( { + $self->generate_output( { type => $self->{var_types}->{$_}, num => $self->{args_match}->{$_}, var => $_, @@ -706,40 +695,34 @@ EOF } elsif ($self->{gotRETVAL} || $wantRETVAL) { my $outputmap = $self->{typemap}->get_outputmap( ctype => $self->{ret_type} ); - my $t = $self->{optimize} && $outputmap && $outputmap->targetable; - # Although the '$var' declared in the next line is never explicitly - # used within this 'elsif' block, commenting it out leads to - # disaster, starting with the first 'eval qq' inside the 'elsif' block - # below. - # It appears that this is related to the fact that at this point the - # value of $t is a reference to an array whose [2] element includes - # '$var' as a substring: - # <i> <> <(IV)$var> + my $trgt = $self->{optimize} && $outputmap && $outputmap->targetable; my $var = 'RETVAL'; my $type = $self->{ret_type}; - if ($t and not $t->{with_size} and $t->{type} eq 'p') { - # PUSHp corresponds to setpvn. Treat setpv directly - my $what = eval qq("$t->{what}"); - warn $@ if $@; - - print "\tsv_setpv(TARG, $what); XSprePUSH; PUSHTARG;\n"; - $prepush_done = 1; - } - elsif ($t) { - my $what = eval qq("$t->{what}"); - warn $@ if $@; - - my $tsize = $t->{what_size}; - $tsize = '' unless defined $tsize; - $tsize = eval qq("$tsize"); - warn $@ if $@; - print "\tXSprePUSH; PUSH$t->{type}($what$tsize);\n"; - $prepush_done = 1; + if ($trgt) { + my $what = $self->eval_output_typemap_code( + qq("$trgt->{what}"), + {var => $var, type => $self->{ret_type}} + ); + if (not $trgt->{with_size} and $trgt->{type} eq 'p') { # sv_setpv + # PUSHp corresponds to sv_setpvn. Treat sv_setpv directly + print "\tsv_setpv(TARG, $what); XSprePUSH; PUSHTARG;\n"; + $prepush_done = 1; + } + else { + my $tsize = $trgt->{what_size}; + $tsize = '' unless defined $tsize; + $tsize = $self->eval_output_typemap_code( + qq("$tsize"), + {var => $var, type => $self->{ret_type}} + ); + print "\tXSprePUSH; PUSH$trgt->{type}($what$tsize);\n"; + $prepush_done = 1; + } } else { # RETVAL almost never needs SvSETMAGIC() - generate_output( { + $self->generate_output( { type => $self->{ret_type}, num => 0, var => 'RETVAL', @@ -755,7 +738,7 @@ EOF print "\tXSprePUSH;" if $c and not $prepush_done; print "\tEXTEND(SP,$c);\n" if $c; $xsreturn += $c; - generate_output( { + $self->generate_output( { type => $self->{var_types}->{$_}, num => $num++, var => $_, @@ -790,7 +773,7 @@ EOF next; } last if $_ eq "$END:"; - $self->death(/^$self->{BLOCK_re}/o ? "Misplaced '$1:'" : "Junk at end of function ($_)"); + $self->death(/^$BLOCK_regexp/o ? "Misplaced '$1:'" : "Junk at end of function ($_)"); } print Q(<<"EOF") if $self->{except}; @@ -842,38 +825,40 @@ EOF $self->{proto} = qq{, "$self->{proto}"}; } - if (%{ $self->{XsubAliases} }) { - $self->{XsubAliases}->{$pname} = 0 - unless defined $self->{XsubAliases}->{$pname}; - while ( my ($xname, $value) = each %{ $self->{XsubAliases} }) { + if ($self->{XsubAliases} and keys %{ $self->{XsubAliases} }) { + $self->{XsubAliases}->{ $self->{pname} } = 0 + unless defined $self->{XsubAliases}->{ $self->{pname} }; + foreach my $xname (sort keys %{ $self->{XsubAliases} }) { + my $value = $self->{XsubAliases}{$xname}; push(@{ $self->{InitFileCode} }, Q(<<"EOF")); -# cv = $self->{newXS}(\"$xname\", XS_$Full_func_name, file$self->{proto}); +# cv = $self->{newXS}(\"$xname\", XS_$self->{Full_func_name}, file$self->{proto}); # XSANY.any_i32 = $value; EOF } } elsif (@{ $self->{Attributes} }) { push(@{ $self->{InitFileCode} }, Q(<<"EOF")); -# cv = $self->{newXS}(\"$pname\", XS_$Full_func_name, file$self->{proto}); -# apply_attrs_string("$Package", cv, "@{ $self->{Attributes} }", 0); +# cv = $self->{newXS}(\"$self->{pname}\", XS_$self->{Full_func_name}, file$self->{proto}); +# apply_attrs_string("$self->{Package}", cv, "@{ $self->{Attributes} }", 0); EOF } elsif ($self->{interface}) { - while ( my ($yname, $value) = each %{ $self->{Interfaces} }) { - $yname = "$Package\::$yname" unless $yname =~ /::/; + foreach my $yname (sort keys %{ $self->{Interfaces} }) { + my $value = $self->{Interfaces}{$yname}; + $yname = "$self->{Package}\::$yname" unless $yname =~ /::/; push(@{ $self->{InitFileCode} }, Q(<<"EOF")); -# cv = $self->{newXS}(\"$yname\", XS_$Full_func_name, file$self->{proto}); +# cv = $self->{newXS}(\"$yname\", XS_$self->{Full_func_name}, file$self->{proto}); # $self->{interface_macro_set}(cv,$value); EOF } } elsif($self->{newXS} eq 'newXS'){ # work around P5NCI's empty newXS macro push(@{ $self->{InitFileCode} }, - " $self->{newXS}(\"$pname\", XS_$Full_func_name, file$self->{proto});\n"); + " $self->{newXS}(\"$self->{pname}\", XS_$self->{Full_func_name}, file$self->{proto});\n"); } else { push(@{ $self->{InitFileCode} }, - " (void)$self->{newXS}(\"$pname\", XS_$Full_func_name, file$self->{proto});\n"); + " (void)$self->{newXS}(\"$self->{pname}\", XS_$self->{Full_func_name}, file$self->{proto});\n"); } } # END 'PARAGRAPH' 'while' loop @@ -888,10 +873,10 @@ EOF # EOF unshift(@{ $self->{InitFileCode} }, <<"MAKE_FETCHMETHOD_WORK"); - /* Making a sub named "${Package}::()" allows the package */ + /* Making a sub named "$self->{Package}::()" allows the package */ /* to be findable via fetchmethod(), and causes */ - /* overload::Overloaded("${Package}") to return true. */ - (void)$self->{newXS}("${Package}::()", XS_$self->{Packid}_nil, file$self->{proto}); + /* overload::Overloaded("$self->{Package}") to return true. */ + (void)$self->{newXS}("$self->{Package}::()", XS_$self->{Packid}_nil, file$self->{proto}); MAKE_FETCHMETHOD_WORK } @@ -916,9 +901,9 @@ EOF #Under 5.8.x and lower, newXS is declared in proto.h as expecting a non-const #file name argument. If the wrong qualifier is used, it causes breakage with #C++ compilers and warnings with recent gcc. - #-Wall: if there is no $Full_func_name there are no xsubs in this .xs + #-Wall: if there is no $self->{Full_func_name} there are no xsubs in this .xs #so 'file' is unused - print Q(<<"EOF") if $Full_func_name; + print Q(<<"EOF") if $self->{Full_func_name}; ##if (PERL_REVISION == 5 && PERL_VERSION < 9) # char* file = __FILE__; ##else @@ -941,7 +926,7 @@ EOF # EOF - print Q(<<"EOF") if defined $self->{xsubaliases} or defined $self->{interfaces}; + print Q(<<"EOF") if defined $self->{XsubAliases} or defined $self->{interfaces}; # { # CV * cv; # @@ -956,14 +941,14 @@ EOF # /* mentioned above, and looks in the SV* slot of it for */ # /* the "fallback" status. */ # sv_setsv( -# get_sv( "${Package}::()", TRUE ), +# get_sv( "$self->{Package}::()", TRUE ), # $self->{Fallback} # ); EOF print @{ $self->{InitFileCode} }; - print Q(<<"EOF") if defined $self->{xsubaliases} or defined $self->{interfaces}; + print Q(<<"EOF") if defined $self->{XsubAliases} or defined $self->{interfaces}; # } EOF @@ -998,7 +983,14 @@ EOF return 1; } -sub report_error_count { $self->{errors} } +sub report_error_count { + if (@_) { + return $_[0]->{errors}||0; + } + else { + return $Singleton->{errors}||0; + } +} # Input: ($self, $_, @{ $self->{line} }) == unparsed input. # Output: ($_, @{ $self->{line} }) == (rest of line, following lines). @@ -1020,7 +1012,7 @@ sub print_section { print("#line ", $self->{line_no}->[@{ $self->{line_no} } - @{ $self->{line} } -1], " \"", escape_file_for_line_directive($self->{filepathname}), "\"\n") if $self->{WantLineNumbers} && !/^\s*#\s*line\b/ && !/^#if XSubPPtmp/; - for (; defined($_) && !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; defined($_) && !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { print "$_\n"; $consumed_code .= "$_\n"; } @@ -1037,7 +1029,7 @@ sub merge_section { $_ = shift(@{ $self->{line} }); } - for (; defined($_) && !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; defined($_) && !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { $in .= "$_\n"; } chomp $in; @@ -1067,7 +1059,7 @@ sub CASE_handler { sub INPUT_handler { my $self = shift; $_ = shift; - for (; !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { last if /^\s*NOT_IMPLEMENTED_YET/; next unless /\S/; # skip blank lines @@ -1136,7 +1128,7 @@ sub INPUT_handler { } } elsif ($var_init =~ /\S/) { - output_init( { + $self->output_init( { type => $var_type, num => $self->{var_num}, var => $var_name, @@ -1145,7 +1137,7 @@ sub INPUT_handler { } ); } elsif ($self->{var_num}) { - generate_init( { + $self->generate_init( { type => $var_type, num => $self->{var_num}, var => $var_name, @@ -1163,7 +1155,7 @@ sub OUTPUT_handler { $self->{have_OUTPUT} = 1; $_ = shift; - for (; !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { next unless /\S/; if (/^\s*SETMAGIC\s*:\s*(ENABLE|DISABLE)\s*/) { $self->{DoSetMagic} = ($1 eq "ENABLE" ? 1 : 0); @@ -1188,7 +1180,7 @@ sub OUTPUT_handler { print "\tSvSETMAGIC(ST(" , $self->{var_num} - 1 , "));\n" if $self->{DoSetMagic}; } else { - generate_output( { + $self->generate_output( { type => $self->{var_types}->{$outarg}, num => $self->{var_num}, var => $outarg, @@ -1289,7 +1281,6 @@ sub get_aliases { Warn( $self, "Warning: Aliases '$orig_alias' and '$self->{XsubAliasValues}->{$value}' have identical values") if $self->{XsubAliasValues}->{$value}; - $self->{xsubaliases} = 1; $self->{XsubAliases}->{$alias} = $value; $self->{XsubAliasValues}->{$value} = $orig_alias; } @@ -1302,7 +1293,7 @@ sub ATTRS_handler { my $self = shift; $_ = shift; - for (; !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { next unless /\S/; trim_whitespace($_); push @{ $self->{Attributes} }, $_; @@ -1313,7 +1304,7 @@ sub ALIAS_handler { my $self = shift; $_ = shift; - for (; !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { next unless /\S/; trim_whitespace($_); $self->get_aliases($_) if $_; @@ -1324,26 +1315,27 @@ sub OVERLOAD_handler { my $self = shift; $_ = shift; - for (; !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { next unless /\S/; trim_whitespace($_); while ( s/^\s*([\w:"\\)\+\-\*\/\%\<\>\.\&\|\^\!\~\{\}\=]+)\s*//) { $self->{Overload} = 1 unless $self->{Overload}; - my $overload = "$Package\::(".$1; + my $overload = "$self->{Package}\::(".$1; push(@{ $self->{InitFileCode} }, - " (void)$self->{newXS}(\"$overload\", XS_$Full_func_name, file$self->{proto});\n"); + " (void)$self->{newXS}(\"$overload\", XS_$self->{Full_func_name}, file$self->{proto});\n"); } } } sub FALLBACK_handler { - my $self = shift; - $_ = shift; + my ($self, $setting) = @_; # the rest of the current line should contain either TRUE, # FALSE or UNDEF - trim_whitespace($_); + trim_whitespace($setting); + $setting = uc($setting); + my %map = ( TRUE => "&PL_sv_yes", 1 => "&PL_sv_yes", FALSE => "&PL_sv_no", 0 => "&PL_sv_no", @@ -1351,42 +1343,39 @@ sub FALLBACK_handler { ); # check for valid FALLBACK value - $self->death("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{uc $_}; + $self->death("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{$setting}; - $self->{Fallback} = $map{uc $_}; + $self->{Fallback} = $map{$setting}; } sub REQUIRE_handler { - my $self = shift; # the rest of the current line should contain a version number - my $Ver = shift; + my ($self, $ver) = @_; - trim_whitespace($Ver); + trim_whitespace($ver); $self->death("Error: REQUIRE expects a version number") - unless $Ver; + unless $ver; # check that the version number is of the form n.n - $self->death("Error: REQUIRE: expected a number, got '$Ver'") - unless $Ver =~ /^\d+(\.\d*)?/; + $self->death("Error: REQUIRE: expected a number, got '$ver'") + unless $ver =~ /^\d+(\.\d*)?/; - $self->death("Error: xsubpp $Ver (or better) required--this is only $VERSION.") - unless $VERSION >= $Ver; + $self->death("Error: xsubpp $ver (or better) required--this is only $VERSION.") + unless $VERSION >= $ver; } sub VERSIONCHECK_handler { - my $self = shift; - $_ = shift; - # the rest of the current line should contain either ENABLE or # DISABLE + my ($self, $setting) = @_; - trim_whitespace($_); + trim_whitespace($setting); # check for ENABLE/DISABLE $self->death("Error: VERSIONCHECK: ENABLE/DISABLE") - unless /^(ENABLE|DISABLE)/i; + unless $setting =~ /^(ENABLE|DISABLE)/i; $self->{WantVersionChk} = 1 if $1 eq 'ENABLE'; $self->{WantVersionChk} = 0 if $1 eq 'DISABLE'; @@ -1402,7 +1391,7 @@ sub PROTOTYPE_handler { $self->death("Error: Only 1 PROTOTYPE definition allowed per xsub") if $self->{proto_in_this_xsub}++; - for (; !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { next unless /\S/; $specified = 1; trim_whitespace($_); @@ -1428,30 +1417,28 @@ sub PROTOTYPE_handler { } sub SCOPE_handler { - my $self = shift; - $_ = shift; + # Rest of line should be either ENABLE or DISABLE + my ($self, $setting) = @_; $self->death("Error: Only 1 SCOPE declaration allowed per xsub") if $self->{scope_in_this_xsub}++; - trim_whitespace($_); + trim_whitespace($setting); $self->death("Error: SCOPE: ENABLE/DISABLE") - unless /^(ENABLE|DISABLE)\b/i; + unless $setting =~ /^(ENABLE|DISABLE)\b/i; $self->{ScopeThisXSUB} = ( uc($1) eq 'ENABLE' ); } sub PROTOTYPES_handler { - my $self = shift; - $_ = shift; - # the rest of the current line should contain either ENABLE or # DISABLE + my ($self, $setting) = @_; - trim_whitespace($_); + trim_whitespace($setting); # check for ENABLE/DISABLE $self->death("Error: PROTOTYPES: ENABLE/DISABLE") - unless /^(ENABLE|DISABLE)/i; + unless $setting =~ /^(ENABLE|DISABLE)/i; $self->{WantPrototypes} = 1 if $1 eq 'ENABLE'; $self->{WantPrototypes} = 0 if $1 eq 'DISABLE'; @@ -1459,17 +1446,15 @@ sub PROTOTYPES_handler { } sub EXPORT_XSUB_SYMBOLS_handler { - my $self = shift; - $_ = shift; - # the rest of the current line should contain either ENABLE or # DISABLE + my ($self, $setting) = @_; - trim_whitespace($_); + trim_whitespace($setting); # check for ENABLE/DISABLE $self->death("Error: EXPORT_XSUB_SYMBOLS: ENABLE/DISABLE") - unless /^(ENABLE|DISABLE)/i; + unless $setting =~ /^(ENABLE|DISABLE)/i; my $xs_impl = $1 eq 'ENABLE' ? 'XS_EXTERNAL' : 'XS_INTERNAL'; @@ -1638,7 +1623,7 @@ sub PopFile { close $self->{FH}; $self->{FH} = $data->{Handle}; - # $filename is the leafname, which for some reason isused for diagnostic + # $filename is the leafname, which for some reason is used for diagnostic # messages, whereas $filepathname is the full pathname, and is used for # #line directives. $self->{filename} = $data->{Filename}; @@ -1671,6 +1656,69 @@ sub Q { $text; } +# Process "MODULE = Foo ..." lines and update global state accordingly +sub _process_module_xs_line { + my ($self, $module, $pkg, $prefix) = @_; + + ($self->{Module_cname} = $module) =~ s/\W/_/g; + + $self->{Package} = defined($pkg) ? $pkg : ''; + $self->{Prefix} = quotemeta( defined($prefix) ? $prefix : '' ); + + ($self->{Packid} = $self->{Package}) =~ tr/:/_/; + + $self->{Packprefix} = $self->{Package}; + $self->{Packprefix} .= "::" if $self->{Packprefix} ne ""; + + $self->{lastline} = ""; +} + +# Skip any embedded POD sections +sub _maybe_skip_pod { + my ($self) = @_; + + while ($self->{lastline} =~ /^=/) { + while ($self->{lastline} = readline($self->{FH})) { + last if ($self->{lastline} =~ /^=cut\s*$/); + } + $self->death("Error: Unterminated pod") unless defined $self->{lastline}; + $self->{lastline} = readline($self->{FH}); + chomp $self->{lastline}; + $self->{lastline} =~ s/^\s+$//; + } +} + +# This chunk of code strips out (and parses) embedded TYPEMAP blocks +# which support a HEREdoc-alike block syntax. +sub _maybe_parse_typemap_block { + my ($self) = @_; + + # This is special cased from the usual paragraph-handler logic + # due to the HEREdoc-ish syntax. + if ($self->{lastline} =~ /^TYPEMAP\s*:\s*<<\s*(?:(["'])(.+?)\1|([^\s'"]+?))\s*;?\s*$/) + { + my $end_marker = quotemeta(defined($1) ? $2 : $3); + + # Scan until we find $end_marker alone on a line. + my @tmaplines; + while (1) { + $self->{lastline} = readline($self->{FH}); + $self->death("Error: Unterminated TYPEMAP section") if not defined $self->{lastline}; + last if $self->{lastline} =~ /^$end_marker\s*$/; + push @tmaplines, $self->{lastline}; + } + + my $tmap = ExtUtils::Typemaps->new( + string => join("", @tmaplines), + lineno_offset => 1 + ($self->current_line_number() || 0), + fake_filename => $self->{filename}, + ); + $self->{typemap}->merge(typemap => $tmap, replace => 1); + + $self->{lastline} = ""; + } +} + # Read next xsub into @{ $self->{line} } from ($lastline, readline($self->{FH})). sub fetch_para { my $self = shift; @@ -1680,66 +1728,38 @@ sub fetch_para { if !defined $self->{lastline} && $self->{XSStack}->[-1]{type} eq 'if'; @{ $self->{line} } = (); @{ $self->{line_no} } = (); - return $self->PopFile() if !defined $self->{lastline}; + return $self->PopFile() if not defined $self->{lastline}; # EOF if ($self->{lastline} =~ - /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/) { - my $Module = $1; - $Package = defined($2) ? $2 : ''; # keep -w happy - $self->{Prefix} = defined($3) ? $3 : ''; # keep -w happy - $self->{Prefix} = quotemeta $self->{Prefix}; - ($self->{Module_cname} = $Module) =~ s/\W/_/g; - ($self->{Packid} = $Package) =~ tr/:/_/; - $self->{Packprefix} = $Package; - $self->{Packprefix} .= "::" if $self->{Packprefix} ne ""; - $self->{lastline} = ""; + /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/) + { + $self->_process_module_xs_line($1, $2, $3); } for (;;) { - # Skip embedded PODs - while ($self->{lastline} =~ /^=/) { - while ($self->{lastline} = readline($self->{FH})) { - last if ($self->{lastline} =~ /^=cut\s*$/); - } - $self->death("Error: Unterminated pod") unless $self->{lastline}; - $self->{lastline} = readline($self->{FH}); - chomp $self->{lastline}; - $self->{lastline} =~ s/^\s+$//; - } - - # This chunk of code strips out (and parses) embedded TYPEMAP blocks - # which support a HEREdoc-alike block syntax. - # This is special cased from the usual paragraph-handler logic - # due to the HEREdoc-ish syntax. - if ($self->{lastline} =~ /^TYPEMAP\s*:\s*<<\s*(?:(["'])(.+?)\1|([^\s'"]+))\s*;?\s*$/) { - my $end_marker = quotemeta(defined($1) ? $2 : $3); - my @tmaplines; - while (1) { - $self->{lastline} = readline($self->{FH}); - $self->death("Error: Unterminated typemap") if not defined $self->{lastline}; - last if $self->{lastline} =~ /^$end_marker\s*$/; - push @tmaplines, $self->{lastline}; - } - - my $tmapcode = join "", @tmaplines; - my $tmap = ExtUtils::Typemaps->new( - string => $tmapcode, - lineno_offset => ($self->current_line_number()||0)+1, - fake_filename => $self->{filename}, - ); - $self->{typemap}->merge(typemap => $tmap, replace => 1); - - $self->{lastline} = ""; - } - - if ($self->{lastline} !~ /^\s*#/ || - # CPP directives: - # ANSI: if ifdef ifndef elif else endif define undef - # line error pragma - # gcc: warning include_next - # obj-c: import - # others: ident (gcc notes that some cpps have this one) - $self->{lastline} =~ /^#[ \t]*(?:(?:if|ifn?def|elif|else|endif|define|undef|pragma|error|warning|line\s+\d+|ident)\b|(?:include(?:_next)?|import)\s*["<].*[>"])/) { + $self->_maybe_skip_pod; + + $self->_maybe_parse_typemap_block; + + if ($self->{lastline} !~ /^\s*#/ # not a CPP directive + # CPP directives: + # ANSI: if ifdef ifndef elif else endif define undef + # line error pragma + # gcc: warning include_next + # obj-c: import + # others: ident (gcc notes that some cpps have this one) + || $self->{lastline} =~ /^\#[ \t]* + (?: + (?:if|ifn?def|elif|else|endif| + define|undef|pragma|error| + warning|line\s+\d+|ident) + \b + | (?:include(?:_next)?|import) + \s* ["<] .* [>"] + ) + /x + ) + { last if $self->{lastline} =~ /^\S/ && @{ $self->{line} } && $self->{line}->[-1] eq ""; push(@{ $self->{line} }, $self->{lastline}); push(@{ $self->{line_no} }, $self->{lastline_no}); @@ -1755,33 +1775,37 @@ sub fetch_para { chomp $self->{lastline}; $self->{lastline} =~ s/^\s+$//; } - pop(@{ $self->{line} }), pop(@{ $self->{line_no} }) while @{ $self->{line} } && $self->{line}->[-1] eq ""; - 1; + + # Nuke trailing "line" entries until there's one that's not empty + pop(@{ $self->{line} }), pop(@{ $self->{line_no} }) + while @{ $self->{line} } && $self->{line}->[-1] eq ""; + + return 1; } sub output_init { + my $self = shift; my $argsref = shift; - my ($type, $num, $var, $init, $printed_name) = ( - $argsref->{type}, - $argsref->{num}, - $argsref->{var}, - $argsref->{init}, - $argsref->{printed_name} - ); - my $arg = $num ? "ST(" . ($num - 1) . ")" : "/* not a parameter */"; - if ( $init =~ /^=/ ) { + my ($type, $num, $var, $init, $printed_name) + = @{$argsref}{qw(type num var init printed_name)}; + + # local assign for efficiently passing in to eval_input_typemap_code + local $argsref->{arg} = $num + ? "ST(" . ($num-1) . ")" + : "/* not a parameter */"; + + if ( $init =~ /^=/ ) { if ($printed_name) { - eval qq/print " $init\\n"/; + $self->eval_input_typemap_code(qq/print " $init\\n"/, $argsref); } else { - eval qq/print "\\t$var $init\\n"/; + $self->eval_input_typemap_code(qq/print "\\t$var $init\\n"/, $argsref); } - warn $@ if $@; } else { if ( $init =~ s/^\+// && $num ) { - generate_init( { + $self->generate_init( { type => $type, num => $num, var => $var, @@ -1793,39 +1817,38 @@ sub output_init { $init =~ s/^;//; } else { - eval qq/print "\\t$var;\\n"/; - warn $@ if $@; + $self->eval_input_typemap_code(qq/print "\\t$var;\\n"/, $argsref); $init =~ s/^;//; } - $self->{deferred} .= eval qq/"\\n\\t$init\\n"/; - warn $@ if $@; + $self->{deferred} + .= $self->eval_input_typemap_code(qq/"\\n\\t$init\\n"/, $argsref); } } sub generate_init { + my $self = shift; my $argsref = shift; - my ($type, $num, $var, $printed_name) = ( - $argsref->{type}, - $argsref->{num}, - $argsref->{var}, - $argsref->{printed_name}, - ); - my $arg = "ST(" . ($num - 1) . ")"; - my ($argoff, $ntype); - $argoff = $num - 1; + + my ($type, $num, $var, $printed_name) + = @{$argsref}{qw(type num var printed_name)}; + + my $argoff = $num - 1; + my $arg = "ST($argoff)"; my $typemaps = $self->{typemap}; - $type = tidy_type($type); - $self->report_typemap_failure($typemaps, $type), return - unless $typemaps->get_typemap(ctype => $type); + $type = ExtUtils::Typemaps::tidy_type($type); + if (not $typemaps->get_typemap(ctype => $type)) { + $self->report_typemap_failure($typemaps, $type); + return; + } + + (my $ntype = $type) =~ s/\s*\*/Ptr/g; + (my $subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//; - ($ntype = $type) =~ s/\s*\*/Ptr/g; - my $subtype; - ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//; my $typem = $typemaps->get_typemap(ctype => $type); my $xstype = $typem->xstype; - $xstype =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/; + $xstype =~ s/OBJ$/REF/ if $self->{func_name} =~ /DESTROY$/; if ($xstype eq 'T_PV' and exists $self->{lengthof}->{$var}) { print "\t$var" unless $printed_name; print " = ($type)SvPV($arg, STRLEN_length_of_$var);\n"; @@ -1833,21 +1856,29 @@ sub generate_init { if defined $self->{defaults}->{$var}; return; } - $type =~ tr/:/_/ unless $self->{hiertype}; + $type =~ tr/:/_/ unless $self->{RetainCplusplusHierarchicalTypes}; my $inputmap = $typemaps->get_inputmap(xstype => $xstype); - $self->blurt("Error: No INPUT definition for type '$type', typekind '" . $type->xstype . "' found"), return - unless defined $inputmap; + if (not defined $inputmap) { + $self->blurt("Error: No INPUT definition for type '$type', typekind '" . $type->xstype . "' found"); + return; + } my $expr = $inputmap->cleaned_code; # Note: This gruesome bit either needs heavy rethinking or documentation. I vote for the former. --Steffen if ($expr =~ /DO_ARRAY_ELEM/) { my $subtypemap = $typemaps->get_typemap(ctype => $subtype); - $self->report_typemap_failure($typemaps, $subtype), return - if not $subtypemap; + if (not $subtypemap) { + $self->report_typemap_failure($typemaps, $subtype); + return; + } + my $subinputmap = $typemaps->get_inputmap(xstype => $subtypemap->xstype); - $self->blurt("Error: No INPUT definition for type '$subtype', typekind '" . $subtypemap->xstype . "' found"), return - unless $subinputmap; + if (not $subinputmap) { + $self->blurt("Error: No INPUT definition for type '$subtype', typekind '" . $subtypemap->xstype . "' found"); + return; + } + my $subexpr = $subinputmap->cleaned_code; $subexpr =~ s/\$type/\$subtype/g; $subexpr =~ s/ntype/subtype/g; @@ -1860,6 +1891,18 @@ sub generate_init { if ($expr =~ m#/\*.*scope.*\*/#i) { # "scope" in C comments $self->{ScopeThisXSUB} = 1; } + + my $eval_vars = { + var => $var, + printed_name => $printed_name, + type => $type, + ntype => $ntype, + subtype => $subtype, + num => $num, + arg => $arg, + argoff => $argoff, + }; + if (defined($self->{defaults}->{$var})) { $expr =~ s/(\t+)/$1 /g; $expr =~ s/ /\t/g; @@ -1867,51 +1910,51 @@ sub generate_init { print ";\n"; } else { - eval qq/print "\\t$var;\\n"/; - warn $@ if $@; + $self->eval_input_typemap_code(qq/print "\\t$var;\\n"/, $eval_vars); } if ($self->{defaults}->{$var} eq 'NO_INIT') { - $self->{deferred} .= eval qq/"\\n\\tif (items >= $num) {\\n$expr;\\n\\t}\\n"/; + $self->{deferred} .= $self->eval_input_typemap_code( + qq/"\\n\\tif (items >= $num) {\\n$expr;\\n\\t}\\n"/, + $eval_vars + ); } else { - $self->{deferred} .= eval qq/"\\n\\tif (items < $num)\\n\\t $var = $self->{defaults}->{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/; + $self->{deferred} .= $self->eval_input_typemap_code( + qq/"\\n\\tif (items < $num)\\n\\t $var = $self->{defaults}->{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/, + $eval_vars + ); } - warn $@ if $@; } elsif ($self->{ScopeThisXSUB} or $expr !~ /^\s*\$var =/) { if ($printed_name) { print ";\n"; } else { - eval qq/print "\\t$var;\\n"/; - warn $@ if $@; + $self->eval_input_typemap_code(qq/print "\\t$var;\\n"/, $eval_vars); } - $self->{deferred} .= eval qq/"\\n$expr;\\n"/; - warn $@ if $@; + $self->{deferred} + .= $self->eval_input_typemap_code(qq/"\\n$expr;\\n"/, $eval_vars); } else { die "panic: do not know how to handle this branch for function pointers" if $printed_name; - eval qq/print "$expr;\\n"/; - warn $@ if $@; + $self->eval_input_typemap_code(qq/print "$expr;\\n"/, $eval_vars); } } sub generate_output { + my $self = shift; my $argsref = shift; - my ($type, $num, $var, $do_setmagic, $do_push) = ( - $argsref->{type}, - $argsref->{num}, - $argsref->{var}, - $argsref->{do_setmagic}, - $argsref->{do_push} - ); + my ($type, $num, $var, $do_setmagic, $do_push) + = @{$argsref}{qw(type num var do_setmagic do_push)}; + my $arg = "ST(" . ($num - ($num != 0)) . ")"; - my $ntype; my $typemaps = $self->{typemap}; - $type = tidy_type($type); + $type = ExtUtils::Typemaps::tidy_type($type); + local $argsref->{type} = $type; + if ($type =~ /^array\(([^,]*),(.*)\)/) { print "\t$arg = sv_newmortal();\n"; print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1));\n"; @@ -1919,48 +1962,64 @@ sub generate_output { } else { my $typemap = $typemaps->get_typemap(ctype => $type); - $self->report_typemap_failure($typemaps, $type), return - if not $typemap; + if (not $typemap) { + $self->report_typemap_failure($typemaps, $type); + return; + } + my $outputmap = $typemaps->get_outputmap(xstype => $typemap->xstype); - $self->blurt("Error: No OUTPUT definition for type '$type', typekind '" . $typemap->xstype . "' found"), return - unless $outputmap; - ($ntype = $type) =~ s/\s*\*/Ptr/g; + if (not $outputmap) { + $self->blurt("Error: No OUTPUT definition for type '$type', typekind '" . $typemap->xstype . "' found"); + return; + } + + (my $ntype = $type) =~ s/\s*\*/Ptr/g; $ntype =~ s/\(\)//g; - my $subtype; - ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//; + (my $subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//; + my $eval_vars = {%$argsref, subtype => $subtype, ntype => $ntype, arg => $arg}; my $expr = $outputmap->cleaned_code; if ($expr =~ /DO_ARRAY_ELEM/) { my $subtypemap = $typemaps->get_typemap(ctype => $subtype); - $self->report_typemap_failure($typemaps, $subtype), return - if not $subtypemap; + if (not $subtypemap) { + $self->report_typemap_failure($typemaps, $subtype); + return; + } + my $suboutputmap = $typemaps->get_outputmap(xstype => $subtypemap->xstype); - $self->blurt("Error: No OUTPUT definition for type '$subtype', typekind '" . $subtypemap->xstype . "' found"), return - unless $suboutputmap; + if (not $suboutputmap) { + $self->blurt("Error: No OUTPUT definition for type '$subtype', typekind '" . $subtypemap->xstype . "' found"); + return; + } + my $subexpr = $suboutputmap->cleaned_code; $subexpr =~ s/ntype/subtype/g; $subexpr =~ s/\$arg/ST(ix_$var)/g; $subexpr =~ s/\$var/${var}\[ix_$var]/g; $subexpr =~ s/\n\t/\n\t\t/g; $expr =~ s/DO_ARRAY_ELEM\n/$subexpr/; - eval "print qq\a$expr\a"; - warn $@ if $@; + $self->eval_output_typemap_code("print qq\a$expr\a", $eval_vars); print "\t\tSvSETMAGIC(ST(ix_$var));\n" if $do_setmagic; } elsif ($var eq 'RETVAL') { - if ($expr =~ /^\t\$arg = new/) { + my $evalexpr = $self->eval_output_typemap_code("qq\a$expr\a", $eval_vars); + if ($expr =~ /^\t\Q$arg\E = new/) { # We expect that $arg has refcnt 1, so we need to # mortalize it. - eval "print qq\a$expr\a"; - warn $@ if $@; + print $evalexpr; print "\tsv_2mortal(ST($num));\n"; print "\tSvSETMAGIC(ST($num));\n" if $do_setmagic; } - elsif ($expr =~ /^\s*\$arg\s*=/) { + # If RETVAL is immortal, don't mortalize it. This code is not perfect: + # It won't detect a func or expression that only returns immortals, for + # example, this RE must be tried before next elsif. + elsif ($evalexpr =~ /^\t\Q$arg\E\s*=\s*(boolSV\(|(&PL_sv_yes|&PL_sv_no|&PL_sv_undef)\s*;)/) { + print $evalexpr; + } + elsif ($evalexpr =~ /^\s*\Q$arg\E\s*=/) { # We expect that $arg has refcnt >=1, so we need # to mortalize it! - eval "print qq\a$expr\a"; - warn $@ if $@; + print $evalexpr; print "\tsv_2mortal(ST(0));\n"; print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic; } @@ -1968,28 +2027,39 @@ sub generate_output { # Just hope that the entry would safely write it # over an already mortalized value. By # coincidence, something like $arg = &sv_undef - # works too. + # works too, but should be caught above. print "\tST(0) = sv_newmortal();\n"; - eval "print qq\a$expr\a"; - warn $@ if $@; + print $evalexpr; # new mortals don't have set magic } } elsif ($do_push) { print "\tPUSHs(sv_newmortal());\n"; - $arg = "ST($num)"; - eval "print qq\a$expr\a"; - warn $@ if $@; + local $eval_vars->{arg} = "ST($num)"; + $self->eval_output_typemap_code("print qq\a$expr\a", $eval_vars); print "\tSvSETMAGIC($arg);\n" if $do_setmagic; } elsif ($arg =~ /^ST\(\d+\)$/) { - eval "print qq\a$expr\a"; - warn $@ if $@; + $self->eval_output_typemap_code("print qq\a$expr\a", $eval_vars); print "\tSvSETMAGIC($arg);\n" if $do_setmagic; } } } + +# Just delegates to a clean package. +# Shim to evaluate Perl code in the right variable context +# for typemap code (having things such as $ALIAS set up). +sub eval_output_typemap_code { + my ($self, $code, $other) = @_; + return ExtUtils::ParseXS::Eval::eval_output_typemap_code($self, $code, $other); +} + +sub eval_input_typemap_code { + my ($self, $code, $other) = @_; + return ExtUtils::ParseXS::Eval::eval_input_typemap_code($self, $code, $other); +} + 1; # vim: ts=2 sw=2 et: diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pod b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pod new file mode 100644 index 00000000000..6bec01482cf --- /dev/null +++ b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS.pod @@ -0,0 +1,177 @@ +=head1 NAME + +ExtUtils::ParseXS - converts Perl XS code into C code + +=head1 SYNOPSIS + + use ExtUtils::ParseXS; + + my $pxs = ExtUtils::ParseXS->new; + $pxs->process_file( filename => 'foo.xs' ); + + $pxs->process_file( filename => 'foo.xs', + output => 'bar.c', + 'C++' => 1, + typemap => 'path/to/typemap', + hiertype => 1, + except => 1, + versioncheck => 1, + linenumbers => 1, + optimize => 1, + prototypes => 1, + ); + + # Legacy non-OO interface using a singleton: + use ExtUtils::ParseXS qw(process_file); + process_file( filename => 'foo.xs' ); + +=head1 DESCRIPTION + +C<ExtUtils::ParseXS> will compile XS code into C code by embedding the constructs +necessary to let C functions manipulate Perl values and creates the glue +necessary to let Perl access those functions. The compiler uses typemaps to +determine how to map C function parameters and variables to Perl values. + +The compiler will search for typemap files called I<typemap>. It will use +the following search path to find default typemaps, with the rightmost +typemap taking precedence. + + ../../../typemap:../../typemap:../typemap:typemap + +=head1 EXPORT + +None by default. C<process_file()> and/or C<report_error_count()> +may be exported upon request. Using the functional interface is +discouraged. + +=head1 METHODS + +=over 4 + +=item $pxs->new() + +Returns a new, empty XS parser/compiler object. + +=item $pxs->process_file() + +This method processes an XS file and sends output to a C file. +The method may be called as a function (this is the legacy +interface) and will then use a singleton as invocant. + +Named parameters control how the processing is done. +The following parameters are accepted: + +=over 4 + +=item B<C++> + +Adds C<extern "C"> to the C code. Default is false. + +=item B<hiertype> + +Retains C<::> in type names so that C++ hierarchical types can be +mapped. Default is false. + +=item B<except> + +Adds exception handling stubs to the C code. Default is false. + +=item B<typemap> + +Indicates that a user-supplied typemap should take precedence over the +default typemaps. A single typemap may be specified as a string, or +multiple typemaps can be specified in an array reference, with the +last typemap having the highest precedence. + +=item B<prototypes> + +Generates prototype code for all xsubs. Default is false. + +=item B<versioncheck> + +Makes sure at run time that the object file (derived from the C<.xs> +file) and the C<.pm> files have the same version number. Default is +true. + +=item B<linenumbers> + +Adds C<#line> directives to the C output so error messages will look +like they came from the original XS file. Default is true. + +=item B<optimize> + +Enables certain optimizations. The only optimization that is currently +affected is the use of I<target>s by the output C code (see L<perlguts>). +Not optimizing may significantly slow down the generated code, but this is the way +B<xsubpp> of 5.005 and earlier operated. Default is to optimize. + +=item B<inout> + +Enable recognition of C<IN>, C<OUT_LIST> and C<INOUT_LIST> +declarations. Default is true. + +=item B<argtypes> + +Enable recognition of ANSI-like descriptions of function signature. +Default is true. + +=item B<s> + +I<Maintainer note:> I have no clue what this does. Strips function prefixes? + +=back + +=item $pxs->report_error_count() + +This method returns the number of [a certain kind of] errors +encountered during processing of the XS file. + +The method may be called as a function (this is the legacy +interface) and will then use a singleton as invocant. + +=back + +=head1 AUTHOR + +Based on xsubpp code, written by Larry Wall. + +Maintained by: + +=over 4 + +=item * + +Ken Williams, <ken@mathforum.org> + +=item * + +David Golden, <dagolden@cpan.org> + +=item * + +James Keenan, <jkeenan@cpan.org> + +=item * + +Steffen Mueller, <smueller@cpan.org> + +=back + +=head1 COPYRIGHT + +Copyright 2002-2014 by Ken Williams, David Golden and other contributors. All +rights reserved. + +This library is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +Based on the C<ExtUtils::xsubpp> code by Larry Wall and the Perl 5 +Porters, which was released under the same license terms. + +=head1 SEE ALSO + +L<perl>, ExtUtils::xsubpp, ExtUtils::MakeMaker, L<perlxs>, L<perlxstut>. + +=cut + + diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Constants.pm b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Constants.pm index 2e27169aa22..34fbc21e167 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Constants.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Constants.pm @@ -3,7 +3,7 @@ use strict; use warnings; use Symbol; -our $VERSION = '3.18'; +our $VERSION = '3.24'; =head1 NAME @@ -39,4 +39,6 @@ our @XSKeywords = qw( EXPORT_XSUB_SYMBOLS ); +our $XSKeywordsAlternation = join('|', @XSKeywords); + 1; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/CountLines.pm b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/CountLines.pm index 7e2a0f5030b..473f531f750 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/CountLines.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/CountLines.pm @@ -1,7 +1,7 @@ package ExtUtils::ParseXS::CountLines; use strict; -our $VERSION = '3.18'; +our $VERSION = '3.24'; our $SECTION_END_MARKER; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Eval.pm b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Eval.pm new file mode 100644 index 00000000000..4b8cbd6337e --- /dev/null +++ b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Eval.pm @@ -0,0 +1,97 @@ +package ExtUtils::ParseXS::Eval; +use strict; +use warnings; + +our $VERSION = '3.24'; + +=head1 NAME + +ExtUtils::ParseXS::Eval - Clean package to evaluate code in + +=head1 SYNOPSIS + + use ExtUtils::ParseXS::Eval; + my $rv = ExtUtils::ParseXS::Eval::eval_typemap_code( + $parsexs_obj, "some Perl code" + ); + +=head1 SUBROUTINES + +=head2 $pxs->eval_output_typemap_code($typemapcode, $other_hashref) + +Sets up various bits of previously global state +(formerly ExtUtils::ParseXS package variables) +for eval'ing output typemap code that may refer to these +variables. + +Warns the contents of C<$@> if any. + +Not all these variables are necessarily considered "public" wrt. use in +typemaps, so beware. Variables set up from the ExtUtils::ParseXS object: + + $Package $Alias $func_name $Full_func_name $pname + +Variables set up from C<$other_hashref>: + + $var $type $ntype $subtype $arg + +=cut + +sub eval_output_typemap_code { + my ($_pxs, $_code, $_other) = @_; + + my ($Package, $ALIAS, $func_name, $Full_func_name, $pname) + = @{$_pxs}{qw(Package ALIAS func_name Full_func_name pname)}; + + my ($var, $type, $ntype, $subtype, $arg) + = @{$_other}{qw(var type ntype subtype arg)}; + + my $rv = eval $_code; + warn $@ if $@; + return $rv; +} + +=head2 $pxs->eval_input_typemap_code($typemapcode, $other_hashref) + +Sets up various bits of previously global state +(formerly ExtUtils::ParseXS package variables) +for eval'ing output typemap code that may refer to these +variables. + +Warns the contents of C<$@> if any. + +Not all these variables are necessarily considered "public" wrt. use in +typemaps, so beware. Variables set up from the ExtUtils::ParseXS object: + + $Package $Alias $func_name $Full_func_name $pname + +Variables set up from C<$other_hashref>: + + $var $type $ntype $subtype $num $init $printed_name $arg $argoff + +=cut + +sub eval_input_typemap_code { + my ($_pxs, $_code, $_other) = @_; + + my ($Package, $ALIAS, $func_name, $Full_func_name, $pname) + = @{$_pxs}{qw(Package ALIAS func_name Full_func_name pname)}; + + my ($var, $type, $num, $init, $printed_name, $arg, $ntype, $argoff, $subtype) + = @{$_other}{qw(var type num init printed_name arg ntype argoff subtype)}; + + my $rv = eval $_code; + warn $@ if $@; + return $rv; +} + +=head1 TODO + +Eventually, with better documentation and possible some cleanup, +this could be part of C<ExtUtils::Typemaps>. + +=cut + +1; + +# vim: ts=2 sw=2 et: diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Utilities.pm b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Utilities.pm index a847a14a409..ae384fd5b58 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Utilities.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Utilities.pm @@ -6,18 +6,16 @@ use File::Spec; use lib qw( lib ); use ExtUtils::ParseXS::Constants (); -our $VERSION = '3.19'; +our $VERSION = '3.24'; our (@ISA, @EXPORT_OK); @ISA = qw(Exporter); @EXPORT_OK = qw( standard_typemap_locations trim_whitespace - tidy_type C_string valid_proto_string process_typemaps - make_targetable map_type standard_XS_defs assign_func_args @@ -41,11 +39,9 @@ ExtUtils::ParseXS::Utilities - Subroutines used with ExtUtils::ParseXS use ExtUtils::ParseXS::Utilities qw( standard_typemap_locations trim_whitespace - tidy_type C_string valid_proto_string process_typemaps - make_targetable map_type standard_XS_defs assign_func_args @@ -129,26 +125,35 @@ Array holding list of directories to be searched for F<typemap> files. =cut -sub standard_typemap_locations { - my $include_ref = shift; - my @tm = qw(typemap); - - my $updir = File::Spec->updir(); - foreach my $dir ( - File::Spec->catdir(($updir) x 1), - File::Spec->catdir(($updir) x 2), - File::Spec->catdir(($updir) x 3), - File::Spec->catdir(($updir) x 4), - ) { - unshift @tm, File::Spec->catfile($dir, 'typemap'); - unshift @tm, File::Spec->catfile($dir, lib => ExtUtils => 'typemap'); - } - foreach my $dir (@{ $include_ref}) { - my $file = File::Spec->catfile($dir, ExtUtils => 'typemap'); - unshift @tm, $file if -e $file; +SCOPE: { + my @tm_template; + + sub standard_typemap_locations { + my $include_ref = shift; + + if (not @tm_template) { + @tm_template = qw(typemap); + + my $updir = File::Spec->updir(); + foreach my $dir ( + File::Spec->catdir(($updir) x 1), + File::Spec->catdir(($updir) x 2), + File::Spec->catdir(($updir) x 3), + File::Spec->catdir(($updir) x 4), + ) { + unshift @tm_template, File::Spec->catfile($dir, 'typemap'); + unshift @tm_template, File::Spec->catfile($dir, lib => ExtUtils => 'typemap'); + } + } + + my @tm = @tm_template; + foreach my $dir (@{ $include_ref}) { + my $file = File::Spec->catfile($dir, ExtUtils => 'typemap'); + unshift @tm, $file if -e $file; + } + return @tm; } - return @tm; -} +} # end SCOPE =head2 C<trim_whitespace()> @@ -175,45 +180,6 @@ sub trim_whitespace { $_[0] =~ s/^\s+|\s+$//go; } -=head2 C<tidy_type()> - -=over 4 - -=item * Purpose - -Rationalize any asterisks (C<*>) by joining them into bunches, removing -interior whitespace, then trimming leading and trailing whitespace. - -=item * Arguments - - ($ret_type) = tidy_type($_); - -String to be cleaned up. - -=item * Return Value - -String cleaned up. - -=back - -=cut - -sub tidy_type { - local ($_) = @_; - - # rationalise any '*' by joining them into bunches and removing whitespace - s#\s*(\*+)\s*#$1#g; - s#(\*+)# $1 #g; - - # change multiple whitespace into a single space - s/\s+/ /g; - - # trim leading & trailing whitespace - trim_whitespace($_); - - $_; -} - =head2 C<C_string()> =over 4 @@ -266,7 +232,7 @@ Upon failure, returns C<0>. =cut sub valid_proto_string { - my($string) = @_; + my ($string) = @_; if ( $string =~ /^$ExtUtils::ParseXS::Constants::PrototypeRegexp+$/ ) { return $string; @@ -323,76 +289,6 @@ sub process_typemaps { return $typemap; } -=head2 C<make_targetable()> - -=over 4 - -=item * Purpose - -Populate C<%targetable>. This constitutes a refinement of the output of -C<process_typemaps()> with respect to its fourth output, C<$output_expr_ref>. - -=item * Arguments - - %targetable = make_targetable($output_expr_ref); - -Single hash reference: the fourth such ref returned by C<process_typemaps()>. - -=item * Return Value - -Hash. - -=back - -=cut - -sub make_targetable { - my $output_expr_ref = shift; - - our $bal; # ()-balanced - $bal = qr[ - (?: - (?>[^()]+) - | - \( (??{ $bal }) \) - )* - ]x; - - # matches variations on (SV*) - my $sv_cast = qr[ - (?: - \( \s* SV \s* \* \s* \) \s* - )? - ]x; - - my $size = qr[ # Third arg (to setpvn) - , \s* (??{ $bal }) - ]x; - - my %targetable; - foreach my $key (keys %{ $output_expr_ref }) { - # We can still bootstrap compile 're', because in code re.pm is - # available to miniperl, and does not attempt to load the XS code. - use re 'eval'; - - my ($type, $with_size, $arg, $sarg) = - ($output_expr_ref->{$key} =~ - m[^ - \s+ - sv_set([iunp])v(n)? # Type, is_setpvn - \s* - \( \s* - $sv_cast \$arg \s* , \s* - ( (??{ $bal }) ) # Set from - ( (??{ $size }) )? # Possible sizeof set-from - \) \s* ; \s* $ - ]x - ); - $targetable{$key} = [$type, $with_size, $arg, $sarg] if $type; - } - return %targetable; -} - =head2 C<map_type()> =over 4 @@ -419,7 +315,7 @@ sub map_type { my ($self, $type, $varname) = @_; # C++ has :: in types too so skip this - $type =~ tr/:/_/ unless $self->{hiertype}; + $type =~ tr/:/_/ unless $self->{RetainCplusplusHierarchicalTypes}; $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s; if ($varname) { if ($type =~ / \( \s* \* (?= \s* \) ) /xg) { diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps.pm index b9a43589488..8bc04af04c3 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps.pm @@ -2,7 +2,7 @@ package ExtUtils::Typemaps; use 5.006001; use strict; use warnings; -our $VERSION = '3.19'; +our $VERSION = '3.24'; #use Carp qw(croak); require ExtUtils::ParseXS; @@ -23,7 +23,7 @@ ExtUtils::Typemaps - Read/Write/Modify Perl/XS typemap files # $typemap = ExtUtils::Typemaps->new(); # alternatively create an in-memory typemap by parsing a string # $typemap = ExtUtils::Typemaps->new(string => $sometypemap); - + # add a mapping $typemap->add_typemap(ctype => 'NV', xstype => 'T_NV'); $typemap->add_inputmap( @@ -34,13 +34,13 @@ ExtUtils::Typemaps - Read/Write/Modify Perl/XS typemap files ); $typemap->add_string(string => $typemapstring); # will be parsed and merged - + # remove a mapping (same for remove_typemap and remove_outputmap...) $typemap->remove_inputmap(xstype => 'SomeType'); - + # save a typemap to a file $typemap->write(file => 'anotherfile.map'); - + # merge the other typemap into this one $typemap->merge(typemap => $another_typemap); @@ -111,6 +111,7 @@ sub _init { } } + =head2 file Get/set the file that the typemap is written to when the @@ -344,7 +345,7 @@ sub remove_typemap { my %args = @_; $ctype = $args{ctype}; die("Need ctype argument") if not defined $ctype; - $ctype = _tidy_type($ctype); + $ctype = tidy_type($ctype); } else { $ctype = $_[0]->tidy_ctype; @@ -443,7 +444,7 @@ sub get_typemap { my %args = @_; my $ctype = $args{ctype}; die("Need ctype argument") if not defined $ctype; - $ctype = _tidy_type($ctype); + $ctype = tidy_type($ctype); my $index = $self->{typemap_lookup}{$ctype}; return() if not defined $index; @@ -860,7 +861,7 @@ sub validate { my %args = @_; if ( exists $args{ctype} - and exists $self->{typemap_lookup}{_tidy_type($args{ctype})} ) + and exists $self->{typemap_lookup}{tidy_type($args{ctype})} ) { die("Multiple definition of ctype '$args{ctype}' in TYPEMAP section"); } @@ -880,6 +881,84 @@ sub validate { return 1; } +=head2 clone + +Creates and returns a clone of a full typemaps object. + +Takes named parameters: If C<shallow> is true, +the clone will share the actual individual type/input/outputmap objects, +but not share their storage. Use with caution. Without C<shallow>, +the clone will be fully independent. + +=cut + +sub clone { + my $proto = shift; + my %args = @_; + + my $self; + if ($args{shallow}) { + $self = bless( { + %$proto, + typemap_section => [@{$proto->{typemap_section}}], + typemap_lookup => {%{$proto->{typemap_lookup}}}, + input_section => [@{$proto->{input_section}}], + input_lookup => {%{$proto->{input_lookup}}}, + output_section => [@{$proto->{output_section}}], + output_lookup => {%{$proto->{output_lookup}}}, + } => ref($proto) ); + } + else { + $self = bless( { + %$proto, + typemap_section => [map $_->new, @{$proto->{typemap_section}}], + typemap_lookup => {%{$proto->{typemap_lookup}}}, + input_section => [map $_->new, @{$proto->{input_section}}], + input_lookup => {%{$proto->{input_lookup}}}, + output_section => [map $_->new, @{$proto->{output_section}}], + output_lookup => {%{$proto->{output_lookup}}}, + } => ref($proto) ); + } + + return $self; +} + +=head2 tidy_type + +Function to (heuristically) canonicalize a C type. Works to some +degree with C++ types. + + $halfway_canonical_type = tidy_type($ctype); + +Moved from C<ExtUtils::ParseXS>. + +=cut + +sub tidy_type { + local $_ = shift; + + # for templated C++ types, do some bit of flawed canonicalization + # wrt. templates at least + if (/[<>]/) { + s/\s*([<>])\s*/$1/g; + s/>>/> >/g; + } + + # rationalise any '*' by joining them into bunches and removing whitespace + s#\s*(\*+)\s*#$1#g; + s#(\*+)# $1 #g ; + + # trim leading & trailing whitespace + s/^\s+//; s/\s+$//; + + # change multiple whitespace into a single space + s/\s+/ /g; + + $_; +} + + + sub _parse { my $self = shift; my $stringref = shift; @@ -970,24 +1049,6 @@ sub _parse { } # taken from ExtUtils::ParseXS -sub _tidy_type { - local $_ = shift; - - # rationalise any '*' by joining them into bunches and removing whitespace - s#\s*(\*+)\s*#$1#g; - s#(\*+)# $1 #g ; - - # trim leading & trailing whitespace - s/^\s+//; s/\s+$//; - - # change multiple whitespace into a single space - s/\s+/ /g; - - $_; -} - - -# taken from ExtUtils::ParseXS sub _valid_proto_string { my $string = shift; if ($string =~ /^$ExtUtils::ParseXS::Constants::PrototypeRegexp+$/o) { @@ -1020,7 +1081,7 @@ Steffen Mueller C<<smueller@cpan.org>> =head1 COPYRIGHT & LICENSE -Copyright 2009, 2010, 2011, 2012 Steffen Mueller +Copyright 2009, 2010, 2011, 2012, 2013 Steffen Mueller This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/Cmd.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/Cmd.pm index 857ac1e8d93..a0be008148d 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/Cmd.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/Cmd.pm @@ -2,7 +2,7 @@ package ExtUtils::Typemaps::Cmd; use 5.006001; use strict; use warnings; -our $VERSION = '3.18'; +our $VERSION = '3.24'; use ExtUtils::Typemaps; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/InputMap.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/InputMap.pm index 487a4a542de..3a600354832 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/InputMap.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/InputMap.pm @@ -2,7 +2,7 @@ package ExtUtils::Typemaps::InputMap; use 5.006001; use strict; use warnings; -our $VERSION = '3.18'; +our $VERSION = '3.24'; =head1 NAME diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/OutputMap.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/OutputMap.pm index 08960618d51..8a019696c84 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/OutputMap.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/OutputMap.pm @@ -2,7 +2,7 @@ package ExtUtils::Typemaps::OutputMap; use 5.006001; use strict; use warnings; -our $VERSION = '3.18'; +our $VERSION = '3.24'; =head1 NAME @@ -95,16 +95,23 @@ sub cleaned_code { =head2 targetable -This is an obscure optimization that used to live in C<ExtUtils::ParseXS> -directly. +This is an obscure but effective optimization that used to +live in C<ExtUtils::ParseXS> directly. Not implementing it +should never result in incorrect use of typemaps, just less +efficient code. In a nutshell, this will check whether the output code -involves calling C<set_iv>, C<set_uv>, C<set_nv>, C<set_pv> or C<set_pvn> -to set the special C<$arg> placeholder to a new value +involves calling C<sv_setiv>, C<sv_setuv>, C<sv_setnv>, C<sv_setpv> or +C<sv_setpvn> to set the special C<$arg> placeholder to a new value B<AT THE END OF THE OUTPUT CODE>. If that is the case, the code is eligible for using the C<TARG>-related macros to optimize this. Thus the name of the method: C<targetable>. +If this optimization is applicable, C<ExtUtils::ParseXS> will +emit a C<dXSTARG;> definition at the start of the generate XSUB code, +and type (see below) dependent code to set C<TARG> and push it on +the stack at the end of the generated XSUB code. + If the optimization can not be applied, this returns undef. If it can be applied, this method returns a hash reference containing the following information: @@ -113,7 +120,7 @@ the following information: with_size: Bool indicating whether this is the sv_setpvn variant what: The code that actually evaluates to the output scalar what_size: If "with_size", this has the string length (as code, - not constant) + not constant, including leading comma) =cut @@ -129,6 +136,13 @@ sub targetable { \( (??{ $bal }) \) )* ]x; + my $bal_no_comma = qr[ + (?: + (?>[^(),]+) + | + \( (??{ $bal }) \) + )+ + ]x; # matches variations on (SV*) my $sv_cast = qr[ @@ -139,7 +153,7 @@ sub targetable { my $size = qr[ # Third arg (to setpvn) , \s* (??{ $bal }) - ]x; + ]xo; my $code = $self->code; @@ -155,10 +169,10 @@ sub targetable { \s* \( \s* $sv_cast \$arg \s* , \s* - ( (??{ $bal }) ) # Set from - ( (??{ $size }) )? # Possible sizeof set-from - \) \s* ; \s* $ - ]x + ( $bal_no_comma ) # Set from + ( $size )? # Possible sizeof set-from + \s* \) \s* ; \s* $ + ]xo ); my $rv = undef; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/Type.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/Type.pm index 1b9f8ba4dea..fa0ca695949 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/Type.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps/Type.pm @@ -4,7 +4,7 @@ use strict; use warnings; require ExtUtils::Typemaps; -our $VERSION = '3.18'; +our $VERSION = '3.24'; =head1 NAME @@ -53,7 +53,7 @@ sub new { $self->{xstype} = $args{xstype} if defined $args{xstype}; $self->{ctype} = $args{ctype} if defined $args{ctype}; - $self->{tidy_ctype} = ExtUtils::Typemaps::_tidy_type($self->{ctype}); + $self->{tidy_ctype} = ExtUtils::Typemaps::tidy_type($self->{ctype}); $self->{proto} = $args{'prototype'} if defined $args{'prototype'}; return $self; diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/testlib.pm b/Master/tlpkg/tlperl/lib/ExtUtils/testlib.pm index b5a51bf3fb1..d8cd4bcb42a 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.66'; +our $VERSION = '6.98'; use Cwd; use File::Spec; @@ -11,7 +11,7 @@ use File::Spec; # So the tests can chdir around and not break @INC. # We use getcwd() because otherwise rel2abs will blow up under taint # mode pre-5.8. We detaint is so @INC won't be tainted. This is -# no worse, and probably better, than just shoving an untainted, +# no worse, and probably better, than just shoving an untainted, # relative "blib/lib" onto @INC. my $cwd; BEGIN { diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/xsubpp b/Master/tlpkg/tlperl/lib/ExtUtils/xsubpp index fa0cd50426a..e2ac71a3234 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/xsubpp +++ b/Master/tlpkg/tlperl/lib/ExtUtils/xsubpp @@ -3,12 +3,6 @@ use 5.006; use strict; eval { require ExtUtils::ParseXS; - ExtUtils::ParseXS->import( - qw( - process_file - report_error_count - ) - ); 1; } or do { @@ -22,7 +16,7 @@ use Getopt::Long; my %args = (); -my $usage = "Usage: xsubpp [-v] [-csuffix csuffix] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-noinout] [-noargtypes] [-s pattern] [-typemap typemap]... file.xs\n"; +my $usage = "Usage: xsubpp [-v] [-csuffix csuffix] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-noinout] [-noargtypes] [-strip|s pattern] [-typemap typemap]... file.xs\n"; Getopt::Long::Configure qw(no_auto_abbrev no_ignore_case); @@ -39,7 +33,7 @@ GetOptions(\%args, qw(hiertype! v typemap=s@ output=s - s=s + s|strip=s csuffix=s )) or die $usage; @@ -53,8 +47,9 @@ if ($args{v}) { $args{filename} = shift @ARGV; -process_file(%args); -exit( report_error_count() ? 1 : 0 ); +my $pxs = ExtUtils::ParseXS->new; +$pxs->process_file(%args); +exit( $pxs->report_error_count() ? 1 : 0 ); __END__ @@ -150,6 +145,22 @@ Currently doesn't do anything at all. This flag has been a no-op for many versions of perl, at least as far back as perl5.003_07. It's allowed here for backwards compatibility. +=item B<-s=...> or B<-strip=...> + +I<This option is obscure and discouraged.> + +If specified, the given string will be stripped off from the beginning +of the C function name in the generated XS functions (if it starts with that prefix). +This only applies to XSUBs without C<CODE> or C<PPCODE> blocks. +For example, the XS: + + void foo_bar(int i); + +when C<xsubpp> is invoked with C<-s foo_> will install a C<foo_bar> +function in Perl, but really call C<bar(i)> in C. Most of the time, +this is the opposite of what you want and failure modes are somewhat +obscure, so please avoid this option where possible. + =back =head1 ENVIRONMENT |