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