From: Robin Barker <rmbarker@cpan.org>
Date: Thu, 22 Apr 2010 10:51:20 +0000 (+0100)
Subject: Fix h2ph and test
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8d66b3f930dc6d88b524d103e304308ae73a46e7;p=p5sagit%2Fp5-mst-13.2.git

Fix h2ph and test
---

diff --git a/lib/h2ph.t b/lib/h2ph.t
index 27dd7b9..8d62d46 100644
--- a/lib/h2ph.t
+++ b/lib/h2ph.t
@@ -18,7 +18,7 @@ if (!(-e $extracted_program)) {
     exit 0;
 }
 
-plan(4);
+plan(5);
 
 # quickly compare two text files
 sub txt_compare {
@@ -41,8 +41,16 @@ $result = runperl( progfile => 'lib/h2ph.pht',
                    stderr => 1 );
 like( $result, qr/syntax OK$/, "output compiles");
 
+$result = runperl( progfile => '_h2ph_pre.ph',
+                   switches => ['-c'],
+                   stderr => 1 );
+like( $result, qr/syntax OK$/, "preamble compiles");
+
 $result = runperl( switches => ["-w"], 
-                   prog => '$SIG{__WARN__} = sub { die $_[0] }; require q(lib/h2ph.pht);');
+                   stderr => 1,
+                   prog => <<'PROG' );
+$SIG{__WARN__} = sub { die $_[0] }; require q(lib/h2ph.pht);
+PROG
 is( $result, '', "output free of warnings" );
 
 # cleanup
diff --git a/utils/h2ph.PL b/utils/h2ph.PL
index 8f56db4..1255807 100644
--- a/utils/h2ph.PL
+++ b/utils/h2ph.PL
@@ -401,7 +401,10 @@ if ($opt_e && (scalar(keys %bad_file) > 0)) {
 exit $Exit;
 
 sub expr {
-    $new = '"(assembly code)"' and return if /\b__asm__\b/; # freak out.
+    if (/\b__asm__\b/) {	# freak out
+	$new = '"(assembly code)"';
+	return
+    }
     my $joined_args;
     if(keys(%curargs)) {
 	$joined_args = join('|', keys(%curargs));
@@ -770,7 +773,7 @@ sub inc_dirs
 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?
@@ -798,7 +801,16 @@ sub build_preamble_if_necessary
 		# parenthesized value:  d=(v)
 		$define{$_} = $1;
 	    }
-	    if ($define{$_} =~ /^([+-]?(\d+)?\.\d+([eE][+-]?\d+)?)[FL]?$/) {
+	    if (/^(\w+)\((\w)\)$/) {
+		my($macro, $arg) = ($1, $2);
+		my $def = $define{$_};
+		$def =~ s/$arg/\$\{$arg\}/g;
+		print PREAMBLE <<DEFINE;
+unless (defined &$macro) { sub $macro(\$) { my (\$$arg) = \@_; \"$def\" } }
+
+DEFINE
+	    } elsif
+		($define{$_} =~ /^([+-]?(\d+)?\.\d+([eE][+-]?\d+)?)[FL]?$/) {
 		# float:
 		print PREAMBLE
 		    "unless (defined &$_) { sub $_() { $1 } }\n\n";
@@ -807,8 +819,14 @@ sub build_preamble_if_necessary
 		print PREAMBLE
 		    "unless (defined &$_) { sub $_() { $1 } }\n\n";
 	    } elsif ($define{$_} =~ /^\w+$/) {
-		print PREAMBLE
-		    "unless (defined &$_) { sub $_() { &$define{$_} } }\n\n";
+		my $def = $define{$_};
+		if ($isatype{$def}) {
+		  print PREAMBLE
+		    "unless (defined &$_) { sub $_() { \"$def\" } }\n\n";
+		} else {
+		  print PREAMBLE
+		    "unless (defined &$_) { sub $_() { &$def } }\n\n";
+	        }
 	    } else {
 		print PREAMBLE
 		    "unless (defined &$_) { sub $_() { \"",