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