Front page | perl.perl5.porters |
Postings from July 2001
[PATCH] h2ph, etc.
Thread Next
From:
Kurt D. Starsinic
Date:
July 25, 2001 23:30
Subject:
[PATCH] h2ph, etc.
Message ID:
20010725233005.A15461@wolfetech.com
Hello,
The following patch:
Adds a test, h2ph_thorough, that compares constants available in
POSIX.pm and Socket.pm to their equivalents as generated by h2ph.
Reveals many bugs in h2ph.
Reveals a bug in Scalar::Util: if you create a Scalar::Util::dualvar
from an SV that has a UV but no IV, then the numeric values get
clobbered by the PV. Fixes said bug. I'm not a big internals guy,
so I would appreciate extra scrutiny on this one.
Fixes many bugs in h2ph, and adds a very cool feature: now
C constants like:
#define INADDR_LOOPBACK 0x7f000001
can be interpreted as 2130706433 when used as a number, and as
the bytes 7f 00 00 01 when used as a string. This unbreaks a
lot of h2ph bloopers.
I expect the Average Platform to get three failures on the test.
These are old bugs; we just didn't have tests for them before. I'm
working on fixing them.
- Kurt
--- MANIFEST.Orig Tue Jul 24 19:42:35 2001
+++ MANIFEST Tue Jul 24 19:43:11 2001
@@ -930,6 +930,7 @@
lib/Getopt/Std.t See if Getopt::Std and Getopt::Long work
lib/getopts.pl Perl library supporting option parsing
lib/h2ph.t See if h2ph works like it should
+lib/h2ph_thorough.t Really hammer h2ph
lib/h2xs.t See if h2xs produces expected lists of files
lib/hostname.pl Old hostname code
lib/I18N/Collate.pm Routines to do strxfrm-based collation
--- /dev/null Thu Jul 26 05:37:06 2001
+++ t/lib/h2ph_thorough.t Thu Jul 26 05:35:55 2001
@@ -0,0 +1,219 @@
+#!./perl
+
+my $Tmp;
+BEGIN {
+ chdir '..' if -d '../pod' && -d '../t';
+ @INC = 'lib';
+ require Cwd;
+ $Tmp = Cwd::cwd() . "/t/tmp";
+ -e $Tmp or mkdir $Tmp, 0777;
+ push @INC, $Tmp;
+}
+
+use strict;
+use warnings;
+
+
+if (@ARGV and $ARGV[0] eq '-q') {
+ shift @ARGV;
+ open OK, '>/dev/null'; # XXX What's the portable way?
+} else {
+ open OK, '>-';
+}
+
+my %Todo = map { $_ => 1 } @ARGV;
+
+my (@tests, $current);
+
+
+while (<DATA>) {
+ next if /^\s*(?:#.*)?$/;
+ chomp;
+
+ push @tests, ($current = []) if /^\w/;
+ push @$current, split;
+}
+
+# STDERR will catch error output from utils/h2ph invocations (below):
+open STDERR, ">$Tmp/h2ph.out";
+
+my ($i, $total) = (1, 0);
+while (@tests) {
+ my ($p1, $p2, @symbols) = @{ shift @tests };
+ my $n = scalar @symbols;
+ $total += $n;
+
+ print STDERR "# Generating $p2.ph\n";
+ system
+ './perl', '-Ilib', 'utils/h2ph',
+ '-Q', # No diagnostics
+ '-D', # Emit debugging code
+ '-h', # Emit line number hints
+ '-a', # Automagically build included files
+ '-n', # Do the least possible real work
+ '-d', "$Tmp", "$p2.h"; # File names and locations
+ print STDERR "# Generated $p2.ph\n";
+
+ { require "$p1.pm"; delete $::{h2ph}; package h2ph; require "$p2.ph" }
+
+ foreach (@symbols) {
+ next if %Todo && !defined $Todo{$_};
+
+ no warnings;
+
+ my $r1 = eval "$p1\::$_()";
+ my $r2 = eval "h2ph::$_()";
+ my $pr2 = defined $r2 ? $r2 : '<< undef >>';
+ my $pn2 = defined $r2 ? $r2 + 0 : 0;
+
+ if (!defined $r1) { print OK "ok $i\t# skip $_\n" }
+ elsif (differ($r1, $r2)) { print "nok $i\t# $_: `$r1' <=> `$pr2 ($pn2)'\n" }
+ else { print OK "ok $i\t# $_\n" }
+
+ $i++;
+ }
+}
+
+$total++;
+
+close STDERR;
+open T, "$Tmp/h2ph.out";
+chomp(my (@T) = (<T>));
+close T;
+
+my @Complained;
+while (@T > 1) {
+ if ($T[0] =~ /^# Generating (.*)/
+ and $T[1] !~ /^# Generat/) {
+ push @Complained, $1;
+ shift @T;
+ }
+
+ shift @T;
+}
+
+if (@Complained) { print "nok $i\t# h2ph noise in @Complained\n" }
+else { print "ok $i\n" }
+
+print "1..$total\n";
+
+
+sub differ
+{
+ no warnings; # Comparing weird things weirdly:
+
+ return 0 if scalar(@_) == 0;
+ return 1 if scalar(@_) < 2;
+
+ return defined $_[1] if not defined $_[0];
+ return 1 if not defined $_[1];
+
+ return 0 if $_[0] != 0 or $_[0] eq '0' and $_[0] == $_[1];
+
+ return $_[0] ne $_[1];
+}
+
+
+__DATA__
+
+#Socket sys/types INADDR_ANY
+Socket netinet/in INADDR_ANY
+
+Socket sys/socket
+ AF_INET AF_UNIX
+ PF_INET PF_UNIX
+ SOCK_DGRAM SOCK_STREAM
+ INADDR_LOOPBACK INADDR_ANY INADDR_BROADCAST INADDR_NONE
+
+POSIX sys/termios
+ B38400 B75 B200 B134 B300 B1800 B150 B0 B19200 B1200 B9600 B600 B4800 B50
+ B2400 B110
+
+ TCSADRAIN TCSANOW TCOON TCIOFLUSH TCOFLUSH TCION TCIFLUSH TCSAFLUSH TCIOFF
+ TCOOFF
+
+ VEOF VEOL VERASE VINTR VKILL VQUIT VSUSP VSTART VSTOP VMIN VTIME NCCS
+
+ CLOCAL CREAD CSIZE CS5 CS6 CS7 CS8 CSTOPB HUPCL PARENB PARODD
+
+ BRKINT ICRNL IGNBRK IGNCR IGNPAR INLCR INPCK ISTRIP IXOFF IXON PARMRK
+
+ ECHO ECHOE ECHOK ECHONL ICANON IEXTEN ISIG NOFLSH TOSTOP
+
+ OPOST
+
+POSIX unistd
+ _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON _PC_MAX_INPUT _PC_NAME_MAX
+ _PC_NO_TRUNC _PC_PATH_MAX _PC_PIPE_BUF _PC_VDISABLE
+
+ _SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL _SC_NGROUPS_MAX
+ _SC_OPEN_MAX _SC_SAVED_IDS _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION
+
+ R_OK SEEK_CUR SEEK_END SEEK_SET STDIN_FILENO STDOUT_FILENO STDERR_FILENO
+ W_OK X_OK
+
+POSIX limits
+ ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX INT_MAX INT_MIN LINK_MAX
+ LONG_MAX LONG_MIN MAX_CANON MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX
+ OPEN_MAX PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN SSIZE_MAX
+ STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX ULONG_MAX USHRT_MAX
+
+ _POSIX_ARG_MAX _POSIX_CHILD_MAX _POSIX_CHOWN_RESTRICTED _POSIX_JOB_CONTROL
+ _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT _POSIX_NAME_MAX
+ _POSIX_NGROUPS_MAX _POSIX_NO_TRUNC _POSIX_OPEN_MAX _POSIX_PATH_MAX
+ _POSIX_PIPE_BUF
+ #_POSIX_SAVED_IDS # Broken on (at least) FreeBSD 4.3
+ _POSIX_SSIZE_MAX _POSIX_STREAM_MAX
+ _POSIX_TZNAME_MAX _POSIX_VDISABLE _POSIX_VERSION
+
+POSIX errno
+ E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT EAGAIN EALREADY EBADF
+ EBUSY ECHILD ECONNABORTED ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM
+ EDQUOT EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS EINTR EINVAL
+ EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE ENAMETOOLONG ENETDOWN
+ ENETRESET ENETUNREACH ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
+ ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR ENOTEMPTY ENOTSOCK
+ ENOTTY ENXIO EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT
+ EPROTOTYPE ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT ESPIPE
+ ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY EUSERS EWOULDBLOCK EXDEV
+
+POSIX fcntl
+ FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_OK F_RDLCK F_SETFD F_SETFL
+ F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY
+ O_NONBLOCK O_RDONLY O_RDWR O_TRUNC O_WRONLY
+
+POSIX float
+ DBL_DIG DBL_EPSILON DBL_MANT_DIG DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP
+ DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP FLT_DIG FLT_EPSILON FLT_MANT_DIG
+ FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP
+ FLT_RADIX FLT_ROUNDS LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG LDBL_MAX
+ LDBL_MAX_10_EXP LDBL_MAX_EXP LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP
+
+POSIX locale
+ LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC LC_TIME
+
+POSIX math
+ HUGE_VAL
+
+POSIX signal
+ SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK SA_RESETHAND SA_RESTART
+ SA_SIGINFO SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT
+ SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU
+ SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK
+
+POSIX sys/stat
+ S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID S_IWGRP
+ S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR
+
+POSIX stdlib
+ EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX RAND_MAX
+
+POSIX stdio
+ BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid L_tmpname TMP_MAX
+
+POSIX time
+ CLK_TCK CLOCKS_PER_SEC
+
+POSIX sys/wait
+ WNOHANG WUNTRACED
+
--- ext/List/Util/Util.xs.Orig Wed Jul 25 20:12:00 2001
+++ ext/List/Util/Util.xs Thu Jul 26 02:59:20 2001
@@ -235,18 +235,18 @@
CODE:
{
STRLEN len;
+ U32 flags;
char *ptr = SvPV(str,len);
- ST(0) = sv_newmortal();
- (void)SvUPGRADE(ST(0),SVt_PVNV);
+ /* ST(0) = sv_newmortal(); */
+ ST(0) = newSVsv(num);
+ (void)SvUPGRADE(ST(0),SVt_PVIV);
+ flags = SvFLAGS(ST(0));
+
sv_setpvn(ST(0),ptr,len);
- if(SvNOKp(num) || !SvIOKp(num)) {
- SvNVX(ST(0)) = SvNV(num);
- SvNOK_on(ST(0));
- }
- else {
- SvIVX(ST(0)) = SvIV(num);
- SvIOK_on(ST(0));
- }
+ SvFLAGS(ST(0)) = flags;
+ SvPOK_on(ST(0));
+ /* SvPVX(ST(0)) = SvPV(str, len); */
+ /* SvPV_set(ST(0), SvPVX(str)); */
if(PL_tainting && (SvTAINTED(num) || SvTAINTED(str)))
SvTAINTED_on(ST(0));
XSRETURN(1);
--- utils/h2ph.PL.Orig Wed Jul 25 05:21:05 2001
+++ utils/h2ph.PL Thu Jul 26 05:33:38 2001
@@ -42,8 +42,8 @@
use File::Path qw(mkpath);
use Getopt::Std;
-getopts('Dd:rlhaQ');
-use vars qw($opt_D $opt_d $opt_r $opt_l $opt_h $opt_a $opt_Q);
+getopts('Dd:rlhaQn');
+use vars qw($opt_D $opt_d $opt_r $opt_l $opt_h $opt_a $opt_Q $opt_n);
die "-r and -a options are mutually exclusive\n" if ($opt_r and $opt_a);
my @inc_dirs = inc_dirs() if $opt_a;
@@ -104,6 +104,7 @@
}
open(IN,"$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next);
+ next if -e "$Dest_dir/$outfile" and $opt_n;
open(OUT,">$Dest_dir/$outfile") || die "Can't create $outfile: $!\n";
}
@@ -148,7 +149,8 @@
} else {
s/^\s+//;
expr();
- $new = 1 if $new eq '';
+ $new = 0 if $new eq '';
+ $new = _dualvar($new);
$new = reindent($new);
$args = reindent($args);
if ($t ne '') {
@@ -245,7 +247,6 @@
# drop "#define FOO FOO" in enums
$next =~ s/^\s*#\s*define\s+(\w+)\s+\1\s*$//;
$_ .= $next;
- print OUT "# $next\n" if $opt_D;
}
s/#\s*if.*?#\s*endif//g; # drop #ifdefs
s@/\*.*?\*/@@g;
@@ -342,6 +343,10 @@
}
s/\([\w\s]+[\*\s]*\)// && next; # then eliminate them.
};
+
+ # If we have something like (foo bar **), then it's a typecast . . .
+ s/\([\w\s]+\*[\*\s]*\)// && next; # . . . so throw it awaw.
+
# struct/union member, including arrays:
s/^([_A-Z]\w*(\[[^\]]+\])?((\.|->)[_A-Z]\w*(\[[^\]]+\])?)+)//i && do {
my $id = $1;
@@ -458,6 +463,8 @@
last READ;
}
+ print OUT "# $out\n" if $opt_D;
+
return $out;
}
@@ -585,7 +592,7 @@
sub build_preamble_if_necessary
{
# Increment $VERSION every time this function is modified:
- my $VERSION = 2;
+ my $VERSION = 3;
my $preamble = "$Dest_dir/_h2ph_pre.ph";
# Can we skip building the preamble file?
@@ -604,6 +611,7 @@
open PREAMBLE, ">$preamble" or die "Cannot open $preamble: $!";
print PREAMBLE "# This file was created by h2ph version $VERSION\n";
+ print PREAMBLE "require Scalar::Util;\n\n";
foreach (sort keys %define) {
if ($opt_D) {
@@ -626,6 +634,22 @@
}
+sub _dualvar
+{
+ # Only do hand-waving over numbers that might represent bit patterns:
+ my ($value) = @_; return $value if $value !~ /^-?\d/;
+
+ # TODO: Detect size of constants; pack 'N' won't *always* work.
+ my $num = eval $value;
+ my $bits = pack 'N', $num;
+ my (@bytes) = ($bits =~ /(.)/gs);
+ my $length = scalar @bytes;
+ my $string = join '', map { sprintf "\\%03o", ord($_) } @bytes;
+
+ return "Scalar::Util::dualvar($num, \"$string\")";
+}
+
+
# %Config contains information on macros that are pre-defined by the
# system's compiler. We need this information to make the .ph files
# function with perl as the .h files do with cc.
@@ -639,7 +663,7 @@
foreach (split /\s+/, $allsymbols) {
/(.+?)=(.+)/ and $define{$1} = $2;
- if ($opt_D) {
+ if ($opt_D and not $opt_Q) {
print STDERR "$_: $1 -> $2\n";
}
}
@@ -659,7 +683,7 @@
=head1 SYNOPSIS
-B<h2ph [-d destination directory] [-r | -a] [-l] [headerfiles]>
+B<h2ph [-d destination directory] [-r | -a] [-lhDQf] [headerfiles]>
=head1 DESCRIPTION
@@ -730,6 +754,11 @@
``Quiet'' mode; don't print out the names of the files being converted.
+=item -n
+
+Don't rebuild .ph files that already exist (except for _h2ph_pre.ph, which
+is rebuilt whenever it should be).
+
=back
=head1 ENVIRONMENT
@@ -781,6 +810,8 @@
Doesn't necessarily locate all of your C compiler's internally-defined
symbols.
+
+You must specify an absolute path to the -d option.
=cut
Thread Next
-
[PATCH] h2ph, etc.
by Kurt D. Starsinic