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