restore ExtUtils-ParseXS portability to Perl 5.6

11 files changed, 84 insertions, 38 deletions

diff --git a/dist/ExtUtils-ParseXS/Changes b/dist/ExtUtils-ParseXS/Changes
index 358ffc2572..b9586bcb0c 100644
--- a/dist/ExtUtils-ParseXS/Changes
+++ b/dist/ExtUtils-ParseXS/Changes
@@ -1,5 +1,7 @@
 Revision history for Perl extension ExtUtils::ParseXS.
 
+  - Restore portability to Perl 5.6, which was lost at EU-PXS 3.00.
+
 3.15 - Thu Feb  2 08:12:00 CET 2012
   - Fix version for PAUSE indexer.
 
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
index 3401b96a0b..883d905931 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
@@ -1,7 +1,7 @@
 package ExtUtils::ParseXS;
 use strict;
 
-use 5.008001;  # We use /??{}/ in regexes
+use 5.006001;
 use Cwd;
 use Config;
 use Exporter;
@@ -11,7 +11,7 @@ use Symbol;
 
 our $VERSION;
 BEGIN {
-  $VERSION = '3.15';
+  $VERSION = '3.16';
 }
 use ExtUtils::ParseXS::Constants $VERSION;
 use ExtUtils::ParseXS::CountLines $VERSION;
