From: Prymmer/Kahn <pvhp@best.com>
Date: Fri, 22 Jun 2001 00:03:24 +0000 (-0700)
Subject: trigraphs and tests for h2xs
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3a9c887ec5858f682dcfa670925a52c00d6a8199;p=p5sagit%2Fp5-mst-13.2.git

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 1bc75f7..6e1805f 100644
--- 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
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 ef31a2e..6bf4be9 100644
--- 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;