This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix Windows build with MinGW-w64's gcc-4.8.0
[perl5.git] / ext / Errno / Errno_pm.PL
CommitLineData
eab60bb1
GS
1use ExtUtils::MakeMaker;
2use Config;
3use strict;
4
f974e9b9 5our $VERSION = "1.20_03";
eab60bb1
GS
6
7my %err = ();
8
27da23d5
JH
9# Symbian cross-compiling environment.
10my $IsSymbian = exists $ENV{SDK} && -d "$ENV{SDK}\\epoc32";
11
12my $IsMSWin32 = $^O eq 'MSWin32' && !$IsSymbian;
13
eab60bb1 14unlink "Errno.pm" if -f "Errno.pm";
cedab142
NC
15unlink "Errno.tmp" if -f "Errno.tmp";
16open OUT, ">Errno.tmp" or die "Cannot open Errno.tmp: $!";
eab60bb1
GS
17select OUT;
18my $file;
1e92bf58
SH
19my @files = get_files();
20if ($Config{gccversion} ne '' && $^O eq 'MSWin32') {
21 # MinGW complains "warning: #pragma system_header ignored outside include
22 # file" if the header files are processed individually, so include them
23 # all in .c file and process that instead.
24 open INCS, '>includes.c' or
25 die "Cannot open includes.c";
26 foreach $file (@files) {
eeb7067f
YST
27 next if $file eq 'errno.c';
28 next unless -f $file;
1e92bf58
SH
29 print INCS qq[#include "$file"\n];
30 }
31 close INCS;
32 process_file('includes.c');
33 unlink 'includes.c';
34}
35else {
36 foreach $file (@files) {
37 process_file($file);
38 }
eab60bb1
GS
39}
40write_errno_pm();
41unlink "errno.c" if -f "errno.c";
f5800e99
NC
42close OUT or die "Error closing Errno.tmp: $!";
43select STDOUT;
cedab142 44rename "Errno.tmp", "Errno.pm" or die "Cannot rename Errno.tmp to Errno.pm: $!";
eab60bb1
GS
45
46sub process_file {
47 my($file) = @_;
48
22402b47
YST
49 # for win32 perl under cygwin, we need to get a windows pathname
50 if ($^O eq 'MSWin32' && $Config{cc} =~ /\B-mno-cygwin\b/ &&
51 defined($file) && !-f $file) {
52 chomp($file = `cygpath -w "$file"`);
53 }
54
6683669a 55 return unless defined $file and -f $file;
27da23d5 56# warn "Processing $file\n";
eab60bb1
GS
57
58 local *FH;
59 if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
60 unless(open(FH," LIBRARY/EXTRACT=ERRNO/OUTPUT=SYS\$OUTPUT $file |")) {
61 warn "Cannot open '$file'";
62 return;
63 }
7237d657 64 } elsif ($Config{gccversion} ne ''
8ff7320b
JH
65 # OpenSTEP has gcc 2.7.2.1 which recognizes but
66 # doesn't implement the -dM flag.
8f4f83ba 67 && $^O ne 'openstep' && $^O ne 'next' && $^O ne 'darwin'
8ff7320b 68 ) {
9ae2e8df 69 # With the -dM option, gcc outputs every #define it finds
ee1e7ac2 70 unless(open(FH,"$Config{cc} -E -dM $Config{cppflags} $file |")) {
9ae2e8df
P
71 warn "Cannot open '$file'";
72 return;
73 }
eab60bb1
GS
74 } else {
75 unless(open(FH,"< $file")) {
def887e8 76 # This file could be a temporary file created by cppstdin
6ad8d9a8
GB
77 # so only warn under -w, and return
78 warn "Cannot open '$file'" if $^W;
eab60bb1
GS
79 return;
80 }
81 }
27da23d5 82
1b9043bb
NC
83 while(<FH>) {
84 $err{$1} = 1
85 if /^\s*#\s*define\s+(E\w+)\s+/;
db5fd395 86 }
27da23d5 87
db5fd395 88 close(FH);
eab60bb1
GS
89}
90
def887e8
JH
91my $cppstdin;
92
93sub default_cpp {
94 unless (defined $cppstdin) {
95 use File::Spec;
96 $cppstdin = $Config{cppstdin};
97 my $upup_cppstdin = File::Spec->catfile(File::Spec->updir,
98 File::Spec->updir,
99 "cppstdin");
100 my $cppstdin_is_wrapper =
101 ($cppstdin eq 'cppstdin'
102 and -f $upup_cppstdin
103 and -x $upup_cppstdin);
104 $cppstdin = $upup_cppstdin if $cppstdin_is_wrapper;
105 }
106 return "$cppstdin $Config{cppflags} $Config{cppminus}";
107}
108
eab60bb1
GS
109sub get_files {
110 my %file = ();
111 # VMS keeps its include files in system libraries (well, except for Gcc)
112 if ($^O eq 'VMS') {
113 if ($Config{vms_cc_type} eq 'decc') {
114 $file{'Sys$Library:DECC$RTLDEF.TLB'} = 1;
115 } elsif ($Config{vms_cc_type} eq 'vaxc') {
116 $file{'Sys$Library:vaxcdef.tlb'} = 1;
117 } elsif ($Config{vms_cc_type} eq 'gcc') {
118 $file{'gnu_cc_include:[000000]errno.h'} = 1;
119 }
9d116dd7
JH
120 } elsif ($^O eq 'os390') {
121 # OS/390 C compiler doesn't generate #file or #line directives
122 $file{'/usr/include/errno.h'} = 1;
7ee146b1
AW
123 } elsif ($Config{archname} eq 'arm-riscos') {
124 # Watch out for cross compiling for RISC OS
125 my $dep = `echo "#include <errno.h>" | gcc -E -M -`;
126 if ($dep =~ /(\S+errno\.h)/) {
127 $file{$1} = 1;
128 }
022394cf 129 } elsif ($^O eq 'linux' &&
65a03812 130 $Config{gccversion} ne '' &&
e9014798
SP
131 $Config{gccversion} !~ /intel/i
132 # might be using, say, Intel's icc
022394cf 133 ) {
98b12e44
JR
134 # When cross-compiling we may store a path for gcc's "sysroot" option:
135 my $sysroot = $Config{sysroot} || '';
9ae2e8df
P
136 # Some Linuxes have weird errno.hs which generate
137 # no #file or #line directives
d7ce6d3b 138 my ($linux_errno_h) = grep { -e $_ } map { "$_/errno.h" }
98b12e44 139 "$sysroot/usr/include", "$sysroot/usr/local/include",
d7ce6d3b
MB
140 split / / => $Config{locincpth} or
141 die "Cannot find errno.h";
a148bc21 142 $file{$linux_errno_h} = 1;
b6c36746 143 } elsif ($^O eq 'haiku') {
0d3cd356
JH
144 # hidden in a special place
145 $file{'/boot/develop/headers/posix/errno.h'} = 1;
146
196918b0
PG
147 } elsif ($^O eq 'vos') {
148 # avoid problem where cpp returns non-POSIX pathnames
149 $file{'/system/include_library/errno.h'} = 1;
27da23d5
JH
150 } elsif ($IsSymbian) {
151 my $SDK = $ENV{SDK};
152 $SDK =~ s!\\!/!g;
153 $file{"$SDK/epoc32/include/libc/sys/errno.h"} = 1;
eab60bb1
GS
154 } else {
155 open(CPPI,"> errno.c") or
156 die "Cannot open errno.c";
157
2986a63f 158 if ($^O eq 'NetWare') {
c623ac67 159 print CPPI "#include <nwerrno.h>\n";
2986a63f 160 } else {
c623ac67 161 print CPPI "#include <errno.h>\n";
27da23d5 162 if ($IsMSWin32) {
b0ba2190 163 print CPPI qq[#include "../../win32/include/sys/errno2.h"\n];
c623ac67 164 }
2986a63f 165 }
eab60bb1
GS
166
167 close(CPPI);
168
169 # invoke CPP and read the output
27da23d5 170 if ($IsMSWin32 || $^O eq 'NetWare') {
6ad8d9a8
GB
171 open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
172 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
173 } else {
def887e8 174 my $cpp = default_cpp();
6ad8d9a8
GB
175 open(CPPO,"$cpp < errno.c |") or
176 die "Cannot exec $cpp";
177 }
eab60bb1 178
378eeda7 179 my $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
eab60bb1 180 while(<CPPO>) {
27da23d5 181 if ($^O eq 'os2' or $IsMSWin32 or $^O eq 'NetWare') {
0196e43b
IZ
182 if (/$pat/o) {
183 my $f = $1;
184 $f =~ s,\\\\,/,g;
185 $file{$f} = 1;
186 }
187 }
188 else {
189 $file{$1} = 1 if /$pat/o;
190 }
eab60bb1
GS
191 }
192 close(CPPO);
193 }
194 return keys %file;
195}
196
197sub write_errno_pm {
198 my $err;
199
def887e8
JH
200 # quick sanity check
201
202 die "No error definitions found" unless keys %err;
203
eab60bb1
GS
204 # create the CPP input
205
206 open(CPPI,"> errno.c") or
207 die "Cannot open errno.c";
208
2986a63f 209 if ($^O eq 'NetWare') {
4d70086c
NIS
210 print CPPI "#include <nwerrno.h>\n";
211 }
212 else {
213 print CPPI "#include <errno.h>\n";
214 }
27da23d5 215 if ($IsMSWin32) {
b0ba2190 216 print CPPI qq[#include "../../win32/include/sys/errno2.h"\n];
4d70086c
NIS
217 }
218
eab60bb1
GS
219 foreach $err (keys %err) {
220 print CPPI '"',$err,'" [[',$err,']]',"\n";
221 }
222
223 close(CPPI);
224
b6c36746 225 { # BeOS (support now removed) did not enter this block
eab60bb1 226 # invoke CPP and read the output
dcbf900d 227
db5fd395
CN
228 if ($^O eq 'VMS') {
229 my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
230 $cpp =~ s/sys\$input//i;
231 open(CPPO,"$cpp errno.c |") or
232 die "Cannot exec $Config{cppstdin}";
27da23d5 233 } elsif ($IsMSWin32 || $^O eq 'NetWare') {
db5fd395
CN
234 open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
235 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
27da23d5
JH
236 } elsif ($IsSymbian) {
237 my $cpp = "gcc -E -I$ENV{SDK}\\epoc32\\include\\libc -";
238 open(CPPO,"$cpp < errno.c |")
239 or die "Cannot exec $cpp";
240 } else {
db5fd395
CN
241 my $cpp = default_cpp();
242 open(CPPO,"$cpp < errno.c |")
243 or die "Cannot exec $cpp";
244 }
eab60bb1 245
db5fd395 246 %err = ();
eab60bb1 247
db5fd395
CN
248 while(<CPPO>) {
249 my($name,$expr);
250 next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
251 next if $name eq $expr;
7bf14090 252 $expr =~ s/\(?\(\s*[a-z_]\w*\s*\)([^\)]*)\)?/$1/i; # ((type)0xcafebabe) at alia
f974e9b9 253 $expr =~ s/((?:0x)?[0-9a-fA-F]+)[luLU]+\b/$1/g; # 2147483647L et alia
99228ec2
MB
254 next if $expr =~ m/^[a-zA-Z]+$/; # skip some Win32 functions
255 if($expr =~ m/^0[xX]/) {
256 $err{$name} = hex $expr;
257 }
258 else {
d7ce6d3b
MB
259 $err{$name} = eval $expr;
260 }
99228ec2
MB
261 delete $err{$name} unless defined $err{$name};
262 }
db5fd395 263 close(CPPO);
eab60bb1 264 }
eab60bb1 265
928b2f01
RU
266 # escape $Config{'archname'}
267 my $archname = $Config{'archname'};
d7ce6d3b 268 $archname =~ s/([@%\$])/\\$1/g;
928b2f01 269
eab60bb1
GS
270 # Write Errno.pm
271
272 print <<"EDQ";
8f8c2a44 273# -*- buffer-read-only: t -*-
eab60bb1
GS
274#
275# This file is auto-generated. ***ANY*** changes here will be lost
276#
277
278package Errno;
8f8c2a44 279require Exporter;
eab60bb1
GS
280use Config;
281use strict;
282
8bc9d590 283"\$Config{'archname'}-\$Config{'osvers'}" eq
928b2f01
RU
284"$archname-$Config{'osvers'}" or
285 die "Errno architecture ($archname-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
eab60bb1 286
8f8c2a44 287our \$VERSION = "$VERSION";
105cd853 288\$VERSION = eval \$VERSION;
8f8c2a44 289our \@ISA = 'Exporter';
eab60bb1 290
42607a60
NC
291my %err;
292
293BEGIN {
294 %err = (
eab60bb1 295EDQ
be54382c 296
be544edc 297 my @err = sort { $err{$a} <=> $err{$b} || $a cmp $b }
be54382c 298 grep { $err{$_} =~ /-?\d+$/ } keys %err;
eab60bb1 299
42607a60
NC
300 foreach $err (@err) {
301 print "\t$err => $err{$err},\n";
302 }
eab60bb1
GS
303
304print <<'ESQ';
42607a60
NC
305 );
306 # Generate proxy constant subroutines for all the values.
5d8ab953
NC
307 # Well, almost all the values. Unfortunately we can't assume that at this
308 # point that our symbol table is empty, as code such as if the parser has
309 # seen code such as C<exists &Errno::EINVAL>, it will have created the
310 # typeglob.
42607a60
NC
311 # Doing this before defining @EXPORT_OK etc means that even if a platform is
312 # crazy enough to define EXPORT_OK as an error constant, everything will
313 # still work, because the parser will upgrade the PCS to a real typeglob.
314 # We rely on the subroutine definitions below to update the internal caches.
315 # Don't use %each, as we don't want a copy of the value.
316 foreach my $name (keys %err) {
5d8ab953
NC
317 if ($Errno::{$name}) {
318 # We expect this to be reached fairly rarely, so take an approach
319 # which uses the least compile time effort in the common case:
320 eval "sub $name() { $err{$name} }; 1" or die $@;
321 } else {
322 $Errno::{$name} = \$err{$name};
323 }
42607a60
NC
324 }
325}
326
8f8c2a44 327our @EXPORT_OK = keys %err;
42607a60 328
8f8c2a44 329our %EXPORT_TAGS = (
eab60bb1
GS
330 POSIX => [qw(
331ESQ
332
333 my $k = join(" ", grep { exists $err{$_} }
334 qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
335 EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
336 ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
337 EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
338 EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
339 EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
340 ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
341 ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
342 ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
343 EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
344 ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
345 ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
346 EUSERS EWOULDBLOCK EXDEV));
347
348 $k =~ s/(.{50,70})\s/$1\n\t/g;
349 print "\t",$k,"\n )]\n);\n\n";
350
eab60bb1 351 print <<'ESQ';
42607a60 352sub TIEHASH { bless \%err }
eab60bb1
GS
353
354sub FETCH {
42607a60
NC
355 my (undef, $errname) = @_;
356 return "" unless exists $err{$errname};
357 my $errno = $err{$errname};
358 return $errno == $! ? $errno : 0;
93014de6 359}
eab60bb1
GS
360
361sub STORE {
362 require Carp;
363 Carp::confess("ERRNO hash is read only!");
364}
365
56d853d6 366*CLEAR = *DELETE = \*STORE; # Typeglob aliasing uses less space
eab60bb1
GS
367
368sub NEXTKEY {
42607a60 369 each %err;
eab60bb1
GS
370}
371
372sub FIRSTKEY {
42607a60
NC
373 my $s = scalar keys %err; # initialize iterator
374 each %err;
eab60bb1
GS
375}
376
377sub EXISTS {
42607a60
NC
378 my (undef, $errname) = @_;
379 exists $err{$errname};
eab60bb1
GS
380}
381
42607a60 382tie %!, __PACKAGE__; # Returns an object, objects are true.
eab60bb1 383
eab60bb1
GS
384__END__
385
386=head1 NAME
387
388Errno - System errno constants
389
390=head1 SYNOPSIS
391
392 use Errno qw(EINTR EIO :POSIX);
393
394=head1 DESCRIPTION
395
396C<Errno> defines and conditionally exports all the error constants
397defined in your system C<errno.h> include file. It has a single export
398tag, C<:POSIX>, which will export all POSIX defined error numbers.
399
93014de6 400C<Errno> also makes C<%!> magic such that each element of C<%!> has a
68301627 401non-zero value only if C<$!> is set to that value. For example:
eab60bb1
GS
402
403 use Errno;
3cb6de81 404
eab60bb1
GS
405 unless (open(FH, "/fangorn/spouse")) {
406 if ($!{ENOENT}) {
407 warn "Get a wife!\n";
408 } else {
409 warn "This path is barred: $!";
410 }
411 }
412
68301627
GS
413If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
414returns C<"">. You may use C<exists $!{EFOO}> to check whether the
93014de6
GS
415constant is available on the system.
416
68301627
GS
417=head1 CAVEATS
418
419Importing a particular constant may not be very portable, because the
420import will fail on platforms that do not have that constant. A more
421portable way to set C<$!> to a valid value is to use:
422
423 if (exists &Errno::EFOO) {
424 $! = &Errno::EFOO;
425 }
426
eab60bb1
GS
427=head1 AUTHOR
428
429Graham Barr <gbarr@pobox.com>
430
431=head1 COPYRIGHT
432
433Copyright (c) 1997-8 Graham Barr. All rights reserved.
434This program is free software; you can redistribute it and/or modify it
435under the same terms as Perl itself.
436
437=cut
438
8f8c2a44 439# ex: set ro:
eab60bb1
GS
440ESQ
441
442}