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