X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/76287dce09265df293372ba2775a5b0e95359fbe..a633c72b52416b7dbe2354fbc72b752af530ba5d:/ext/Errno/Errno_pm.PL diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL index dc17b45..39e2c19 100644 --- a/ext/Errno/Errno_pm.PL +++ b/ext/Errno/Errno_pm.PL @@ -1,13 +1,11 @@ -#!perl use ExtUtils::MakeMaker; use Config; use strict; -use vars qw($VERSION); - -$VERSION = "1.08"; +our $VERSION = "1.09_01"; my %err = (); +my %wsa = (); unlink "Errno.pm" if -f "Errno.pm"; open OUT, ">Errno.pm" or die "Cannot open Errno.pm: $!"; @@ -22,7 +20,14 @@ unlink "errno.c" if -f "errno.c"; sub process_file { my($file) = @_; - return unless defined $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')) { @@ -30,17 +35,59 @@ sub process_file { warn "Cannot open '$file'"; return; } + } 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 $Config{cppflags} $file |")) { + warn "Cannot open '$file'"; + return; + } } else { unless(open(FH,"< $file")) { - warn "Cannot open '$file'"; + # This file could be a temporary file created by cppstdin + # so only warn under -w, and return + warn "Cannot open '$file'" if $^W; 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 ($^O eq 'MSWin32') { + $wsa{$1} = 1 + if /^\s*#\s*define\s+WSA(E\w+)\s+/; + } + } + } + close(FH); +} + +my $cppstdin; + +sub default_cpp { + unless (defined $cppstdin) { + use File::Spec; + $cppstdin = $Config{cppstdin}; + my $upup_cppstdin = File::Spec->catfile(File::Spec->updir, + File::Spec->updir, + "cppstdin"); + my $cppstdin_is_wrapper = + ($cppstdin eq 'cppstdin' + and -f $upup_cppstdin + and -x $upup_cppstdin); + $cppstdin = $upup_cppstdin if $cppstdin_is_wrapper; + } + return "$cppstdin $Config{cppflags} $Config{cppminus}"; } sub get_files { @@ -54,28 +101,79 @@ sub get_files { } elsif ($Config{vms_cc_type} eq 'gcc') { $file{'gnu_cc_include:[000000]errno.h'} = 1; } + } elsif ($^O eq 'os390') { + # OS/390 C compiler doesn't generate #file or #line directives + $file{'/usr/include/errno.h'} = 1; + } elsif ($^O eq 'vmesa') { + # OS/390 C compiler doesn't generate #file or #line directives + $file{'../../vmesa/errno.h'} = 1; + } 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 + 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; } 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 ($^O eq 'MSWin32') { + print CPPI "#define _WINSOCKAPI_\n"; # don't drag in everything + print CPPI "#include \n"; + } + } close(CPPI); # invoke CPP and read the output - - open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or - die "Cannot exec $Config{cpprun}"; + if ($^O eq 'MSWin32' || $^O eq 'NetWare') { + 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"; + } my $pat; - if ($^O eq 'MSWin32' and $Config{cc} =~ /^bcc/i) { + if (($^O eq 'MSWin32' || $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) { $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/'; } else { - $pat = '^#(?:line)?\s*\d+\s+"([^"]+)"'; + $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"'; } while() { - $file{$1} = 1 if /$pat/o; + if ($^O eq 'os2' or $^O eq 'MSWin32' or $^O eq 'NetWare') { + if (/$pat/o) { + my $f = $1; + $f =~ s,\\\\,/,g; + $file{$f} = 1; + } + } + else { + $file{$1} = 1 if /$pat/o; + } } close(CPPO); } @@ -85,42 +183,109 @@ sub get_files { sub write_errno_pm { my $err; + # quick sanity check + + die "No error definitions found" unless keys %err; + # create the CPP input 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 ($^O eq 'MSWin32') { + 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 'next') { - my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}"; - open(CPPO,"$cpp < errno.c |") or die "Cannot exec $cpp"; - } else { - open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or - die "Cannot exec $Config{cpprun}"; - } - %err = (); + 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' || $^O eq 'NetWare') { + 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"; + } + + %err = (); - while() { - my($name,$expr); - next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/; - next if $name eq $expr; - $err{$name} = eval $expr; + 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); + } + + # 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 @@ -130,15 +295,17 @@ sub write_errno_pm { # package Errno; -use vars qw(\@EXPORT_OK \%EXPORT_TAGS \@ISA \$VERSION \%errno \$AUTOLOAD); +our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD); use Exporter (); use Config; use strict; -\$Config{'myarchname'} eq "$Config{'myarchname'}" or - die "Errno architecture ($Config{'myarchname'}) does not match executable architecture (\$Config{'myarchname'})"; +"\$Config{'archname'}-\$Config{'osvers'}" eq +"$Config{'archname'}-$Config{'osvers'}" or + 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 @@ -185,13 +352,14 @@ sub TIEHASH { bless [] } sub FETCH { my ($self, $errname) = @_; my $proto = prototype("Errno::$errname"); + my $errno = ""; if (defined($proto) && $proto eq "") { no strict 'refs'; - return $! == &$errname; + $errno = &$errname; + $errno = 0 unless $! == $errno; } - require Carp; - Carp::confess("No errno $errname"); -} + return $errno; +} sub STORE { require Carp; @@ -206,19 +374,19 @@ sub NEXTKEY { while(($k,$v) = each %Errno::) { my $proto = prototype("Errno::$k"); last if (defined($proto) && $proto eq ""); - } $k } sub FIRSTKEY { - my $s = scalar keys %Errno::; + my $s = scalar keys %Errno::; # initialize iterator goto &NEXTKEY; } 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 ""; } @@ -241,11 +409,11 @@ C defines and conditionally exports all the error constants defined in your system C include file. It has a single export tag, C<:POSIX>, which will export all POSIX defined error numbers. -C also makes C<%!> magic such that each element of C<%!> has a non-zero -value only if C<$!> is set to that value, eg +C also makes C<%!> magic such that each element of C<%!> has a +non-zero value only if C<$!> is set to that value. For example: use Errno; - + unless (open(FH, "/fangorn/spouse")) { if ($!{ENOENT}) { warn "Get a wife!\n"; @@ -254,6 +422,20 @@ value only if C<$!> is set to that value, eg } } +If a specified constant C does not exist on the system, C<$!{EFOO}> +returns C<"">. You may use C to check whether the +constant is available on the system. + +=head1 CAVEATS + +Importing a particular constant may not be very portable, because the +import will fail on platforms that do not have that constant. A more +portable way to set C<$!> to a valid value is to use: + + if (exists &Errno::EFOO) { + $! = &Errno::EFOO; + } + =head1 AUTHOR Graham Barr