trigraphs and tests for h2xs

Message-ID: <Pine.BSF.4.21.0106212354510.6026-100000@shell8.ba.best.com>

p4raw-id: //depot/perl@10820

diff --git a/MANIFEST b/MANIFEST
index 1bc75f7d8dbe1e33228e8dbb447690b71306659d..6e1805fd4ed33c9ba6404c47d179dcc353553013 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -908,6 +908,7 @@ lib/Getopt/Std.pm           Fetch command options (getopt, getopts)
 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/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
 lib/I18N/Collate.t             See if I18N::Collate works

diff --git a/lib/h2xs.t b/lib/h2xs.t
new file mode 100644 (file)
index 0000000..d4c03d9
--- /dev/null
+++ b/lib/h2xs.t
@@ -0,0 +1,117 @@
+#!./perl
+
+# Some quick tests to see if h2xs actually runs and creates files as 
+# expected.  File contents include date stamps and/or usernames
+# hence are not checked.  File existence is checked with -e though.
+# This test depends on File::Path::rmtree() to clean up with.
+#  - pvhp
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+use File::Path;  # for cleaning up with rmtree()
+
+my $extracted_program = '../utils/h2xs'; # unix, nt, ...
+if ($^O eq 'VMS') { $extracted_program = '[-.utils]h2xs.com'; }
+if ($^O eq 'MacOS') { $extracted_program = ':::utils:h2xs'; }
+if (!(-e $extracted_program)) {
+    print "1..0 # Skip: $extracted_program was not built\n";
+    exit 0;
+}
+# You might also wish to bail out if your perl platform does not
+# do `$^X -e 'warn "Writing h2xst"' 2>&1`; duplicity.
+
+my $dupe = '2>&1'; # ok on unix, nt, VMS, ...
+my $lib = '"-I../lib"'; # ok on unix, nt, The extra \" are for VMS
+# The >&1 would create a file named &1 on MPW (STDERR && STDOUT are
+# already merged).
+if ($^O eq 'MacOS') {
+    $dupe = '';
+    $lib = '-I::lib:';
+}
+# $name should differ from system header file names and must
+# not already be found in the t/ subdirectory for perl.
+my $name = 'h2xst';
+
+print "1..17\n";
+
+my @result = ();
+my $result = '';
+my $expectation = '';
+
+# h2xs warns about what it is writing hence the (possibly unportable)
+# 2>&1 dupe:
+# does it run?
+@result = `$^X $lib $extracted_program -f -n $name $dupe`;
+print(((!$?) ? "" : "not "), "ok 1\n");
+$result = join("",@result);
+
+$expectation = <<"EOXSFILES";
+Writing $name/$name.pm
+Writing $name/$name.xs
+Writing $name/Makefile.PL
+Writing $name/README
+Writing $name/t/1.t
+Writing $name/Changes
+Writing $name/MANIFEST
+EOXSFILES
+
+# accomodate MPW # comment character prependage
+if ($^O eq 'MacOS') {
+    $result =~ s/#\s*//gs;
+}
+
+#print "# expectation is >$expectation<\n";
+#print "# result is >$result<\n";
+# Was the output the list of files that were expected?
+print((($result eq $expectation) ? "" : "not "), "ok 2\n");
+# Were the files created?
+my $t = 3;
+$expectation =~ s/Writing //; # remove leader
+foreach (split(/Writing /,$expectation)) {
+    chomp;  # remove \n
+    if ($^O eq 'MacOS') { $_ = ':' . join(':',split(/\//,$_)); }
+    print(((-e $_) ? "" : "not "), "ok $t\n");
+    $t++;
+}
+
+# clean up
+rmtree($name);
+
+# does it run with -X and omit the h2xst.xs file?
+@result = ();
+$result = '';
+# The extra \" around -X are for VMS but do no harm on NT or Unix
+@result = `$^X $lib $extracted_program \"-X\" -f -n $name $dupe`;
+print(((!$?) ? "" : "not "), "ok $t\n");
+$t++;
+$result = join("",@result);
+
+$expectation = <<"EONOXSFILES";
+Writing $name/$name.pm
+Writing $name/Makefile.PL
+Writing $name/README
+Writing $name/t/1.t
+Writing $name/Changes
+Writing $name/MANIFEST
+EONOXSFILES
+
+if ($^O eq 'MacOS') { $result =~ s/#\s*//gs; }
+#print $expectation;
+#print $result;
+print((($result eq $expectation) ? "" : "not "), "ok $t\n");
+$t++;
+$expectation =~ s/Writing //; # remove leader
+foreach (split(/Writing /,$expectation)) {
+    chomp;  # remove \n
+    if ($^O eq 'MacOS') { $_ = ':' . join(':',split(/\//,$_)); }
+    print(((-e $_) ? "" : "not "), "ok $t\n");
+    $t++;
+}
+
+# clean up
+rmtree($name);
+

diff --git a/utils/h2xs.PL b/utils/h2xs.PL
index ef31a2e8a9ec1a294684616776b170d711c957d6..6bf4be97a2f3c30064514b76572ea2b44ab7e5eb 100644 (file)
--- a/utils/h2xs.PL
+++ b/utils/h2xs.PL
@@ -553,6 +553,7 @@ if( @path_h ){
     use Config;
     use File::Spec;
     my @paths;
+    my $pre_sub_tri_graphs = 1;
     if ($^O eq 'VMS') {  # Consider overrides of default location
       # XXXX This is not equivalent to what the older version did:
       #                it was looking at $hadsys header-file per header-file...
@@ -616,6 +617,19 @@ if( @path_h ){
       open(CH, "<$rel_path_h") || die "Can't open $rel_path_h: $!\n";
     defines:
       while (<CH>) {
+       if ($pre_sub_tri_graphs) {
+           # Preprocess all tri-graphs 
+           # including things stuck in quoted string constants.
+           s/\?\?=/#/g;                         # | ??=|  #|
+           s/\?\?\!/|/g;                        # | ??!|  ||
+           s/\?\?'/^/g;                         # | ??'|  ^|
+           s/\?\?\(/[/g;                        # | ??(|  [|
+           s/\?\?\)/]/g;                        # | ??)|  ]|
+           s/\?\?\-/~/g;                        # | ??-|  ~|
+           s/\?\?\//\\/g;                       # | ??/|  \|
+           s/\?\?</{/g;                         # | ??<|  {|
+           s/\?\?>/}/g;                         # | ??>|  }|
+       }
        if (/^[ \t]*#[ \t]*define\s+([\$\w]+)\b(?!\()\s*(?=[^" \t])(.*)/) {
            my $def = $1;
            my $rest = $2;