@@ -1852,7 +1852,7 @@ sub generate_init {
     $subexpr =~ s/\$arg/ST(ix_$var)/g;
     $subexpr =~ s/\n\t/\n\t\t/g;
     $subexpr =~ s/is not of (.*\")/[arg %d] is not of $1, ix_$var + 1/g;
-    $subexpr =~ s/\$var/${var}[ix_$var - $argoff]/;
+    $subexpr =~ s/\$var/${var}\[ix_$var - $argoff]/;
     $expr =~ s/DO_ARRAY_ELEM/$subexpr/;
   }
   if ($expr =~ m#/\*.*scope.*\*/#i) {  # "scope" in C comments
@@ -1938,7 +1938,7 @@ sub generate_output {
       my $subexpr = $suboutputmap->cleaned_code;
       $subexpr =~ s/ntype/subtype/g;
       $subexpr =~ s/\$arg/ST(ix_$var)/g;
-      $subexpr =~ s/\$var/${var}[ix_$var]/g;
+      $subexpr =~ s/\$var/${var}\[ix_$var]/g;
       $subexpr =~ s/\n\t/\n\t\t/g;
       $expr =~ s/DO_ARRAY_ELEM\n/$subexpr/;
       eval "print qq\a$expr\a";
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm
index a002637fc4..2f822dacbe 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use Symbol;
 
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 =head1 NAME
 
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm
index b2a46576fd..66944cd629 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm
@@ -1,7 +1,7 @@
 package ExtUtils::ParseXS::CountLines;
 use strict;
 
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 our $SECTION_END_MARKER;
 
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
index e4c5104769..c4172d017e 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
@@ -6,7 +6,7 @@ use File::Spec;
 use lib qw( lib );
 use ExtUtils::ParseXS::Constants ();
 
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 our (@ISA, @EXPORT_OK);
 @ISA = qw(Exporter);
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
index 6b22153781..2bc9c8036f 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps;
 use 5.006001;
 use strict;
 use warnings;
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 #use Carp qw(croak);
 
 require ExtUtils::ParseXS;
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm
index 6d1d3e00be..671110fb97 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::Cmd;
 use 5.006001;
 use strict;
 use warnings;
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 use ExtUtils::Typemaps;
 
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm
index fea3a47280..9e7053f229 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::InputMap;
 use 5.006001;
 use strict;
 use warnings;
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 =head1 NAME
 
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
index 3475ec860b..95cbbccf5c 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::OutputMap;
 use 5.006001;
 use strict;
 use warnings;
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 =head1 NAME
 
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
index 6604d84a62..b29e212d45 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 require ExtUtils::Typemaps;
 
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 =head1 NAME
 
diff --git a/dist/ExtUtils-ParseXS/t/lib/PrimitiveCapture.pm b/dist/ExtUtils-ParseXS/t/lib/PrimitiveCapture.pm
index aa873d4d4f..29dbf658e6 100644
--- a/dist/ExtUtils-ParseXS/t/lib/PrimitiveCapture.pm
+++ b/dist/ExtUtils-ParseXS/t/lib/PrimitiveCapture.pm
@@ -2,32 +2,76 @@ package PrimitiveCapture;
 use strict;
 use warnings;
 
-sub capture_stdout {
-  my $sub = shift;
-  my $stdout;
-  open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!";
-  close STDOUT;
-  open STDOUT, '>', \$stdout or die "Can't open STDOUT: $!";
-
-  $sub->();
-
-  close STDOUT;
-  open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!";
-  return $stdout;
-}
-
-sub capture_stderr {
-  my $sub = shift;
-  my $stderr;
-  open my $olderr, ">&STDERR" or die "Can't dup STDERR: $!";
-  close STDERR;
-  open STDERR, '>', \$stderr or die "Can't open STDERR: $!";
-
-  $sub->();
-
-  close STDERR;
-  open STDERR, ">&", $olderr or die "Can't dup \$olderr: $!";
-  return $stderr;
+if ("$]" >= 5.008000) {
+  eval "#line @{[__LINE__+1]} ".q{"lib/PrimitiveCapture.pm"
+    sub capture_stdout {
+      my $sub = shift;
+      my $stdout;
+      open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!";
+      close STDOUT;
+      open STDOUT, '>', \$stdout or die "Can't open STDOUT: $!";
+      $sub->();
+      close STDOUT;
+      open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!";
+      return $stdout;
+    }
+    sub capture_stderr {
+      my $sub = shift;
+      my $stderr;
+      open my $olderr, ">&STDERR" or die "Can't dup STDERR: $!";
+      close STDERR;
+      open STDERR, '>', \$stderr or die "Can't open STDERR: $!";
+      $sub->();
+      close STDERR;
+      open STDERR, ">&", $olderr or die "Can't dup \$olderr: $!";
+      return $stderr;
+    }
+  }; die $@ unless $@ eq "";
+} else {
+  eval "#line @{[__LINE__+1]} ".q{"lib/PrimitiveCapture.pm"
+    use File::Spec;
+    use File::Temp;
+    my $tmpdir;
+    my $i = 0;
+    sub _tmpfile {
+      $tmpdir ||= File::Temp::tempdir(CLEANUP => 1, TMPDIR => 1);
+      return File::Spec->catfile($tmpdir, $i++);
+    }
+    sub _slurp {
+      my $filename = shift;
+      open my $fh, "<", $filename or die "Can't read $filename: $!";
+      local $/ = undef;
+      my $content = <$fh>;
+      defined $content or die "Can't read $filename: $!";
+      return $content;
+    }
+    sub capture_stdout {
+      my $sub = shift;
+      my $tmpfile = _tmpfile();
+      local *OLDSTDOUT;
+      open OLDSTDOUT, ">&STDOUT" or die "Can't dup STDOUT: $!";
+      close STDOUT;
+      open STDOUT, '>', $tmpfile or die "Can't open STDOUT: $!";
+      $sub->();
+      close STDOUT;
+      open STDOUT, ">&OLDSTDOUT" or die "Can't dup OLDSTDOUT: $!";
+      close OLDSTDOUT;
+      return _slurp($tmpfile);
+    }
+    sub capture_stderr {
+      my $sub = shift;
+      my $tmpfile = _tmpfile();
+      local *OLDSTDERR;
+      open OLDSTDERR, ">&STDERR" or die "Can't dup STDERR: $!";
+      close STDERR;
+      open STDERR, '>', $tmpfile or die "Can't open STDERR: $!";
+      $sub->();
+      close STDERR;
+      open STDERR, ">&OLDSTDERR" or die "Can't dup OLDSTDERR: $!";
+      close OLDSTDERR;
+      return _slurp($tmpfile);
+    }
+  }; die $@ unless $@ eq "";
 }
 
 1;