use Config;
use strict;
-our $VERSION = "1.111";
+our $VERSION = "1.25";
my %err = ();
+# 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: $!";
+unlink "Errno.tmp" if -f "Errno.tmp";
+open OUT, ">Errno.tmp" or die "Cannot open Errno.tmp: $!";
select OUT;
my $file;
-foreach $file (get_files()) {
- process_file($file);
+my @files = get_files();
+if ($Config{gccversion} ne '' && $^O eq 'MSWin32') {
+ # MinGW complains "warning: #pragma system_header ignored outside include
+ # file" if the header files are processed individually, so include them
+ # all in .c file and process that instead.
+ open INCS, '>includes.c' or
+ die "Cannot open includes.c";
+ foreach $file (@files) {
+ next if $file eq 'errno.c';
+ next unless -f $file;
+ print INCS qq[#include "$file"\n];
+ }
+ close INCS;
+ process_file('includes.c');
+ unlink 'includes.c';
+}
+else {
+ foreach $file (@files) {
+ process_file($file);
+ }
}
write_errno_pm();
unlink "errno.c" if -f "errno.c";
+close OUT or die "Error closing Errno.tmp: $!";
+select STDOUT;
+rename "Errno.tmp", "Errno.pm" or die "Cannot rename Errno.tmp to Errno.pm: $!";
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')) {
warn "Cannot open '$file'";
return;
}
- } elsif ($Config{gccversion} ne '') {
+ } elsif ($Config{gccversion} ne '' && $^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;
}
}
-
- if ($^O eq 'MacOS') {
- while(<FH>) {
- $err{$1} = $2
- if /^\s*#\s*define\s+(E\w+)\s+(\d+)/;
- }
- } else {
- while(<FH>) {
- $err{$1} = 1
- if /^\s*#\s*define\s+(E\w+)\s+/;
- }
+
+ my $pat;
+ if ($IsMSWin32) {
+ $pat = '^\s*#\s*define\s+((?:WSA)?E\w+)\s+';
+ }
+ else {
+ $pat = '^\s*#\s*define\s+(E\w+)\s+';
+ }
+ while(<FH>) {
+ $err{$1} = 1
+ if /$pat/;
}
+
close(FH);
}
sub get_files {
my %file = ();
- # VMS keeps its include files in system libraries (well, except for Gcc)
+ # VMS keeps its include files in system libraries
if ($^O eq 'VMS') {
- if ($Config{vms_cc_type} eq 'decc') {
- $file{'Sys$Library:DECC$RTLDEF.TLB'} = 1;
- } elsif ($Config{vms_cc_type} eq 'vaxc') {
- $file{'Sys$Library:vaxcdef.tlb'} = 1;
- } elsif ($Config{vms_cc_type} eq 'gcc') {
- $file{'gnu_cc_include:[000000]errno.h'} = 1;
- }
+ $file{'Sys$Library:DECC$RTLDEF.TLB'} = 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/epoc/include/libc/sys/errno.h'} = 1;
- } elsif ($^O eq 'linux') {
+ } elsif ($Config{archname} eq 'arm-riscos') {
+ # Watch out for cross compiling for RISC OS
+ my $dep = `echo "#include <errno.h>" | gcc -E -M -`;
+ if ($dep =~ /(\S+errno\.h)/) {
+ $file{$1} = 1;
+ }
+ } elsif ($^O eq 'linux' &&
+ $Config{gccversion} ne '' &&
+ $Config{gccversion} !~ /intel/i
+ # might be using, say, Intel's icc
+ ) {
+ # When cross-compiling we may store a path for gcc's "sysroot" option:
+ my $sysroot = $Config{sysroot} || '';
# Some Linuxes have weird errno.hs which generate
# no #file or #line directives
- $file{'/usr/include/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;
-
+ my ($linux_errno_h) = grep { -e $_ } map { "$_/errno.h" }
+ "$sysroot/usr/include", "$sysroot/usr/local/include",
+ split / / => $Config{locincpth} or
+ die "Cannot find errno.h";
+ $file{$linux_errno_h} = 1;
+ } elsif ($^O eq 'haiku') {
+ # 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 <errno.h>\n";
+ if ($^O eq 'NetWare') {
+ print CPPI "#include <nwerrno.h>\n";
+ } else {
+ print CPPI "#include <errno.h>\n";
+ if ($IsMSWin32) {
+ print CPPI qq[#include "../../win32/include/sys/errno2.h"\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 {
die "Cannot exec $cpp";
}
- my $pat;
- if ($^O eq 'MSWin32' and $Config{cc} =~ /^bcc/i) {
- $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/';
- }
- else {
- $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
- }
+ my $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
while(<CPPO>) {
- 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;
open(CPPI,"> errno.c") or
die "Cannot open errno.c";
- print CPPI "#include <errno.h>\n";
-
+ if ($^O eq 'NetWare') {
+ print CPPI "#include <nwerrno.h>\n";
+ }
+ else {
+ print CPPI "#include <errno.h>\n";
+ }
+ if ($IsMSWin32) {
+ print CPPI qq[#include "../../win32/include/sys/errno2.h"\n];
+ }
+
foreach $err (keys %err) {
print CPPI '"',$err,'" [[',$err,']]',"\n";
}
close(CPPI);
- unless ($^O eq 'MacOS') { # trust what we have
+ { # BeOS (support now removed) did not enter this block
# invoke CPP and read the output
+ my $inhibit_linemarkers = '';
+ if ($Config{gccversion} =~ /\A(\d+)\./ and $1 >= 5) {
+ # GCC 5.0 interleaves expanded macros with line numbers breaking
+ # each line into multiple lines. RT#123784
+ $inhibit_linemarkers = ' -P';
+ }
+
if ($^O eq 'VMS') {
- my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
+ my $cpp = "$Config{cppstdin} $Config{cppflags}" .
+ $inhibit_linemarkers . " $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();
+ } elsif ($IsMSWin32 || $^O eq 'NetWare') {
+ my $cpp = "$Config{cpprun} $Config{cppflags}" .
+ $inhibit_linemarkers;
+ open(CPPO,"$cpp errno.c |") or
+ die "Cannot run '$cpp errno.c'";
+ } elsif ($IsSymbian) {
+ my $cpp = "gcc -E -I$ENV{SDK}\\epoc32\\include\\libc" .
+ $inhibit_linemarkers ." -";
+ open(CPPO,"$cpp < errno.c |")
+ or die "Cannot exec $cpp";
+ } else {
+ my $cpp = default_cpp() . $inhibit_linemarkers;
open(CPPO,"$cpp < errno.c |")
or die "Cannot exec $cpp";
}
my($name,$expr);
next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
next if $name eq $expr;
- $err{$name} = eval $expr;
+ $expr =~ s/\(?\(\s*[a-z_]\w*\s*\)\(?([^\)]+)\)?\)?/$1/i; # ((type)0xcafebabe) at alia
+ $expr =~ s/\b((?:0x)?[0-9a-f]+)[LU]+\b/$1/gi; # 2147483647L et alia
+ next if $expr =~ m/\b[a-z_]\w*\b/i; # skip expressions containing function names etc
+ if($expr =~ m/^0[xX]/) {
+ $err{$name} = hex $expr;
+ }
+ else {
+ $err{$name} = eval $expr;
+ }
+ delete $err{$name} unless defined $err{$name};
}
close(CPPO);
}
+ # escape $Config{'archname'}
+ my $archname = $Config{'archname'};
+ $archname =~ s/([@%\$])/\\$1/g;
+
# Write Errno.pm
print <<"EDQ";
+# -*- buffer-read-only: t -*-
#
# This file is auto-generated. ***ANY*** changes here will be lost
#
package Errno;
-our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD);
-use Exporter ();
-use Config;
+require Exporter;
use strict;
+EDQ
+
+ # Errno only needs Config to make sure it hasn't changed platforms.
+ # If someone set $ENV{PERL_BUILD_EXPAND_CONFIG_VARS} at build time,
+ # they've already declared perl doesn't need to worry about this risk.
+ if(!$ENV{'PERL_BUILD_EXPAND_CONFIG_VARS'}) {
+ print <<"CONFIG_CHECK_END";
+use Config;
"\$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'})";
+"$archname-$Config{'osvers'}" or
+ die "Errno architecture ($archname-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
+
+CONFIG_CHECK_END
+}
+
+ print <<"EDQ";
+our \$VERSION = "$VERSION";
+\$VERSION = eval \$VERSION;
+our \@ISA = 'Exporter';
-\$VERSION = "$VERSION";
-\@ISA = qw(Exporter);
+my %err;
+BEGIN {
+ %err = (
EDQ
-
- my $len = 0;
- my @err = sort { $err{$a} <=> $err{$b} } keys %err;
- map { $len = length if length > $len } @err;
- my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
- $j =~ s/(.{50,70})\s/$1\n\t/g;
- print $j,"\n";
+ my @err = sort { $err{$a} <=> $err{$b} || $a cmp $b }
+ grep { $err{$_} =~ /-?\d+$/ } keys %err;
+
+ foreach $err (@err) {
+ print "\t$err => $err{$err},\n";
+ }
print <<'ESQ';
-%EXPORT_TAGS = (
+ );
+ # Generate proxy constant subroutines for all the values.
+ # Well, almost all the values. Unfortunately we can't assume that at this
+ # point that our symbol table is empty, as code such as if the parser has
+ # seen code such as C<exists &Errno::EINVAL>, it will have created the
+ # typeglob.
+ # Doing this before defining @EXPORT_OK etc means that even if a platform is
+ # crazy enough to define EXPORT_OK as an error constant, everything will
+ # still work, because the parser will upgrade the PCS to a real typeglob.
+ # We rely on the subroutine definitions below to update the internal caches.
+ # Don't use %each, as we don't want a copy of the value.
+ foreach my $name (keys %err) {
+ if ($Errno::{$name}) {
+ # We expect this to be reached fairly rarely, so take an approach
+ # which uses the least compile time effort in the common case:
+ eval "sub $name() { $err{$name} }; 1" or die $@;
+ } else {
+ $Errno::{$name} = \$err{$name};
+ }
+ }
+}
+
+our @EXPORT_OK = keys %err;
+
+our %EXPORT_TAGS = (
POSIX => [qw(
ESQ
EUSERS EWOULDBLOCK EXDEV));
$k =~ s/(.{50,70})\s/$1\n\t/g;
- print "\t",$k,"\n )]\n);\n\n";
+ print "\t",$k,"\n )],\n";
- foreach $err (@err) {
- printf "sub %s () { %d }\n",,$err,$err{$err};
+ if ($IsMSWin32) {
+ print " WINSOCK => [qw(\n";
+ $k = join(" ", grep { /^WSAE/ } keys %err);
+ $k =~ s/(.{50,70})\s/$1\n\t/g;
+ print "\t",$k,"\n )],\n";
}
- print <<'ESQ';
+ print ");\n\n";
-sub TIEHASH { bless [] }
+ print <<'ESQ';
+sub TIEHASH { bless \%err }
sub FETCH {
- my ($self, $errname) = @_;
- my $proto = prototype("Errno::$errname");
- my $errno = "";
- if (defined($proto) && $proto eq "") {
- no strict 'refs';
- $errno = &$errname;
- $errno = 0 unless $! == $errno;
- }
- return $errno;
+ my (undef, $errname) = @_;
+ return "" unless exists $err{$errname};
+ my $errno = $err{$errname};
+ return $errno == $! ? $errno : 0;
}
sub STORE {
Carp::confess("ERRNO hash is read only!");
}
-*CLEAR = \&STORE;
-*DELETE = \&STORE;
+# This is the true return value
+*CLEAR = *DELETE = \*STORE; # Typeglob aliasing uses less space
sub NEXTKEY {
- my($k,$v);
- while(($k,$v) = each %Errno::) {
- my $proto = prototype("Errno::$k");
- last if (defined($proto) && $proto eq "");
- }
- $k
+ each %err;
}
sub FIRSTKEY {
- my $s = scalar keys %Errno::; # initialize iterator
- goto &NEXTKEY;
+ my $s = scalar keys %err; # initialize iterator
+ each %err;
}
sub EXISTS {
- my ($self, $errname) = @_;
- my $proto = prototype($errname);
- defined($proto) && $proto eq "";
+ my (undef, $errname) = @_;
+ exists $err{$errname};
}
-tie %!, __PACKAGE__;
+sub _tie_it {
+ tie %{$_[0]}, __PACKAGE__;
+}
-1;
__END__
=head1 NAME
=head1 DESCRIPTION
C<Errno> defines and conditionally exports all the error constants
-defined in your system C<errno.h> include file. It has a single export
+defined in your system F<errno.h> include file. It has a single export
tag, C<:POSIX>, which will export all POSIX defined error numbers.
+On Windows, C<Errno> also defines and conditionally exports all the
+Winsock error constants defined in your system F<WinError.h> include
+file. These are included in a second export tag, C<:WINSOCK>.
+
C<Errno> 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:
=cut
+# ex: set ro:
ESQ
}
https://perl5.git.perl.org / perl5.git / blobdiff