X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FErrno%2FErrno_pm.PL;h=5c76d89057094175745bbf843351e8b319b9b616;hb=427d62a407a31445bc7585263d1b781552e27ce5;hp=3e34b90bee4f5f606872a2827a33f5477f1e9231;hpb=0e06870bf080a38cda51c06c6612359afc2334e1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL index 3e34b90..5c76d89 100644 --- a/ext/Errno/Errno_pm.PL +++ b/ext/Errno/Errno_pm.PL @@ -2,9 +2,15 @@ use ExtUtils::MakeMaker; use Config; use strict; -our $VERSION = "1.111"; +our $VERSION = "1.09_01"; my %err = (); +my %wsa = (); + +# Symbian cross-compiling environment. +my $IsSymbian = exists $ENV{SDK} && -d "$ENV{SDK}\\epoc32"; + +my $IsMSWin32 = $^O eq 'MSWin32' && !$IsSymbian; unlink "Errno.pm" if -f "Errno.pm"; open OUT, ">Errno.pm" or die "Cannot open Errno.pm: $!"; @@ -19,7 +25,14 @@ unlink "errno.c" if -f "errno.c"; sub process_file { my($file) = @_; + # for win32 perl under cygwin, we need to get a windows pathname + if ($^O eq 'MSWin32' && $Config{cc} =~ /\B-mno-cygwin\b/ && + defined($file) && !-f $file) { + chomp($file = `cygpath -w "$file"`); + } + return unless defined $file and -f $file; +# warn "Processing $file\n"; local *FH; if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) { @@ -27,9 +40,13 @@ sub process_file { warn "Cannot open '$file'"; return; } - } elsif ($Config{gccversion} ne '') { + } elsif ($Config{gccversion} ne '' + # OpenSTEP has gcc 2.7.2.1 which recognizes but + # doesn't implement the -dM flag. + && $^O ne 'openstep' && $^O ne 'next' && $^O ne 'darwin' + ) { # With the -dM option, gcc outputs every #define it finds - unless(open(FH,"$Config{cc} -E -dM $file |")) { + unless(open(FH,"$Config{cc} -E -dM $Config{cppflags} $file |")) { warn "Cannot open '$file'"; return; } @@ -41,11 +58,24 @@ sub process_file { return; } } - while() { - $err{$1} = 1 - if /^\s*#\s*define\s+(E\w+)\s+/; - } - close(FH); + + if ($^O eq 'MacOS') { + while() { + $err{$1} = $2 + if /^\s*#\s*define\s+(E\w+)\s+(\d+)/; + } + } else { + while() { + $err{$1} = 1 + if /^\s*#\s*define\s+(E\w+)\s+/; + if ($IsMSWin32) { + $wsa{$1} = 1 + if /^\s*#\s*define\s+WSA(E\w+)\s+/; + } + } + } + + close(FH); } my $cppstdin; @@ -83,20 +113,51 @@ sub get_files { } elsif ($^O eq 'vmesa') { # OS/390 C compiler doesn't generate #file or #line directives $file{'../../vmesa/errno.h'} = 1; - } elsif ($^O eq 'linux') { + } elsif ($Config{archname} eq 'epoc') { + # Watch out for cross compiling for EPOC (usually done on linux) + $file{'/usr/local/epocemx/epocsdk/include/libc/sys/errno.h'} = 1; + } elsif ($^O eq 'linux' && + $Config{gccversion} ne '' # might be using, say, Intel's icc + ) { # Some Linuxes have weird errno.hs which generate # no #file or #line directives - $file{'/usr/include/errno.h'} = 1; + my $linux_errno_h = -e '/usr/include/errno.h' ? + '/usr/include/errno.h' : '/usr/local/include/errno.h'; + $file{$linux_errno_h} = 1; + } elsif ($^O eq 'MacOS') { + # note that we are only getting the GUSI errno's here ... + # we might miss out on compiler-specific ones + $file{"$ENV{GUSI}include:sys:errno.h"} = 1; + + } elsif ($^O eq 'beos') { + # hidden in a special place + $file{'/boot/develop/headers/posix/errno.h'} = 1; + + } elsif ($^O eq 'vos') { + # avoid problem where cpp returns non-POSIX pathnames + $file{'/system/include_library/errno.h'} = 1; + } elsif ($IsSymbian) { + my $SDK = $ENV{SDK}; + $SDK =~ s!\\!/!g; + $file{"$SDK/epoc32/include/libc/sys/errno.h"} = 1; } else { open(CPPI,"> errno.c") or die "Cannot open errno.c"; - print CPPI "#include \n"; + if ($^O eq 'NetWare') { + print CPPI "#include \n"; + } else { + print CPPI "#include \n"; + if ($IsMSWin32) { + print CPPI "#define _WINSOCKAPI_\n"; # don't drag in everything + print CPPI "#include \n"; + } + } close(CPPI); # invoke CPP and read the output - if ($^O eq 'MSWin32') { + if ($IsMSWin32 || $^O eq 'NetWare') { open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; } else { @@ -106,14 +167,14 @@ sub get_files { } my $pat; - if ($^O eq 'MSWin32' and $Config{cc} =~ /^bcc/i) { + if (($IsMSWin32 || $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) { $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/'; } else { $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"'; } while() { - if ($^O eq 'os2' or $^O eq 'MSWin32') { + if ($^O eq 'os2' or $IsMSWin32 or $^O eq 'NetWare') { if (/$pat/o) { my $f = $1; $f =~ s,\\\\,/,g; @@ -141,39 +202,104 @@ sub write_errno_pm { open(CPPI,"> errno.c") or die "Cannot open errno.c"; - print CPPI "#include \n"; - + if ($^O eq 'NetWare') { + print CPPI "#include \n"; + } + else { + print CPPI "#include \n"; + } + if ($IsMSWin32) { + print CPPI "#include \n"; + foreach $err (keys %wsa) { + print CPPI "#ifndef $err\n"; + print CPPI "#define $err WSA$err\n"; + print CPPI "#endif\n"; + $err{$err} = 1; + } + } + foreach $err (keys %err) { print CPPI '"',$err,'" [[',$err,']]',"\n"; } close(CPPI); + unless ($^O eq 'MacOS' || $^O eq 'beos') { # trust what we have / get later # invoke CPP and read the output - if ($^O eq 'VMS') { - my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}"; - $cpp =~ s/sys\$input//i; - open(CPPO,"$cpp errno.c |") or - die "Cannot exec $Config{cppstdin}"; - } elsif ($^O eq 'MSWin32') { - open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or - die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; - } else { - my $cpp = default_cpp(); - open(CPPO,"$cpp < errno.c |") - or die "Cannot exec $cpp"; - } + if ($^O eq 'VMS') { + my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}"; + $cpp =~ s/sys\$input//i; + open(CPPO,"$cpp errno.c |") or + die "Cannot exec $Config{cppstdin}"; + } elsif ($IsMSWin32 || $^O eq 'NetWare') { + open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or + die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; + } elsif ($IsSymbian) { + my $cpp = "gcc -E -I$ENV{SDK}\\epoc32\\include\\libc -"; + open(CPPO,"$cpp < errno.c |") + or die "Cannot exec $cpp"; + } else { + my $cpp = default_cpp(); + open(CPPO,"$cpp < errno.c |") + or die "Cannot exec $cpp"; + } + + %err = (); - %err = (); + while() { + my($name,$expr); + next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/; + next if $name eq $expr; + $expr =~ s/\(?\([a-z_]\w*\)([^\)]*)\)?/$1/i; # ((type)0xcafebabe) at alia + $expr =~ s/((?:0x)?[0-9a-fA-F]+)[LU]+\b/$1/g; # 2147483647L et alia + next if $expr =~ m/^[a-zA-Z]+$/; # skip some Win32 functions + if($expr =~ m/^0[xX]/) { + $err{$name} = hex $expr; + } + else { + $err{$name} = eval $expr; + } + delete $err{$name} unless defined $err{$name}; + } + close(CPPO); + } - while() { - my($name,$expr); - next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/; - next if $name eq $expr; - $err{$name} = eval $expr; + # Many of the E constants (including ENOENT, which is being + # used in the Perl test suite a lot), are available only as + # enums in BeOS, so compiling and executing some code is about + # only way to find out what the numeric Evalues are. In fact above, we + # didn't even bother to get the values of the ones that have numeric + # values, since we can get all of them here, anyway. + + if ($^O eq 'beos') { + if (open(C, ">errno.c")) { + my @allerrs = keys %err; + print C < +#include +int main() { +EOF + for (@allerrs) { + print C qq[printf("$_ %d\n", $_);] + } + print C "}\n"; + close C; + system("cc -o errno errno.c"); + unlink("errno.c"); + if (open(C, "./errno|")) { + while () { + if (/^(\w+) (-?\d+)$/) { $err{$1} = $2 } + } + close(C); + } else { + die "failed to execute ./errno: $!\n"; + } + unlink("errno"); + } else { + die "failed to create errno.c: $!\n"; + } } - close(CPPO); # Write Errno.pm @@ -193,6 +319,7 @@ use strict; die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})"; \$VERSION = "$VERSION"; +\$VERSION = eval \$VERSION; \@ISA = qw(Exporter); EDQ @@ -272,7 +399,8 @@ sub FIRSTKEY { sub EXISTS { my ($self, $errname) = @_; - my $proto = prototype($errname); + my $r = ref $errname; + my $proto = !$r || $r eq 'CODE' ? prototype($errname) : undef; defined($proto) && $proto eq ""; }