Merge conflicts. More elegant improvements will follow in a couple
of days.
This commit is contained in:
Mark Murray
parent
315164071c
commit
c3180f4f12
@ -1,5 +1,5 @@
|
||||
# This -*- perl -*- script makes the Makefile
|
||||
# $Id: Makefile.PL,v 1.1.1.1 1998/09/09 06:59:51 markm Exp $
|
||||
# $Id: Makefile.PL,v 1.1.1.2 1999/05/02 14:20:37 markm Exp $
|
||||
|
||||
require 5.002;
|
||||
use ExtUtils::MakeMaker;
|
||||
@ -22,7 +22,7 @@ sub MY::libscan
|
||||
WriteMakefile(
|
||||
VERSION_FROM => "SysV.pm",
|
||||
NAME => "IPC::SysV",
|
||||
MAN3PODS => ' ',
|
||||
MAN3PODS => {}, # Pods will be built by installman.
|
||||
|
||||
'dist' => {COMPRESS => 'gzip -9f',
|
||||
SUFFIX => 'gz',
|
||||
|
||||
@ -1,8 +1,8 @@
|
||||
use ExtUtils::MakeMaker;
|
||||
WriteMakefile(
|
||||
NAME => 'POSIX',
|
||||
(($^O eq 'MSWin32' || $^O eq 'freebsd') ? () : (LIBS => ["-lm -lposix -lcposix"])),
|
||||
MAN3PODS => ' ', # Pods will be built by installman.
|
||||
($^O eq 'MSWin32' ? () : (LIBS => ["-lm -lposix -lcposix"])),
|
||||
MAN3PODS => {}, # Pods will be built by installman.
|
||||
XSPROTOARG => '-noprototypes', # XXX remove later?
|
||||
VERSION_FROM => 'POSIX.pm',
|
||||
);
|
||||
|
||||
@ -115,20 +115,21 @@ case "$osvers" in
|
||||
fi
|
||||
cccdlflags='-DPIC -fpic'
|
||||
;;
|
||||
3.0*) objformat=`objformat`
|
||||
if [ x$objformat = xelf ]; then
|
||||
libpth="/usr/lib /usr/local/lib"
|
||||
glibpth="/usr/lib /usr/local/lib"
|
||||
ldflags="-Wl,-E "
|
||||
lddlflags="-shared "
|
||||
else
|
||||
if [ -e /usr/lib/aout ]; then
|
||||
libpth="/usr/lib/aout /usr/local/lib /usr/lib"
|
||||
glibpth="/usr/lib/aout /usr/local/lib /usr/lib"
|
||||
fi
|
||||
lddlflags='-Bshareable'
|
||||
fi
|
||||
cccdlflags='-DPIC -fpic'
|
||||
3.*|4.0*)
|
||||
objformat=`/usr/bin/objformat`
|
||||
if [ x$objformat = xelf ]; then
|
||||
libpth="/usr/lib /usr/local/lib"
|
||||
glibpth="/usr/lib /usr/local/lib"
|
||||
ldflags="-Wl,-E "
|
||||
lddlflags="-shared "
|
||||
else
|
||||
if [ -e /usr/lib/aout ]; then
|
||||
libpth="/usr/lib/aout /usr/local/lib /usr/lib"
|
||||
glibpth="/usr/lib/aout /usr/local/lib /usr/lib"
|
||||
fi
|
||||
lddlflags='-Bshareable'
|
||||
fi
|
||||
cccdlflags='-DPIC -fpic'
|
||||
;;
|
||||
|
||||
*) cccdlflags='-DPIC -fpic'
|
||||
@ -146,38 +147,91 @@ problem. Try
|
||||
|
||||
EOM
|
||||
|
||||
# XXX EXPERIMENTAL A.D. 03/09/1998
|
||||
# XXX This script UU/usethreads.cbu will get 'called-back' by Configure
|
||||
# XXX after it has prompted the user for whether to use threads.
|
||||
cat > UU/usethreads.cbu <<'EOSH'
|
||||
case "$usethreads" in
|
||||
$define)
|
||||
case "$osvers" in
|
||||
3.0*) ldflags="-pthread $ldflags"
|
||||
;;
|
||||
2.2*) if [ ! -r /usr/lib/libc_r ]; then
|
||||
cat <<'EOM' >&4
|
||||
POSIX threads are not supported by default on FreeBSD $uname_r. Follow the
|
||||
instructions in 'man pthread' to build and install the needed libraries.
|
||||
EOM
|
||||
exit 1
|
||||
fi
|
||||
set `echo X "$libswanted "| sed -e 's/ c / c_r /'`
|
||||
shift
|
||||
libswanted="$*"
|
||||
# Configure will probably pick the wrong libc to use for nm
|
||||
# scan.
|
||||
# The safest quick-fix is just to not use nm at all.
|
||||
usenm=false
|
||||
;;
|
||||
*) cat <<'EOM' >&4
|
||||
It is not known if FreeBSD $uname_r supports POSIX threads or not. Consider
|
||||
upgrading to the latest STABLE release.
|
||||
EOM
|
||||
exit 1
|
||||
;;
|
||||
esac
|
||||
# From: Anton Berezin <tobez@plab.ku.dk>
|
||||
# To: perl5-porters@perl.org
|
||||
# Subject: [PATCH 5.005_54] Configure - hints/freebsd.sh signal handler type
|
||||
# Date: 30 Nov 1998 19:46:24 +0100
|
||||
# Message-ID: <864srhhvcv.fsf@lion.plab.ku.dk>
|
||||
|
||||
signal_t='void'
|
||||
d_voidsig='define'
|
||||
|
||||
# set libperl.so.X.X for 2.2.X
|
||||
case "$osvers" in
|
||||
2.2*)
|
||||
# unfortunately this code gets executed before
|
||||
# the equivalent in the main Configure so we copy a little
|
||||
# from Configure XXX Configure should be fixed.
|
||||
if $test -r $src/patchlevel.h;then
|
||||
patchlevel=`awk '/define[ ]+PATCHLEVEL/ {print $3}' $src/patchlevel.h`
|
||||
subversion=`awk '/define[ ]+SUBVERSION/ {print $3}' $src/patchlevel.h`
|
||||
else
|
||||
patchlevel=0
|
||||
subversion=0
|
||||
fi
|
||||
libperl="libperl.so.$patchlevel.$subversion"
|
||||
unset patchlevel
|
||||
unset subversion
|
||||
;;
|
||||
esac
|
||||
EOSH
|
||||
# XXX EXPERIMENTAL --end of call-back
|
||||
|
||||
# This script UU/usethreads.cbu will get 'called-back' by Configure
|
||||
# after it has prompted the user for whether to use threads.
|
||||
cat > UU/usethreads.cbu <<'EOCBU'
|
||||
case "$usethreads" in
|
||||
$define|true|[yY]*)
|
||||
lc_r=`/sbin/ldconfig -r|grep ':-lc_r'|awk '{print $NF}'`
|
||||
case "$osvers" in
|
||||
2.2.8*|3.*|4.*)
|
||||
if [ ! -r "$lc_r" ]; then
|
||||
cat <<EOM >&4
|
||||
POSIX threads should be supported by FreeBSD $osvers --
|
||||
but your system is missing the shared libc_r.
|
||||
(/sbin/ldconfig -r doesn't find any).
|
||||
|
||||
Consider using the latest STABLE release.
|
||||
EOM
|
||||
exit 1
|
||||
fi
|
||||
ldflags="-pthread $ldflags"
|
||||
;;
|
||||
2.2*)
|
||||
cat <<EOM >&4
|
||||
POSIX threads are not supported well by FreeBSD $osvers.
|
||||
|
||||
Please consider upgrading to at least FreeBSD 2.2.8,
|
||||
or preferably to 3.something.
|
||||
|
||||
(While 2.2.7 does have pthreads, it has some problems
|
||||
with the combination of threads and pipes and therefore
|
||||
many Perl tests will either hang or fail.)
|
||||
EOM
|
||||
exit 1
|
||||
;;
|
||||
*) cat <<EOM >&4
|
||||
I did not know that FreeBSD $osvers supports POSIX threads.
|
||||
|
||||
Feel free to tell perlbug@perl.com otherwise.
|
||||
EOM
|
||||
exit 1
|
||||
;;
|
||||
esac
|
||||
|
||||
set `echo X "$libswanted "| sed -e 's/ c / c_r /'`
|
||||
shift
|
||||
libswanted="$*"
|
||||
# Configure will probably pick the wrong libc to use for nm scan.
|
||||
# The safest quick-fix is just to not use nm at all...
|
||||
usenm=false
|
||||
|
||||
case "$osvers" in
|
||||
2.2.8*)
|
||||
# ... but this does not apply for 2.2.8 - we know it's safe
|
||||
libc="$lc_r"
|
||||
usenm=true
|
||||
;;
|
||||
esac
|
||||
|
||||
unset lc_r
|
||||
esac
|
||||
EOCBU
|
||||
|
||||
@ -32,7 +32,7 @@ The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
|
||||
in Perl.
|
||||
|
||||
The abs_path() function takes a single argument and returns the
|
||||
absolute pathname for that argument. It uses the same algoritm as
|
||||
absolute pathname for that argument. It uses the same algorithm as
|
||||
getcwd(). (actually getcwd() is abs_path("."))
|
||||
|
||||
The fastcwd() function looks the same as getcwd(), but runs faster.
|
||||
@ -269,7 +269,7 @@ sub fast_abs_path {
|
||||
# --- PORTING SECTION ---
|
||||
|
||||
# VMS: $ENV{'DEFAULT'} points to default directory at all times
|
||||
# 06-Mar-1996 Charles Bailey bailey@genetics.upenn.edu
|
||||
# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
|
||||
# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
|
||||
# in the process logical name table as the default device and directory
|
||||
# seen by Perl. This may not be the same as the default device
|
||||
|
||||
@ -2,7 +2,7 @@ package ExtUtils::Liblist;
|
||||
use vars qw($VERSION);
|
||||
# Broken out of MakeMaker from version 4.11
|
||||
|
||||
$VERSION = substr q$Revision: 1.1.1.1 $, 10;
|
||||
$VERSION = substr q$Revision: 1.1.1.2 $, 10;
|
||||
|
||||
use Config;
|
||||
use Cwd 'cwd';
|
||||
@ -225,6 +225,9 @@ sub _win32_ext {
|
||||
my $search = 1;
|
||||
my($fullname, $thislib, $thispth);
|
||||
|
||||
# add "$Config{installarchlib}/CORE" to default search path
|
||||
push @libpath, "$Config{installarchlib}/CORE";
|
||||
|
||||
foreach (Text::ParseWords::quotewords('\s+', 0, $potential_libs)){
|
||||
|
||||
$thislib = $_;
|
||||
@ -240,8 +243,8 @@ sub _win32_ext {
|
||||
|
||||
# if searching is disabled, do compiler-specific translations
|
||||
unless ($search) {
|
||||
s/^-L/-libpath:/ if $VC;
|
||||
s/^-l(.+)$/$1.lib/ unless $GC;
|
||||
s/^-L/-libpath:/ if $VC;
|
||||
push(@extralibs, $_);
|
||||
$found++;
|
||||
next;
|
||||
@ -575,7 +578,7 @@ Unix-OS/2 version in several respects:
|
||||
=item *
|
||||
|
||||
Input library and path specifications are accepted with or without the
|
||||
C<-l> and C<-L> prefices used by Unix linkers. If neither prefix is
|
||||
C<-l> and C<-L> prefixes used by Unix linkers. If neither prefix is
|
||||
present, a token is considered a directory to search if it is in fact
|
||||
a directory, and a library to search for otherwise. Authors who wish
|
||||
their extensions to be portable to Unix or OS/2 should use the Unix
|
||||
@ -586,7 +589,7 @@ prefixes, since the Unix-OS/2 version of ext() requires them.
|
||||
Wherever possible, shareable images are preferred to object libraries,
|
||||
and object libraries to plain object files. In accordance with VMS
|
||||
naming conventions, ext() looks for files named I<lib>shr and I<lib>rtl;
|
||||
it also looks for I<lib>lib and libI<lib> to accomodate Unix conventions
|
||||
it also looks for I<lib>lib and libI<lib> to accommodate Unix conventions
|
||||
used in some ported software.
|
||||
|
||||
=item *
|
||||
@ -625,14 +628,15 @@ Unix-OS/2 version in several respects:
|
||||
If C<$potential_libs> is empty, the return value will be empty.
|
||||
Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm)
|
||||
will be appended to the list of C<$potential_libs>. The libraries
|
||||
will be searched for in the directories specified in C<$potential_libs>
|
||||
as well as in C<$Config{libpth}>. For each library that is found, a
|
||||
space-separated list of fully qualified library pathnames is generated.
|
||||
will be searched for in the directories specified in C<$potential_libs>,
|
||||
C<$Config{libpth}>, and in C<$Config{installarchlib}/CORE>.
|
||||
For each library that is found, a space-separated list of fully qualified
|
||||
library pathnames is generated.
|
||||
|
||||
=item *
|
||||
|
||||
Input library and path specifications are accepted with or without the
|
||||
C<-l> and C<-L> prefices used by Unix linkers.
|
||||
C<-l> and C<-L> prefixes used by Unix linkers.
|
||||
|
||||
An entry of the form C<-La:\foo> specifies the C<a:\foo> directory to look
|
||||
for the libraries that follow.
|
||||
|
||||
@ -8,8 +8,8 @@ use strict;
|
||||
use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Is_Dos $Is_PERL_OBJECT
|
||||
$Verbose %pm %static $Xsubpp_Version);
|
||||
|
||||
$VERSION = substr q$Revision: 1.2 $, 10;
|
||||
# $Id: MM_Unix.pm,v 1.2 1998/09/09 13:10:46 markm Exp $
|
||||
$VERSION = substr q$Revision: 1.1.1.2 $, 10;
|
||||
# $Id: MM_Unix.pm,v 1.1.1.2 1999/05/02 14:25:31 markm Exp $
|
||||
|
||||
Exporter::import('ExtUtils::MakeMaker',
|
||||
qw( $Verbose &neatvalue));
|
||||
@ -19,7 +19,7 @@ $Is_Mac = $^O eq 'MacOS';
|
||||
$Is_Win32 = $^O eq 'MSWin32';
|
||||
$Is_Dos = $^O eq 'dos';
|
||||
|
||||
$Is_PERL_OBJECT = 1 if $Config{'ccflags'} =~ /-DPERL_OBJECT/;
|
||||
$Is_PERL_OBJECT = $Config{'ccflags'} =~ /-DPERL_OBJECT/;
|
||||
|
||||
if ($Is_VMS = $^O eq 'VMS') {
|
||||
require VMS::Filespec;
|
||||
@ -84,10 +84,10 @@ sub canonpath {
|
||||
if ( $^O eq 'qnx' && $path =~ s|^(//\d+)/|/| ) {
|
||||
$node = $1;
|
||||
}
|
||||
$path =~ s|/+|/|g ; # xx////xx -> xx/xx
|
||||
$path =~ s|(?<=[^/])/+|/|g ; # xx////xx -> xx/xx
|
||||
$path =~ s|(/\.)+/|/|g ; # xx/././xx -> xx/xx
|
||||
$path =~ s|^(\./)+|| unless $path eq "./"; # ./xx -> xx
|
||||
$path =~ s|/$|| unless $path eq "/"; # xx/ -> xx
|
||||
$path =~ s|(?<=[^/])/$|| ; # xx/ -> xx
|
||||
"$node$path";
|
||||
}
|
||||
|
||||
@ -233,6 +233,7 @@ sub ExtUtils::MM_Unix::tools_other ;
|
||||
sub ExtUtils::MM_Unix::top_targets ;
|
||||
sub ExtUtils::MM_Unix::writedoc ;
|
||||
sub ExtUtils::MM_Unix::xs_c ;
|
||||
sub ExtUtils::MM_Unix::xs_cpp ;
|
||||
sub ExtUtils::MM_Unix::xs_o ;
|
||||
sub ExtUtils::MM_Unix::xsubpp_version ;
|
||||
|
||||
@ -374,9 +375,9 @@ sub cflags {
|
||||
$self->{uc $_} ||= $cflags{$_}
|
||||
}
|
||||
|
||||
if ($self->{CAPI} && $Is_PERL_OBJECT == 1) {
|
||||
if ($self->{CAPI} && $Is_PERL_OBJECT) {
|
||||
$self->{CCFLAGS} =~ s/-DPERL_OBJECT(\s|$)//;
|
||||
$self->{CCFLAGS} .= '-DPERL_CAPI';
|
||||
$self->{CCFLAGS} .= ' -DPERL_CAPI ';
|
||||
if ($Is_Win32 && $Config{'cc'} =~ /^cl.exe/i) {
|
||||
# Turn off C++ mode of the MSC compiler
|
||||
$self->{CCFLAGS} =~ s/-TP(\s|$)//;
|
||||
@ -818,7 +819,7 @@ ci :
|
||||
|
||||
=item dist_core (o)
|
||||
|
||||
Defeines the targets dist, tardist, zipdist, uutardist, shdist
|
||||
Defines the targets dist, tardist, zipdist, uutardist, shdist
|
||||
|
||||
=cut
|
||||
|
||||
@ -915,6 +916,7 @@ sub dlsyms {
|
||||
|
||||
my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
|
||||
my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || [];
|
||||
my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
|
||||
my(@m);
|
||||
|
||||
push(@m,"
|
||||
@ -931,7 +933,8 @@ static :: $self->{BASEEXT}.exp
|
||||
$self->{BASEEXT}.exp: Makefile.PL
|
||||
",' $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\
|
||||
Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ',
|
||||
neatvalue($funcs),', "DL_VARS" => ', neatvalue($vars), ');\'
|
||||
neatvalue($funcs), ', "FUNCLIST" => ', neatvalue($funclist),
|
||||
', "DL_VARS" => ', neatvalue($vars), ');\'
|
||||
');
|
||||
|
||||
join('',@m);
|
||||
@ -2019,7 +2022,7 @@ uninstall_from_sitedirs ::
|
||||
|
||||
=item installbin (o)
|
||||
|
||||
Defines targets to install EXE_FILES.
|
||||
Defines targets to make and to install EXE_FILES.
|
||||
|
||||
=cut
|
||||
|
||||
@ -2046,7 +2049,7 @@ EXE_FILES = @{$self->{EXE_FILES}}
|
||||
} : q{FIXIN = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::MakeMaker \
|
||||
-e "MY->fixin(shift)"
|
||||
}).qq{
|
||||
all :: @to
|
||||
pure_all :: @to
|
||||
$self->{NOECHO}\$(NOOP)
|
||||
|
||||
realclean ::
|
||||
@ -2348,7 +2351,7 @@ $tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c
|
||||
$tmp/perlmain.c: $makefilename}, q{
|
||||
}.$self->{NOECHO}.q{echo Writing $@
|
||||
}.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) -MExtUtils::Miniperl \\
|
||||
-e "writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)" > $@t && $(MV) $@t $@
|
||||
-e "writemain(grep s#.*/auto/##, split(q| |, q|$(MAP_STATIC)|))" > $@t && $(MV) $@t $@
|
||||
|
||||
};
|
||||
push @m, "\t",$self->{NOECHO}.q{$(PERL) $(INSTALLSCRIPT)/fixpmain
|
||||
@ -2747,10 +2750,13 @@ sub ppd {
|
||||
push(@m, "\t\@\$(PERL) -e \"print qq{<SOFTPKG NAME=\\\"$self->{DISTNAME}\\\" VERSION=\\\"$pack_ver\\\">\\n}");
|
||||
push(@m, ". qq{\\t<TITLE>$self->{DISTNAME}</TITLE>\\n}");
|
||||
my $abstract = $self->{ABSTRACT};
|
||||
$abstract =~ s/\n/\\n/sg;
|
||||
$abstract =~ s/</</g;
|
||||
$abstract =~ s/>/>/g;
|
||||
push(@m, ". qq{\\t<ABSTRACT>$abstract</ABSTRACT>\\n}");
|
||||
my ($author) = $self->{AUTHOR};
|
||||
$author =~ s/</</g;
|
||||
$author =~ s/>/>/g;
|
||||
$author =~ s/@/\\@/g;
|
||||
push(@m, ". qq{\\t<AUTHOR>$author</AUTHOR>\\n}");
|
||||
push(@m, ". qq{\\t<IMPLEMENTATION>\\n}");
|
||||
@ -2758,9 +2764,11 @@ sub ppd {
|
||||
foreach $prereq (sort keys %{$self->{PREREQ_PM}}) {
|
||||
my $pre_req = $prereq;
|
||||
$pre_req =~ s/::/-/g;
|
||||
push(@m, ". qq{\\t\\t<DEPENDENCY NAME=\\\"$pre_req\\\" />\\n}");
|
||||
my ($dep_ver) = join ",", (split (/\./, $self->{PREREQ_PM}{$prereq}), (0) x 4) [0 .. 3];
|
||||
push(@m, ". qq{\\t\\t<DEPENDENCY NAME=\\\"$pre_req\\\" VERSION=\\\"$dep_ver\\\" />\\n}");
|
||||
}
|
||||
push(@m, ". qq{\\t\\t<OS NAME=\\\"\$(OSNAME)\\\" />\\n}");
|
||||
push(@m, ". qq{\\t\\t<ARCHITECTURE NAME=\\\"$Config{'archname'}\\\" />\\n}");
|
||||
my ($bin_location) = $self->{BINARY_LOCATION};
|
||||
$bin_location =~ s/\\/\\\\/g;
|
||||
if ($self->{PPM_INSTALL_SCRIPT}) {
|
||||
@ -2784,7 +2792,7 @@ Returns the attribute C<PERM_RW> or the string C<644>.
|
||||
Used as the string that is passed
|
||||
to the C<chmod> command to set the permissions for read/writeable files.
|
||||
MakeMaker chooses C<644> because it has turned out in the past that
|
||||
relying on the umask provokes hard-to-track bugreports.
|
||||
relying on the umask provokes hard-to-track bug reports.
|
||||
When the return value is used by the perl function C<chmod>, it is
|
||||
interpreted as an octal value.
|
||||
|
||||
@ -2890,13 +2898,18 @@ sub processPL {
|
||||
return "" unless $self->{PL_FILES};
|
||||
my(@m, $plfile);
|
||||
foreach $plfile (sort keys %{$self->{PL_FILES}}) {
|
||||
my $list = ref($self->{PL_FILES}->{$plfile})
|
||||
? $self->{PL_FILES}->{$plfile}
|
||||
: [$self->{PL_FILES}->{$plfile}];
|
||||
foreach $target (@$list) {
|
||||
push @m, "
|
||||
all :: $self->{PL_FILES}->{$plfile}
|
||||
all :: $target
|
||||
$self->{NOECHO}\$(NOOP)
|
||||
|
||||
$self->{PL_FILES}->{$plfile} :: $plfile
|
||||
\$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile
|
||||
$target :: $plfile
|
||||
\$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile $target
|
||||
";
|
||||
}
|
||||
}
|
||||
join "", @m;
|
||||
}
|
||||
@ -2944,7 +2957,11 @@ form Foo/Bar and replaces the slash with C<::>. Returns the replacement.
|
||||
|
||||
sub replace_manpage_separator {
|
||||
my($self,$man) = @_;
|
||||
$man =~ s,/+,::,g;
|
||||
if ($^O eq 'uwin') {
|
||||
$man =~ s,/+,.,g;
|
||||
} else {
|
||||
$man =~ s,/+,::,g;
|
||||
}
|
||||
$man;
|
||||
}
|
||||
|
||||
@ -3305,7 +3322,7 @@ sub tool_xsubpp {
|
||||
}
|
||||
}
|
||||
|
||||
$xsubpp = $self->{CAPI} ? "xsubpp -object_capi" : "xsubpp";
|
||||
my $xsubpp = $self->{CAPI} ? "xsubpp -object_capi" : "xsubpp";
|
||||
|
||||
return qq{
|
||||
XSUBPPDIR = $xsdir
|
||||
@ -3455,7 +3472,7 @@ Version_check:
|
||||
|
||||
=item writedoc
|
||||
|
||||
Obsolete, depecated method. Not used since Version 5.21.
|
||||
Obsolete, deprecated method. Not used since Version 5.21.
|
||||
|
||||
=cut
|
||||
|
||||
@ -3479,7 +3496,22 @@ sub xs_c {
|
||||
return '' unless $self->needs_linking();
|
||||
'
|
||||
.xs.c:
|
||||
$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >$*.tc && $(MV) $*.tc $@
|
||||
$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.c
|
||||
';
|
||||
}
|
||||
|
||||
=item xs_cpp (o)
|
||||
|
||||
Defines the suffix rules to compile XS files to C++.
|
||||
|
||||
=cut
|
||||
|
||||
sub xs_cpp {
|
||||
my($self) = shift;
|
||||
return '' unless $self->needs_linking();
|
||||
'
|
||||
.xs.cpp:
|
||||
$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.cpp
|
||||
';
|
||||
}
|
||||
|
||||
@ -3510,6 +3542,7 @@ and Win32 do.
|
||||
|
||||
sub perl_archive
|
||||
{
|
||||
return '$(PERL_INC)' . "/$Config{libperl}" if $^O eq "beos";
|
||||
return "";
|
||||
}
|
||||
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
/* perl.c
|
||||
*
|
||||
* Copyright (c) 1987-1998 Larry Wall
|
||||
* Copyright (c) 1987-1999 Larry Wall
|
||||
*
|
||||
* You may distribute under the terms of either the GNU General Public
|
||||
* License or the Artistic License, as specified in the README file.
|
||||
@ -64,6 +64,9 @@ static void my_exit_jump _((void)) __attribute__((noreturn));
|
||||
static void nuke_stacks _((void));
|
||||
static void open_script _((char *, bool, SV *, int *fd));
|
||||
static void usage _((char *));
|
||||
#ifdef IAMSUID
|
||||
static int fd_on_nosuid_fs _((int));
|
||||
#endif
|
||||
static void validate_suid _((char *, char*, int));
|
||||
static I32 read_e_script _((int idx, SV *buf_sv, int maxlen));
|
||||
#endif
|
||||
@ -126,6 +129,7 @@ perl_construct(register PerlInterpreter *sv_interp)
|
||||
croak("panic: pthread_key_create");
|
||||
#endif
|
||||
MUTEX_INIT(&PL_sv_mutex);
|
||||
MUTEX_INIT(&PL_cred_mutex);
|
||||
/*
|
||||
* Safe to use basic SV functions from now on (though
|
||||
* not things like mortals or tainting yet).
|
||||
@ -551,9 +555,14 @@ perl_destruct(register PerlInterpreter *sv_interp)
|
||||
|
||||
DEBUG_P(debprofdump());
|
||||
#ifdef USE_THREADS
|
||||
MUTEX_DESTROY(&PL_strtab_mutex);
|
||||
MUTEX_DESTROY(&PL_sv_mutex);
|
||||
MUTEX_DESTROY(&PL_cred_mutex);
|
||||
MUTEX_DESTROY(&PL_eval_mutex);
|
||||
COND_DESTROY(&PL_eval_cond);
|
||||
#ifdef EMULATE_ATOMIC_REFCOUNTS
|
||||
MUTEX_DESTROY(&PL_svref_mutex);
|
||||
#endif /* EMULATE_ATOMIC_REFCOUNTS */
|
||||
|
||||
/* As the penultimate thing, free the non-arena SV for thrsv */
|
||||
Safefree(SvPVX(PL_thrsv));
|
||||
@ -719,6 +728,9 @@ setuid perl scripts securely.\n");
|
||||
s = argv[0]+1;
|
||||
reswitch:
|
||||
switch (*s) {
|
||||
#ifndef PERL_STRICT_CR
|
||||
case '\r':
|
||||
#endif
|
||||
case ' ':
|
||||
case '0':
|
||||
case 'F':
|
||||
@ -1138,6 +1150,7 @@ CV*
|
||||
perl_get_cv(char *name, I32 create)
|
||||
{
|
||||
GV* gv = gv_fetchpv(name, create, SVt_PVCV);
|
||||
/* XXX unsafe for threads if eval_owner isn't held */
|
||||
if (create && !GvCVu(gv))
|
||||
return newSUB(start_subparse(FALSE, 0),
|
||||
newSVOP(OP_CONST, 0, newSVpv(name,0)),
|
||||
@ -1440,8 +1453,10 @@ perl_eval_pv(char *p, I32 croak_on_error)
|
||||
sv = POPs;
|
||||
PUTBACK;
|
||||
|
||||
if (croak_on_error && SvTRUE(ERRSV))
|
||||
croak(SvPVx(ERRSV, PL_na));
|
||||
if (croak_on_error && SvTRUE(ERRSV)) {
|
||||
STRLEN n_a;
|
||||
croak(SvPVx(ERRSV, n_a));
|
||||
}
|
||||
|
||||
return sv;
|
||||
}
|
||||
@ -1713,7 +1728,7 @@ moreswitches(char *s)
|
||||
LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
|
||||
#endif
|
||||
|
||||
printf("\n\nCopyright 1987-1998, Larry Wall\n");
|
||||
printf("\n\nCopyright 1987-1999, Larry Wall\n");
|
||||
#ifdef MSDOS
|
||||
printf("\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
|
||||
#endif
|
||||
@ -1737,6 +1752,12 @@ moreswitches(char *s)
|
||||
#ifdef OEMVS
|
||||
printf("MVS (OS390) port by Mortice Kern Systems, 1997-1998\n");
|
||||
#endif
|
||||
#ifdef __VOS__
|
||||
printf("Stratus VOS port by Paul_Green@stratus.com, 1997-1999\n");
|
||||
#endif
|
||||
#ifdef __MINT__
|
||||
printf("MiNT port by Guido Flohr, 1997\n");
|
||||
#endif
|
||||
#ifdef BINARY_BUILD_NOTICE
|
||||
BINARY_BUILD_NOTICE;
|
||||
#endif
|
||||
@ -1758,7 +1779,7 @@ Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n");
|
||||
break;
|
||||
case '-':
|
||||
case 0:
|
||||
#ifdef WIN32
|
||||
#if defined(WIN32) || !defined(PERL_STRICT_CR)
|
||||
case '\r':
|
||||
#endif
|
||||
case '\n':
|
||||
@ -1886,6 +1907,9 @@ init_main_stash(void)
|
||||
about not iterating on it, and not adding tie magic to it.
|
||||
It is properly deallocated in perl_destruct() */
|
||||
PL_strtab = newHV();
|
||||
#ifdef USE_THREADS
|
||||
MUTEX_INIT(&PL_strtab_mutex);
|
||||
#endif
|
||||
HvSHAREKEYS_off(PL_strtab); /* mandatory */
|
||||
hv_ksplit(PL_strtab, 512);
|
||||
|
||||
@ -1913,7 +1937,7 @@ init_main_stash(void)
|
||||
PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
|
||||
PL_globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
|
||||
/* We must init $/ before switches are processed. */
|
||||
sv_setpvn(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), "\n", 1);
|
||||
sv_setpvn(perl_get_sv("/", TRUE), "\n", 1);
|
||||
}
|
||||
|
||||
STATIC void
|
||||
@ -2056,6 +2080,71 @@ sed %s -e \"/^[^#]/b\" \
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef IAMSUID
|
||||
static int
|
||||
fd_on_nosuid_fs(int fd)
|
||||
{
|
||||
int on_nosuid = 0;
|
||||
int check_okay = 0;
|
||||
/*
|
||||
* Preferred order: fstatvfs(), fstatfs(), getmntent().
|
||||
* fstatvfs() is UNIX98.
|
||||
* fstatfs() is BSD.
|
||||
* getmntent() is O(number-of-mounted-filesystems) and can hang.
|
||||
*/
|
||||
|
||||
# ifdef HAS_FSTATVFS
|
||||
struct statvfs stfs;
|
||||
check_okay = fstatvfs(fd, &stfs) == 0;
|
||||
on_nosuid = check_okay && (stfs.f_flag & ST_NOSUID);
|
||||
# else
|
||||
# if defined(HAS_FSTATFS) && defined(HAS_STRUCT_STATFS_FLAGS)
|
||||
struct statfs stfs;
|
||||
check_okay = fstatfs(fd, &stfs) == 0;
|
||||
# undef PERL_MOUNT_NOSUID
|
||||
# if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID)
|
||||
# define PERL_MOUNT_NOSUID MNT_NOSUID
|
||||
# endif
|
||||
# if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID)
|
||||
# define PERL_MOUNT_NOSUID MS_NOSUID
|
||||
# endif
|
||||
# if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID)
|
||||
# define PERL_MOUNT_NOSUID M_NOSUID
|
||||
# endif
|
||||
# ifdef PERL_MOUNT_NOSUID
|
||||
on_nosuid = check_okay && (stfs.f_flags & PERL_MOUNT_NOSUID);
|
||||
# endif
|
||||
# else
|
||||
# if defined(HAS_GETMNTENT) && defined(HAS_HASMNTOPT) && defined(MNTOPT_NOSUID)
|
||||
FILE *mtab = fopen("/etc/mtab", "r");
|
||||
struct mntent *entry;
|
||||
struct stat stb, fsb;
|
||||
|
||||
if (mtab && (fstat(fd, &stb) == 0)) {
|
||||
while (entry = getmntent(mtab)) {
|
||||
if (stat(entry->mnt_dir, &fsb) == 0
|
||||
&& fsb.st_dev == stb.st_dev)
|
||||
{
|
||||
/* found the filesystem */
|
||||
check_okay = 1;
|
||||
if (hasmntopt(entry, MNTOPT_NOSUID))
|
||||
on_nosuid = 1;
|
||||
break;
|
||||
} /* A single fs may well fail its stat(). */
|
||||
}
|
||||
}
|
||||
if (mtab)
|
||||
fclose(mtab);
|
||||
# endif /* mntent */
|
||||
# endif /* statfs */
|
||||
# endif /* statvfs */
|
||||
if (!check_okay)
|
||||
croak("Can't check filesystem of script \"%s\" for nosuid",
|
||||
PL_origfilename);
|
||||
return on_nosuid;
|
||||
}
|
||||
#endif /* IAMSUID */
|
||||
|
||||
STATIC void
|
||||
validate_suid(char *validarg, char *scriptname, int fdscript)
|
||||
{
|
||||
@ -2089,6 +2178,7 @@ validate_suid(char *validarg, char *scriptname, int fdscript)
|
||||
croak("Can't stat script \"%s\"",PL_origfilename);
|
||||
if (fdscript < 0 && PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
|
||||
I32 len;
|
||||
STRLEN n_a;
|
||||
|
||||
#ifdef IAMSUID
|
||||
#ifndef HAS_SETREUID
|
||||
@ -2123,20 +2213,10 @@ validate_suid(char *validarg, char *scriptname, int fdscript)
|
||||
croak("Can't swap uid and euid"); /* really paranoid */
|
||||
if (PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&tmpstatbuf) < 0)
|
||||
croak("Permission denied"); /* testing full pathname here */
|
||||
#if (defined(BSD) && (BSD >= 199306))
|
||||
#ifdef IAMSUID
|
||||
{
|
||||
struct statfs stfs;
|
||||
|
||||
if (fstatfs(fileno(PL_rsfp),&stfs) < 0)
|
||||
croak("Can't statfs filesystem of script \"%s\"",PL_origfilename);
|
||||
|
||||
if (stfs.f_flags & MNT_NOSUID)
|
||||
#if defined(IAMSUID) && !defined(NO_NOSUID_CHECK)
|
||||
if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp)))
|
||||
croak("Permission denied");
|
||||
}
|
||||
#endif /* IAMSUID */
|
||||
#endif /* BSD */
|
||||
|
||||
#endif
|
||||
if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
|
||||
tmpstatbuf.st_ino != PL_statbuf.st_ino) {
|
||||
(void)PerlIO_close(PL_rsfp);
|
||||
@ -2175,12 +2255,12 @@ validate_suid(char *validarg, char *scriptname, int fdscript)
|
||||
PL_doswitches = FALSE; /* -s is insecure in suid */
|
||||
PL_curcop->cop_line++;
|
||||
if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
|
||||
strnNE(SvPV(PL_linestr,PL_na),"#!",2) ) /* required even on Sys V */
|
||||
strnNE(SvPV(PL_linestr,n_a),"#!",2) ) /* required even on Sys V */
|
||||
croak("No #! line");
|
||||
s = SvPV(PL_linestr,PL_na)+2;
|
||||
s = SvPV(PL_linestr,n_a)+2;
|
||||
if (*s == ' ') s++;
|
||||
while (!isSPACE(*s)) s++;
|
||||
for (s2 = s; (s2 > SvPV(PL_linestr,PL_na)+2 &&
|
||||
for (s2 = s; (s2 > SvPV(PL_linestr,n_a)+2 &&
|
||||
(isDIGIT(s2[-1]) || strchr("._-", s2[-1]))); s2--) ;
|
||||
if (strnNE(s2-4,"perl",4) && strnNE(s-9,"perl",4)) /* sanity check */
|
||||
croak("Not a perl script");
|
||||
@ -2719,7 +2799,7 @@ incpush(char *p, int addsubdirs)
|
||||
char *unix;
|
||||
STRLEN len;
|
||||
|
||||
if ((unix = tounixspec_ts(SvPV(libdir,PL_na),Nullch)) != Nullch) {
|
||||
if ((unix = tounixspec_ts(SvPV(libdir,len),Nullch)) != Nullch) {
|
||||
len = strlen(unix);
|
||||
while (unix[len-1] == '/') len--; /* Cosmetic */
|
||||
sv_usepvn(libdir,unix,len);
|
||||
@ -2727,7 +2807,7 @@ incpush(char *p, int addsubdirs)
|
||||
else
|
||||
PerlIO_printf(PerlIO_stderr(),
|
||||
"Failed to unixify @INC element \"%s\"\n",
|
||||
SvPV(libdir,PL_na));
|
||||
SvPV(libdir,len));
|
||||
#endif
|
||||
/* .../archname/version if -d .../archname/version/auto */
|
||||
sv_setsv(subdir, libdir);
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
/* perl.h
|
||||
*
|
||||
* Copyright (c) 1987-1997, Larry Wall
|
||||
* Copyright (c) 1987-1999, Larry Wall
|
||||
*
|
||||
* You may distribute under the terms of either the GNU General Public
|
||||
* License or the Artistic License, as specified in the README file.
|
||||
@ -209,6 +209,12 @@ register struct op *op asm(stringify(OP_IN_REGISTER));
|
||||
# define LIBERAL 1
|
||||
#endif
|
||||
|
||||
#if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90
|
||||
#define ASCIIish
|
||||
#else
|
||||
#undef ASCIIish
|
||||
#endif
|
||||
|
||||
/*
|
||||
* The following contortions are brought to you on behalf of all the
|
||||
* standards, semi-standards, de facto standards, not-so-de-facto standards
|
||||
@ -244,7 +250,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER));
|
||||
#define TAINT_NOT (PL_tainted = FALSE)
|
||||
#define TAINT_IF(c) if (c) { PL_tainted = TRUE; }
|
||||
#define TAINT_ENV() if (PL_tainting) { taint_env(); }
|
||||
#define TAINT_PROPER(s) if (PL_tainting) { taint_proper(no_security, s); }
|
||||
#define TAINT_PROPER(s) if (PL_tainting) { taint_proper(Nullch, s); }
|
||||
|
||||
/* XXX All process group stuff is handled in pp_sys.c. Should these
|
||||
defines move there? If so, I could simplify this a lot. --AD 9/96.
|
||||
@ -594,7 +600,7 @@ Free_t Perl_free _((Malloc_t where));
|
||||
set_vaxc_errno(vmserrcode); \
|
||||
} STMT_END
|
||||
#else
|
||||
# define SETERRNO(errcode,vmserrcode) errno = (errcode)
|
||||
# define SETERRNO(errcode,vmserrcode) (errno = (errcode))
|
||||
#endif
|
||||
|
||||
#ifdef USE_THREADS
|
||||
@ -1118,7 +1124,11 @@ typedef I32 (*filter_t) _((int, SV *, int));
|
||||
# if defined(MPE)
|
||||
# include "mpeix/mpeixish.h"
|
||||
# else
|
||||
# include "unixish.h"
|
||||
# if defined(__VOS__)
|
||||
# include "vosish.h"
|
||||
# else
|
||||
# include "unixish.h"
|
||||
# endif
|
||||
# endif
|
||||
# endif
|
||||
# endif
|
||||
@ -1149,11 +1159,22 @@ typedef I32 (*filter_t) _((int, SV *, int));
|
||||
# ifdef OS2
|
||||
# include "os2thread.h"
|
||||
# else
|
||||
# include <pthread.h>
|
||||
typedef pthread_t perl_os_thread;
|
||||
typedef pthread_mutex_t perl_mutex;
|
||||
typedef pthread_cond_t perl_cond;
|
||||
typedef pthread_key_t perl_key;
|
||||
# ifdef I_MACH_CTHREADS
|
||||
# include <mach/cthreads.h>
|
||||
# ifdef NeXT
|
||||
# define MUTEX_INIT_CALLS_MALLOC
|
||||
# endif
|
||||
typedef cthread_t perl_os_thread;
|
||||
typedef mutex_t perl_mutex;
|
||||
typedef condition_t perl_cond;
|
||||
typedef void * perl_key;
|
||||
# else /* Posix threads */
|
||||
# include <pthread.h>
|
||||
typedef pthread_t perl_os_thread;
|
||||
typedef pthread_mutex_t perl_mutex;
|
||||
typedef pthread_cond_t perl_cond;
|
||||
typedef pthread_key_t perl_key;
|
||||
# endif /* I_MACH_CTHREADS */
|
||||
# endif /* OS2 */
|
||||
# endif /* WIN32 */
|
||||
# endif /* FAKE_THREADS */
|
||||
@ -1369,7 +1390,7 @@ EXT char Error[1];
|
||||
# define HAS_VTOHS
|
||||
# define HAS_HTOVL
|
||||
# define HAS_HTOVS
|
||||
# if BYTEORDER == 0x4321
|
||||
# if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
|
||||
# define vtohl(x) ((((x)&0xFF)<<24) \
|
||||
+(((x)>>24)&0xFF) \
|
||||
+(((x)&0x0000FF00)<<8) \
|
||||
@ -1554,7 +1575,7 @@ char *getlogin _((void));
|
||||
#define UNLINK unlnk
|
||||
I32 unlnk _((char*));
|
||||
#else
|
||||
#define UNLINK unlink
|
||||
#define UNLINK PerlLIO_unlink
|
||||
#endif
|
||||
|
||||
#ifndef HAS_SETREUID
|
||||
@ -1594,8 +1615,22 @@ typedef Sighandler_t Sigsave_t;
|
||||
#endif
|
||||
|
||||
#ifdef MYMALLOC
|
||||
# define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex)
|
||||
# define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex)
|
||||
# ifdef MUTEX_INIT_CALLS_MALLOC
|
||||
# define MALLOC_INIT \
|
||||
STMT_START { \
|
||||
PL_malloc_mutex = NULL; \
|
||||
MUTEX_INIT(&PL_malloc_mutex); \
|
||||
} STMT_END
|
||||
# define MALLOC_TERM \
|
||||
STMT_START { \
|
||||
perl_mutex tmp = PL_malloc_mutex; \
|
||||
PL_malloc_mutex = NULL; \
|
||||
MUTEX_DESTROY(&tmp); \
|
||||
} STMT_END
|
||||
# else
|
||||
# define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex)
|
||||
# define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex)
|
||||
# endif
|
||||
#else
|
||||
# define MALLOC_INIT
|
||||
# define MALLOC_TERM
|
||||
@ -1912,6 +1947,39 @@ typedef enum {
|
||||
XTERMBLOCK
|
||||
} expectation;
|
||||
|
||||
enum { /* pass one of these to get_vtbl */
|
||||
want_vtbl_sv,
|
||||
want_vtbl_env,
|
||||
want_vtbl_envelem,
|
||||
want_vtbl_sig,
|
||||
want_vtbl_sigelem,
|
||||
want_vtbl_pack,
|
||||
want_vtbl_packelem,
|
||||
want_vtbl_dbline,
|
||||
want_vtbl_isa,
|
||||
want_vtbl_isaelem,
|
||||
want_vtbl_arylen,
|
||||
want_vtbl_glob,
|
||||
want_vtbl_mglob,
|
||||
want_vtbl_nkeys,
|
||||
want_vtbl_taint,
|
||||
want_vtbl_substr,
|
||||
want_vtbl_vec,
|
||||
want_vtbl_pos,
|
||||
want_vtbl_bm,
|
||||
want_vtbl_fm,
|
||||
want_vtbl_uvar,
|
||||
want_vtbl_defelem,
|
||||
want_vtbl_regexp,
|
||||
want_vtbl_collxfrm,
|
||||
want_vtbl_amagic,
|
||||
want_vtbl_amagicelem
|
||||
#ifdef USE_THREADS
|
||||
,
|
||||
want_vtbl_mutex
|
||||
#endif
|
||||
};
|
||||
|
||||
|
||||
/* Note: the lowest 8 bits are reserved for
|
||||
stuffing into op->op_private */
|
||||
@ -2084,6 +2152,50 @@ typedef void *Thread;
|
||||
#endif
|
||||
|
||||
#ifdef PERL_OBJECT
|
||||
/* from perly.c */
|
||||
#undef yydebug
|
||||
#undef yynerrs
|
||||
#undef yyerrflag
|
||||
#undef yychar
|
||||
#undef yyssp
|
||||
#undef yyvsp
|
||||
#undef yyval
|
||||
#undef yylval
|
||||
#define yydebug PL_yydebug
|
||||
#define yynerrs PL_yynerrs
|
||||
#define yyerrflag PL_yyerrflag
|
||||
#define yychar PL_yychar
|
||||
#define yyssp PL_yyssp
|
||||
#define yyvsp PL_yyvsp
|
||||
#define yyval PL_yyval
|
||||
#define yylval PL_yylval
|
||||
PERLVAR(yydebug, int)
|
||||
PERLVAR(yynerrs, int)
|
||||
PERLVAR(yyerrflag, int)
|
||||
PERLVAR(yychar, int)
|
||||
PERLVAR(yyssp, short*)
|
||||
PERLVAR(yyvsp, YYSTYPE*)
|
||||
PERLVAR(yyval, YYSTYPE)
|
||||
PERLVAR(yylval, YYSTYPE)
|
||||
|
||||
#define efloatbuf PL_efloatbuf
|
||||
#define efloatsize PL_efloatsize
|
||||
PERLVAR(efloatbuf, char *)
|
||||
PERLVAR(efloatsize, STRLEN)
|
||||
|
||||
#define glob_index PL_glob_index
|
||||
#define srand_called PL_srand_called
|
||||
#define uudmap PL_uudmap
|
||||
#define bitcount PL_bitcount
|
||||
#define filter_debug PL_filter_debug
|
||||
PERLVAR(glob_index, int)
|
||||
PERLVAR(srand_called, bool)
|
||||
PERLVAR(uudmap[256], char)
|
||||
PERLVAR(bitcount, char*)
|
||||
PERLVAR(filter_debug, int)
|
||||
PERLVAR(super_bufptr, char*) /* PL_bufptr that was */
|
||||
PERLVAR(super_bufend, char*) /* PL_bufend that was */
|
||||
|
||||
/*
|
||||
* The following is a buffer where new variables must
|
||||
* be defined to maintain binary compatibility with PERL_OBJECT
|
||||
@ -2458,4 +2570,18 @@ enum {
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifdef IAMSUID
|
||||
|
||||
#ifdef I_SYS_STATVFS
|
||||
# include <sys/statvfs.h> /* for f?statvfs() */
|
||||
#endif
|
||||
#ifdef I_SYS_MOUNT
|
||||
# include <sys/mount.h> /* for *BSD f?statfs() */
|
||||
#endif
|
||||
#ifdef I_MNTENT
|
||||
# include <mntent.h> /* for getmntent() */
|
||||
#endif
|
||||
|
||||
#endif /* IAMSUID */
|
||||
|
||||
#endif /* Include guard */
|
||||
|
||||
@ -63,6 +63,8 @@ $inif = 0;
|
||||
|
||||
@ARGV = ('-') unless @ARGV;
|
||||
|
||||
build_preamble_if_necessary();
|
||||
|
||||
while (defined ($file = next_file())) {
|
||||
if (-l $file and -d $file) {
|
||||
link_if_possible($file) if ($opt_l);
|
||||
@ -97,6 +99,8 @@ while (defined ($file = next_file())) {
|
||||
open(IN,"$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next);
|
||||
open(OUT,">$Dest_dir/$outfile") || die "Can't create $outfile: $!\n";
|
||||
}
|
||||
|
||||
print OUT "require '_h2ph_pre.ph';\n\n";
|
||||
while (<IN>) {
|
||||
chop;
|
||||
while (/\\$/) {
|
||||
@ -105,6 +109,7 @@ while (defined ($file = next_file())) {
|
||||
chop;
|
||||
}
|
||||
print OUT "# $_\n" if $opt_D;
|
||||
|
||||
if (s:/\*:\200:g) {
|
||||
s:\*/:\201:g;
|
||||
s/\200[^\201]*\201//g; # delete single line comments
|
||||
@ -158,6 +163,7 @@ while (defined ($file = next_file())) {
|
||||
$args = reindent($args);
|
||||
if ($t ne '') {
|
||||
$new =~ s/(['\\])/\\$1/g; #']);
|
||||
|
||||
if ($opt_h) {
|
||||
print OUT $t,"eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name () {",$new,";}' unless defined(\&$name);\n";
|
||||
$eval_index++;
|
||||
@ -165,6 +171,9 @@ while (defined ($file = next_file())) {
|
||||
print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n";
|
||||
}
|
||||
} else {
|
||||
# Shunt around such directives as `#define FOO FOO':
|
||||
next if " \&$name" eq $new;
|
||||
|
||||
print OUT $t,"unless(defined(\&$name)) {\n sub $name () {\t",$new,";}\n}\n";
|
||||
}
|
||||
}
|
||||
@ -230,10 +239,12 @@ while (defined ($file = next_file())) {
|
||||
print OUT $t,"}\n";
|
||||
} elsif(/^undef\s+(\w+)/) {
|
||||
print OUT $t, "undef(&$1) if defined(&$1);\n";
|
||||
} elsif(/^error\s+(".*")/) {
|
||||
print OUT $t, "die($1);\n";
|
||||
} elsif(/^error\s+(.*)/) {
|
||||
print OUT $t, "die(\"$1\");\n";
|
||||
print OUT $t, "die(\"", quotemeta($1), "\");\n";
|
||||
} elsif(/^warning\s+(.*)/) {
|
||||
print OUT $t, "warn(\"$1\");\n";
|
||||
print OUT $t, "warn(\"", quotemeta($1), "\");\n";
|
||||
} elsif(/^ident\s+(.*)/) {
|
||||
print OUT $t, "# $1\n";
|
||||
}
|
||||
@ -512,6 +523,71 @@ sub inc_dirs
|
||||
}
|
||||
|
||||
|
||||
# Create "_h2ph_pre.ph", if it doesn't exist or was built by a different
|
||||
# version of h2ph.
|
||||
sub build_preamble_if_necessary
|
||||
{
|
||||
# Increment $VERSION every time this function is modified:
|
||||
my $VERSION = 1;
|
||||
my $preamble = "$Dest_dir/_h2ph_pre.ph";
|
||||
|
||||
# Can we skip building the preamble file?
|
||||
if (-r $preamble) {
|
||||
# Extract version number from first line of preamble:
|
||||
open PREAMBLE, $preamble or die "Cannot open $preamble: $!";
|
||||
my $line = <PREAMBLE>;
|
||||
$line =~ /(\b\d+\b)/;
|
||||
close PREAMBLE or die "Cannot close $preamble: $!";
|
||||
|
||||
# Don't build preamble if a compatible preamble exists:
|
||||
return if $1 == $VERSION;
|
||||
}
|
||||
|
||||
my (%define) = _extract_cc_defines();
|
||||
|
||||
open PREAMBLE, ">$preamble" or die "Cannot open $preamble: $!";
|
||||
print PREAMBLE "# This file was created by h2ph version $VERSION\n";
|
||||
|
||||
foreach (sort keys %define) {
|
||||
if ($opt_D) {
|
||||
print PREAMBLE "# $_=$define{$_}\n";
|
||||
}
|
||||
|
||||
if ($define{$_} =~ /^\d+$/) {
|
||||
print PREAMBLE
|
||||
"unless (defined &$_) { sub $_() { $define{$_} } }\n\n";
|
||||
} else {
|
||||
print PREAMBLE
|
||||
"unless (defined &$_) { sub $_() { \"",
|
||||
quotemeta($define{$_}), "\" } }\n\n";
|
||||
}
|
||||
}
|
||||
close PREAMBLE or die "Cannot close $preamble: $!";
|
||||
}
|
||||
|
||||
|
||||
# %Config contains information on macros that are pre-defined by the
|
||||
# system's compiler. We need this information to make the .ph files
|
||||
# function with perl as the .h files do with cc.
|
||||
sub _extract_cc_defines
|
||||
{
|
||||
my %define;
|
||||
my $allsymbols = join " ", @Config{ccsymbols, cppsymbols, cppccsymbols};
|
||||
|
||||
# Split compiler pre-definitions into `key=value' pairs:
|
||||
foreach (split /\s+/, $allsymbols) {
|
||||
/(.*?)=(.*)/;
|
||||
$define{$1} = $2;
|
||||
|
||||
if ($opt_D) {
|
||||
print STDERR "$_: $1 -> $2\n";
|
||||
}
|
||||
}
|
||||
|
||||
return %define;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
##############################################################################
|
||||
@ -590,6 +666,10 @@ However, the B<.ph> files almost double in size when built using B<-h>.
|
||||
Include the code from the B<.h> file as a comment in the B<.ph> file.
|
||||
This is primarily used for debugging I<h2ph>.
|
||||
|
||||
=item -Q
|
||||
|
||||
``Quiet'' mode; don't print out the names of the files being converted.
|
||||
|
||||
=back
|
||||
|
||||
=head1 ENVIRONMENT
|
||||
@ -626,6 +706,24 @@ that it can translate.
|
||||
It's only intended as a rough tool.
|
||||
You may need to dicker with the files produced.
|
||||
|
||||
Doesn't run with C<use strict>
|
||||
|
||||
You have to run this program by hand; it's not run as part of the Perl
|
||||
installation.
|
||||
|
||||
Doesn't handle complicated expressions built piecemeal, a la:
|
||||
|
||||
enum {
|
||||
FIRST_VALUE,
|
||||
SECOND_VALUE,
|
||||
#ifdef ABC
|
||||
THIRD_VALUE
|
||||
#endif
|
||||
};
|
||||
|
||||
Doesn't necessarily locate all of your C compiler's internally-defined
|
||||
symbols.
|
||||
|
||||
=cut
|
||||
|
||||
!NO!SUBS!
|
||||
|
||||
@ -528,7 +528,7 @@ EOF
|
||||
Environment for perl $]:
|
||||
EOF
|
||||
for my $env (sort
|
||||
(qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR),
|
||||
(qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE),
|
||||
grep /^(?:PERL|LC_)/, keys %ENV)
|
||||
) {
|
||||
print OUT " $env",
|
||||
@ -901,6 +901,13 @@ it all, but at least have a look at the sections that I<seem> relevant).
|
||||
Be aware of the familiar traps that perl programmers of various hues
|
||||
fall into. See L<perltrap>.
|
||||
|
||||
Check in L<perldiag> to see what any Perl error message(s) mean.
|
||||
If message isn't in perldiag, it probably isn't generated by Perl.
|
||||
Consult your operating system documentation instead.
|
||||
|
||||
If you are on a non-UNIX platform check also L<perlport>, some
|
||||
features may not be implemented or work differently.
|
||||
|
||||
Try to study the problem under the perl debugger, if necessary.
|
||||
See L<perldebug>.
|
||||
|
||||
@ -916,6 +923,17 @@ A good test case is almost always a good candidate to be on the perl
|
||||
test suite. If you have the time, consider making your test case so
|
||||
that it will readily fit into the standard test suite.
|
||||
|
||||
Remember also to include the B<exact> error messages, if any.
|
||||
"Perl complained something" is not an exact error message.
|
||||
|
||||
If you get a core dump (or equivalent), you may use a debugger
|
||||
(B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
|
||||
report. NOTE: unless your Perl has been compiled with debug info
|
||||
(often B<-g>), the stack trace is likely to be somewhat hard to use
|
||||
because it will most probably contain only the function names, not
|
||||
their arguments. If possible, recompile your Perl with debug info and
|
||||
reproduce the dump and the stack trace.
|
||||
|
||||
=item Can you describe the bug in plain English?
|
||||
|
||||
The easier it is to understand a reproducible bug, the more likely it
|
||||
@ -954,6 +972,11 @@ it to B<perlbug@perl.com>. If, for some reason, you cannot run
|
||||
C<perlbug> at all on your system, be sure to include the entire output
|
||||
produced by running C<perl -V> (note the uppercase V).
|
||||
|
||||
Whether you use C<perlbug> or send the email manually, please make
|
||||
your subject informative. "a bug" not informative. Neither is "perl
|
||||
crashes" nor "HELP!!!", these all are null information. A compact
|
||||
description of what's wrong is fine.
|
||||
|
||||
=back
|
||||
|
||||
Having done your bit, please be prepared to wait, to be told the bug
|
||||
@ -1071,12 +1094,14 @@ Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently I<doc>tored
|
||||
by Gurusamy Sarathy (E<lt>gsar@umich.eduE<gt>), Tom Christiansen
|
||||
(E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
|
||||
Charles F. Randall (E<lt>cfr@pobox.comE<gt>), Mike Guy
|
||||
(E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>)
|
||||
and Hugo van der Sanden (E<lt>hv@crypt0.demon.co.ukE<gt>).
|
||||
(E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>),
|
||||
Hugo van der Sanden (E<lt>hv@crypt0.demon.co.ukE<gt>), and
|
||||
Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>).
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), perldebug(1), perltrap(1), diff(1), patch(1)
|
||||
perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
|
||||
diff(1), patch(1), dbx(1), gdb(1)
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
@ -1090,4 +1115,3 @@ close OUT or die "Can't close $file: $!";
|
||||
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
|
||||
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
|
||||
chdir $origdir;
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user