This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Reduce Errno memory usage by around 55%.
[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";
337#
338# This file is auto-generated. ***ANY*** changes here will be lost
339#
340
341package Errno;
42607a60 342our (\@ISA,\$VERSION);
eab60bb1
GS
343use Exporter ();
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
GS
350
351\$VERSION = "$VERSION";
105cd853 352\$VERSION = eval \$VERSION;
eab60bb1
GS
353\@ISA = qw(Exporter);
354
42607a60
NC
355my %err;
356
357BEGIN {
358 %err = (
eab60bb1
GS
359EDQ
360
eab60bb1 361 my @err = sort { $err{$a} <=> $err{$b} } keys %err;
eab60bb1 362
42607a60
NC
363 foreach $err (@err) {
364 print "\t$err => $err{$err},\n";
365 }
eab60bb1
GS
366
367print <<'ESQ';
42607a60
NC
368 );
369 # Generate proxy constant subroutines for all the values.
370 # We assume at this point that our symbol table is empty.
371 # Doing this before defining @EXPORT_OK etc means that even if a platform is
372 # crazy enough to define EXPORT_OK as an error constant, everything will
373 # still work, because the parser will upgrade the PCS to a real typeglob.
374 # We rely on the subroutine definitions below to update the internal caches.
375 # Don't use %each, as we don't want a copy of the value.
376 foreach my $name (keys %err) {
377 $Errno::{$name} = \$err{$name};
378 }
379}
380
381our (@EXPORT_OK, %EXPORT_TAGS);
382
383@EXPORT_OK = keys %err;
384
eab60bb1
GS
385%EXPORT_TAGS = (
386 POSIX => [qw(
387ESQ
388
389 my $k = join(" ", grep { exists $err{$_} }
390 qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
391 EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
392 ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
393 EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
394 EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
395 EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
396 ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
397 ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
398 ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
399 EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
400 ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
401 ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
402 EUSERS EWOULDBLOCK EXDEV));
403
404 $k =~ s/(.{50,70})\s/$1\n\t/g;
405 print "\t",$k,"\n )]\n);\n\n";
406
eab60bb1 407 print <<'ESQ';
42607a60 408sub TIEHASH { bless \%err }
eab60bb1
GS
409
410sub FETCH {
42607a60
NC
411 my (undef, $errname) = @_;
412 return "" unless exists $err{$errname};
413 my $errno = $err{$errname};
414 return $errno == $! ? $errno : 0;
93014de6 415}
eab60bb1
GS
416
417sub STORE {
418 require Carp;
419 Carp::confess("ERRNO hash is read only!");
420}
421
422*CLEAR = \&STORE;
423*DELETE = \&STORE;
424
425sub NEXTKEY {
42607a60 426 each %err;
eab60bb1
GS
427}
428
429sub FIRSTKEY {
42607a60
NC
430 my $s = scalar keys %err; # initialize iterator
431 each %err;
eab60bb1
GS
432}
433
434sub EXISTS {
42607a60
NC
435 my (undef, $errname) = @_;
436 exists $err{$errname};
eab60bb1
GS
437}
438
42607a60 439tie %!, __PACKAGE__; # Returns an object, objects are true.
eab60bb1 440
eab60bb1
GS
441__END__
442
443=head1 NAME
444
445Errno - System errno constants
446
447=head1 SYNOPSIS
448
449 use Errno qw(EINTR EIO :POSIX);
450
451=head1 DESCRIPTION
452
453C<Errno> defines and conditionally exports all the error constants
454defined in your system C<errno.h> include file. It has a single export
455tag, C<:POSIX>, which will export all POSIX defined error numbers.
456
93014de6 457C<Errno> also makes C<%!> magic such that each element of C<%!> has a
68301627 458non-zero value only if C<$!> is set to that value. For example:
eab60bb1
GS
459
460 use Errno;
3cb6de81 461
eab60bb1
GS
462 unless (open(FH, "/fangorn/spouse")) {
463 if ($!{ENOENT}) {
464 warn "Get a wife!\n";
465 } else {
466 warn "This path is barred: $!";
467 }
468 }
469
68301627
GS
470If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
471returns C<"">. You may use C<exists $!{EFOO}> to check whether the
93014de6
GS
472constant is available on the system.
473
68301627
GS
474=head1 CAVEATS
475
476Importing a particular constant may not be very portable, because the
477import will fail on platforms that do not have that constant. A more
478portable way to set C<$!> to a valid value is to use:
479
480 if (exists &Errno::EFOO) {
481 $! = &Errno::EFOO;
482 }
483
eab60bb1
GS
484=head1 AUTHOR
485
486Graham Barr <gbarr@pobox.com>
487
488=head1 COPYRIGHT
489
490Copyright (c) 1997-8 Graham Barr. All rights reserved.
491This program is free software; you can redistribute it and/or modify it
492under the same terms as Perl itself.
493
494=cut
495
496ESQ
497
498}