case '!':
if(len > 1)
break;
- if(sv_type == SVt_PVHV) {
+ if(sv_type > SVt_PV) {
HV* stash = gv_stashpvn("Errno",5,FALSE);
if(!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
dSP;
SPAGAIN;
stash = gv_stashpvn("Errno",5,FALSE);
if (!stash || !(gv_fetchmethod(stash, "TIEHASH")))
- croak("%! is not avaliable on this machine");
+ croak("Can't use %%! because Errno.pm is not avaliable");
}
}
goto magicalize;
# Error status.
*CHILD_ERROR = *? ;
- *OS_ERROR = *! ;
- *ERRNO = *! ;
+ *OS_ERROR = \$! ;
+ *ERRNO = \$! ;
*EXTENDED_OS_ERROR = *^E ;
*EVAL_ERROR = *@ ;
#endif
init_predump_symbols();
+ /* init_postdump_symbols not currently designed to be called */
+ /* more than once (ENV isn't cleared first, for example) */
+ /* But running with -u leaves %ENV & @ARGV undefined! XXX */
if (!do_undump)
init_postdump_symbols(argc,argv,env);
=item sleep
Causes the script to sleep for EXPR seconds, or forever if no EXPR.
-May be interrupted by sending the process a SIGALRM. Returns the
-number of seconds actually slept. You probably cannot mix alarm() and
-sleep() calls, because sleep() is often implemented using alarm().
+May be interrupted if the process receives a signal such as SIGALRM.
+Returns the number of seconds actually slept. You probably cannot
+mix alarm() and sleep() calls, because sleep() is often implemented
+using alarm().
On some older systems, it may sleep up to a full second less than what
you requested, depending on how it counts seconds. Most modern systems
less than, equal to, or greater than 0, depending on how the elements
of the array are to be ordered. (The C<E<lt>=E<gt>> and C<cmp>
operators are extremely useful in such routines.) SUBNAME may be a
-scalar variable name, in which case the value provides the name of the
-subroutine to use. In place of a SUBNAME, you can provide a BLOCK as
-an anonymous, in-line sort subroutine.
+scalar variable name (unsubscripted), in which case the value provides
+the name of (or a reference to) the actual subroutine to use. In place
+of a SUBNAME, you can provide a BLOCK as an anonymous, in-line sort
+subroutine.
In the interests of efficiency the normal calling code for subroutines is
bypassed, with the following effects: the subroutine may not be a
# forked, so the errno value is not visible in the parent.
printf "command failed: %s\n", ($! || "Unknown system() error");
}
- elsif ($rc > 0x80) {
+ elsif (($rc & 0xff) == 0) {
$rc >>= 8;
print "ran with non-zero exit status $rc\n";
}
}
$| = 1;
-print "1..10\n";
+print "1..12\n";
open(PIPE, "|-") || (exec 'tr', 'YX', 'ko');
print PIPE "Xk 1\n";
s/^not //;
print;
}
+ close PIPE; # avoid zombies which disrupt test 12
}
else {
print STDOUT "not ok 3\n";
y/A-Z/a-z/;
print;
}
+ close READER; # avoid zombies which disrupt test 12
}
else {
die "Couldn't fork" unless defined $pid;
print "ok 8\n";
# VMS doesn't like spawning subprocesses that are still connected to
-# STDOUT. Someone should modify tests #9 and #10 to work with VMS.
+# STDOUT. Someone should modify tests #9 to #12 to work with VMS.
if ($^O eq 'VMS') {
print "ok 9\n";
print "ok 10\n";
+ print "ok 11\n";
+ print "ok 12\n";
exit;
}
else {
print "ok 10\n";
}
+
+# check that status for the correct process is collected
+my $zombie = fork or exit 37;
+my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n";
+$SIG{ALRM} = sub { return };
+alarm(1);
+my $close = close FH;
+if ($? == 13*256 && ! length $close && ! $!) {
+ print "ok 11\n";
+} else {
+ print "not ok 11\n# close $close\$?=$? \$!=", $!+0, ":$!\n";
+};
+my $wait = wait;
+if ($? == 37*256 && $wait == $zombie && ! $!) {
+ print "ok 12\n";
+} else {
+ print "not ok 12\n# pid=$wait \$?=$? \$!=", $!+0, ":$!\n";
+}
if ($^O eq 'MSWin32') {
print "# exec is unsupported on Win32\n";
+ # XXX the system tests could be written to use ./perl and so work on Win32
print "1..0\n";
exit(0);
}
print "not ok 2\n" if system "echo ok 2"; # split and directly called
print "not ok 3\n" if system "echo", "ok", "3"; # directly called
+# these should probably be rewritten to match the examples in perlfunc.pod
if (system "true") {print "not ok 4\n";} else {print "ok 4\n";}
if ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; }
print "1..0\n";
exit;
}
+
+ use strict;
+
my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth}));
my %done = ();
my %define = ();
sub process_file {
- my($file) = @_;
+ my($file,$level) = @_;
return unless defined $file;
return if exists $done{$path};
$done{$path} = 1;
- unless(defined $path) {
+ if(not defined $path and $level == 0) {
warn "Cannot find '$file'";
return;
}
+ local(*F);
open(F,$path) or return;
+ $level = 1 unless defined $level;
+ my $indent = " " x $level;
+ print "#$indent open $path\n";
while(<F>) {
s#/\*.*(\*/|$)##;
- process_file($mm,$1)
- if /^#\s*include\s*[<"]([^>"]+)[>"]/;
+ if ( /^#\s*include\s*[<"]([^>"]+)[>"]/ ) {
+ print "#${indent} include $1\n";
+ process_file($1,$level+1);
+ print "#${indent} done include $1\n";
+ print "#${indent} back in $path\n";
+ }
s/(?:\([^)]*\)\s*)//;
- $define{$1} = $2
- if /^#\s*define\s+(\w+)\s+((0x)?\d+|\w+)/;
+ if ( /^#\s*define\s+(\w+)\s+(\w+)/ ) {
+ print "#${indent} define $1 $2\n";
+ $define{$1} = $2;
+ }
}
close(F);
+ print "#$indent close $path\n";
}
process_file("sys/sem.h");
process_file("sys/ipc.h");
process_file("sys/stat.h");
- foreach $d (@define) {
+ foreach my $d (@define) {
while(defined($define{$d}) && $define{$d} !~ /^(0x)?\d+$/) {
$define{$d} = exists $define{$define{$d}}
? $define{$define{$d}} : undef;
}
unless(defined $define{$d}) {
- print "0..0\n";
+ print "# $d undefined\n";
+ print "1..0\n";
exit;
- };
- ${ $d } = eval $define{$d};
+ }
+ {
+ no strict 'refs';
+ ${ $d } = eval $define{$d};
+ }
}
}
int status;
SV **svp;
int pid;
+ int pid2;
bool close_failed;
int saved_errno;
#ifdef VMS
rsignal_save(SIGINT, SIG_IGN, &istat);
rsignal_save(SIGQUIT, SIG_IGN, &qstat);
do {
- pid = wait4pid(pid, &status, 0);
- } while (pid == -1 && errno == EINTR);
+ pid2 = wait4pid(pid, &status, 0);
+ } while (pid2 == -1 && errno == EINTR);
rsignal_restore(SIGHUP, &hstat);
rsignal_restore(SIGINT, &istat);
rsignal_restore(SIGQUIT, &qstat);
SETERRNO(saved_errno, saved_vaxc_errno);
return -1;
}
- return(pid < 0 ? pid : status == 0 ? 0 : (errno = 0, status));
+ return(pid2 < 0 ? pid2 : status == 0 ? 0 : (errno = 0, status));
}
#endif /* !DOSISH */
use File::Path qw(mkpath);
use Getopt::Std;
-getopts('Dd:rlh');
+getopts('Dd:rlha');
+die "-r and -a options are mutually exclusive\n" if ($opt_r and $opt_a);
+@inc_dirs = inc_dirs() if $opt_a;
my $Exit = 0;
$dir = $1;
mkpath "$Dest_dir/$dir";
}
+
+ if ($opt_a) { # automagic mode: locate header file in @inc_dirs
+ foreach (@inc_dirs) {
+ chdir $_;
+ last if -f $file;
+ }
+ }
+
open(IN,"$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next);
open(OUT,">$Dest_dir/$outfile") || die "Can't create $outfile: $!\n";
}
}
}
print OUT "1;\n";
+
+ $is_converted{$file} = 1;
+ queue_includes_from($file) if ($opt_a);
}
exit $Exit;
} else {
print STDERR "Skipping directory `$file'\n";
}
- } else {
+ } elsif ($opt_a) {
+ return $file;
+ } else {
print STDERR "Skipping `$file': not a file or directory\n";
}
}
# expand_glob() is going to be called until $ARGV[0] isn't a
# directory; so push directories, and unshift everything else.
- if (-d "$directory/$_") {
- push @ARGV, "$directory/$_";
- } else {
- unshift @ARGV, "$directory/$_";
- }
+ if (-d "$directory/$_") { push @ARGV, "$directory/$_" }
+ else { unshift @ARGV, "$directory/$_" }
}
closedir DIR;
}
unlink "$Dest_dir/$dirlink" or
print STDERR "Could not remove link $Dest_dir/$dirlink: $!\n";
}
+
if (eval 'symlink($target, "$Dest_dir/$dirlink")') {
print "Linking $target -> $Dest_dir/$dirlink\n";
# Make sure that the link _links_ to something:
if (! -e "$Dest_dir/$target") {
- mkdir("$Dest_dir/$target", 0755) or
+ mkpath("$Dest_dir/$target", 0755) or
print STDERR "Could not create $Dest_dir/$target/\n";
}
} else {
}
+# Push all #included files in $file onto our stack, except for STDIN
+# and files we've already processed.
+sub queue_includes_from
+{
+ my ($file) = @_;
+ my $line;
+
+ return if ($file eq "-");
+
+ open HEADER, $file or return;
+ while (defined($line = <HEADER>)) {
+ while (/\\$/) { # Handle continuation lines
+ chop $line;
+ $line .= <HEADER>;
+ }
+
+ if ($line =~ /^#\s*include\s+<(.*?)>/) {
+ push(@ARGV, $1) unless $is_converted{$1};
+ }
+ }
+ close HEADER;
+}
+
+
+# Determine include directories; $Config{usrinc} should be enough for (all
+# non-GCC?) C compilers, but gcc uses an additional include directory.
+sub inc_dirs
+{
+ my $from_gcc = `$Config{cc} -v 2>&1`;
+ $from_gcc =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s;
+
+ length($from_gcc) ? ($from_gcc, $Config{usrinc}) : ($Config{usrinc});
+}
+
+
1;
##############################################################################
=head1 SYNOPSIS
-B<h2ph [-d destination directory] [-r] [-l] [headerfiles]>
+B<h2ph [-d destination directory] [-r | -a] [-l] [headerfiles]>
=head1 DESCRIPTION
=item -r
Run recursively; if any of B<headerfiles> are directories, then run I<h2ph>
-on all files in those directories (and their subdirectories, etc.).
+on all files in those directories (and their subdirectories, etc.). B<-r>
+and B<-a> are mutually exclusive.
+
+=item -a
+
+Run automagically; convert B<headerfiles>, as well as any B<.h> files
+which they include. This option will search for B<.h> files in all
+directories which your C compiler ordinarily uses. B<-a> and B<-r> are
+mutually exclusive.
=item -l
However, the B<.ph> files almost double in size when built using B<-h>.
+=item -D
+
+Include the code from the B<.h> file as a comment in the B<.ph> file.
+This is primarily used for debugging I<h2ph>.
+
=back
=head1 ENVIRONMENT
my \$constname;
(\$constname = \$AUTOLOAD) =~ s/.*:://;
+ croak "&$module::constant not defined" if \$constname eq 'constant';
my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
if (\$! != 0) {
if (\$! =~ /Invalid/) {
croak "Your vendor has not defined $module macro \$constname";
}
}
- eval "sub \$AUTOLOAD { \$val }";
+ *\$AUTOLOAD = sub () { \$val };
goto &\$AUTOLOAD;
}
projects / platform / upstream / perl.git / commitdiff