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