Mostly adding tests and documentation.

Rename sub print_preprocessor_statements() to
analyze_preprocessor_statements().  Modify interface to map_type() and
re-work tests as needed.  Wrote documentation in Utilities.pm for
process_single_typemap(), map_type(), standard_XS_defs(),
assign_func_args(), analyze_preprocessor_statements().  Write tests
in t/109-standard_XS_defs.t, t/110-assign_func_args.t.

11 files changed, 359 insertions, 76 deletions

diff --git a/MANIFEST b/MANIFEST
index cff5970ee5..a6defc752f 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2992,11 +2992,12 @@ dist/ExtUtils-ParseXS/t/107-make_targetable.t			ExtUtils::ParseXS tests
 dist/ExtUtils-ParseXS/t/108-map_type.t				ExtUtils::ParseXS tests
 dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t			ExtUtils::ParseXS tests
 dist/ExtUtils-ParseXS/t/110-assign_func_args.t			ExtUtils::ParseXS tests
-dist/ExtUtils-ParseXS/t/111-print_preprocessor_statements.t	ExtUtils::ParseXS tests
+dist/ExtUtils-ParseXS/t/111-analyze_preprocessor_statements.t	ExtUtils::ParseXS tests
 dist/ExtUtils-ParseXS/t/112-set_cond.t				ExtUtils::ParseXS tests
 dist/ExtUtils-ParseXS/t/113-check_cond_preproc_statements.t	ExtUtils::ParseXS tests
 dist/ExtUtils-ParseXS/t/114-blurt_death_Warn.t			ExtUtils::ParseXS tests
 dist/ExtUtils-ParseXS/t/lib/IncludeTester.pm			ExtUtils::ParseXS testing utility
+dist/ExtUtils-ParseXS/t/lib/PrimitiveCapture.pm			Primitive STDOUT/ERR capturing for tests
 dist/ExtUtils-ParseXS/t/pseudotypemap1				A test-typemap
 dist/ExtUtils-ParseXS/t/typemap					Standard typemap for controlled testing
 dist/ExtUtils-ParseXS/t/XSInclude.xsh				Test file for ExtUtils::ParseXS tests
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
index 37f655266d..156f6e5ac7 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
@@ -21,7 +21,7 @@ use ExtUtils::ParseXS::Utilities qw(
   map_type
   standard_XS_defs
   assign_func_args
-  print_preprocessor_statements
+  analyze_preprocessor_statements
   set_cond
   Warn
   blurt
@@ -273,8 +273,11 @@ EOM
       my $ln = shift(@{ $self->{line} });
       print $ln, "\n";
       next unless $ln =~ /^\#\s*((if)(?:n?def)?|elsif|else|endif)\b/;
+      my $statement = $+;
       ( $self, $XSS_work_idx, $BootCode_ref ) =
-        print_preprocessor_statements( $self, $XSS_work_idx, $BootCode_ref );
+        analyze_preprocessor_statements(
+          $self, $statement, $XSS_work_idx, $BootCode_ref
+        );
     }
 
     next PARAGRAPH unless @{ $self->{line} };
@@ -621,7 +624,7 @@ EOF
       }
       else {
         if ($self->{ret_type} ne "void") {
-          print "\t" . map_type($self->{ret_type}, 'RETVAL', $self->{hiertype}) . ";\n"
+          print "\t" . map_type($self, $self->{ret_type}, 'RETVAL') . ";\n"
             if !$self->{retvaldone};
           $self->{args_match}->{"RETVAL"} = 0;
           $self->{var_types}->{"RETVAL"} = $self->{ret_type};
@@ -1092,11 +1095,11 @@ sub INPUT_handler {
     my $printed_name;
     if ($var_type =~ / \( \s* \* \s* \) /x) {
       # Function pointers are not yet supported with &output_init!
-      print "\t" . map_type($var_type, $var_name, $self->{hiertype});
+      print "\t" . map_type($self, $var_type, $var_name);
       $printed_name = 1;
     }
     else {
-      print "\t" . map_type($var_type, undef, $self->{hiertype});
+      print "\t" . map_type($self, $var_type, undef);
       $printed_name = 0;
     }
     $self->{var_num} = $self->{args_match}->{$var_name};
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
index ef22fdce26..b25df02d4d 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
@@ -19,7 +19,7 @@ our (@ISA, @EXPORT_OK);
   map_type
   standard_XS_defs
   assign_func_args
-  print_preprocessor_statements
+  analyze_preprocessor_statements
   set_cond
   Warn
   blurt
@@ -310,6 +310,31 @@ sub process_typemaps {
   return ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
 }
 
+=head2 C<process_single_typemap()>
+
+=over 4
+
+=item * Purpose
+
+Process a single typemap within C<process_typemaps()>.
+
+=item * Arguments
+
+    ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref) =
+      process_single_typemap( $typemap,
+        $type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
+
+List of five elements:  The individual typemap needing processing and four
+references.
+
+=item * Return Value
+
+List of four references -- modified versions of those passed in as arguments.
+
+=back
+
+=cut
+
 sub process_single_typemap {
   my ($typemap,
     $type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref) = @_;
@@ -347,10 +372,6 @@ sub process_single_typemap {
       $type_kind_ref->{$type} = $kind;
       # prototype defaults to '$'
       $proto = "\$" unless $proto;
-#      warn(
-#          "Warning: File '$typemap' Line $. '$logged_line' " .
-#          "Invalid prototype '$proto'\n"
-#      ) unless valid_proto_string($proto);
       $proto_letter_ref->{$type} = C_string($proto);
     }
     elsif (/^\s/) {
@@ -421,11 +442,33 @@ sub make_targetable {
   return %targetable;
 }
 
+=head2 C<map_type()>
+
+=over 4
+
+=item * Purpose
+
+Performs a mapping at several places inside C<PARAGRAPH> loop.
+
+=item * Arguments
+
+  $type = map_type($self, $type, $varname);
+
+List of three arguments.
+
+=item * Return Value
+
+String holding augmented version of second argument.
+
+=back
+
+=cut
+
 sub map_type {
-  my ($type, $varname, $hiertype) = @_;
+  my ($self, $type, $varname) = @_;
 
   # C++ has :: in types too so skip this
-  $type =~ tr/:/_/ unless $hiertype;
+  $type =~ tr/:/_/ unless $self->{hiertype};
   $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s;
   if ($varname) {
     if ($type =~ / \( \s* \* (?= \s* \) ) /xg) {
@@ -438,6 +481,27 @@ sub map_type {
   return $type;
 }
 
+=head2 C<standard_XS_defs()>
+
+=over 4
+
+=item * Purpose
+
+Writes to the C<.c> output file certain preprocessor directives and function
+headers needed in all such files.
+
+=item * Arguments
+
+None.
+
+=item * Return Value
+
+Implicitly returns true when final C<print> statement completes.
+
+=back
+
+=cut
+
 sub standard_XS_defs {
   print <<"EOF";
 #ifndef PERL_UNUSED_VAR
@@ -497,21 +561,69 @@ S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
 EOF
 }
 
+=head2 C<assign_func_args()>
+
+=over 4
+
+=item * Purpose
+
+Perform assignment to the C<func_args> attribute.
+
+=item * Arguments
+
+  $string = assign_func_args($self, $argsref, $class);
+
+List of three elements.  Second is an array reference; third is a string.
+
+=item * Return Value
+
+String.
+
+=back
+
+=cut
+
 sub assign_func_args {
   my ($self, $argsref, $class) = @_;
   my @func_args = @{$argsref};
   shift @func_args if defined($class);
 
-  for (@func_args) {
-    s/^/&/ if $self->{in_out}->{$_};
+  for my $arg (@func_args) {
+    $arg =~ s/^/&/ if $self->{in_out}->{$arg};
   }
   return join(", ", @func_args);
 }
 
-sub print_preprocessor_statements {
-  my ($self, $XSS_work_idx, $BootCode_ref) = @_;
+=head2 C<analyze_preprocessor_statements()>
+
+=over 4
+
+=item * Purpose
+
+Within each function inside each Xsub, print to the F<.c> output file certain
+preprocessor statements.
+
+=item * Arguments
+
+      ( $self, $XSS_work_idx, $BootCode_ref ) =
+        analyze_preprocessor_statements(
+          $self, $statement, $XSS_work_idx, $BootCode_ref
+        );
+
+List of four elements.
+
+=item * Return Value
+
+Modifed values of three of the arguments passed to the function.  In
+particular, the C<XSStack> and C<InitFileCode> attributes are modified.
+
+=back
+
+=cut
+
+sub analyze_preprocessor_statements {
+  my ($self, $statement, $XSS_work_idx, $BootCode_ref) = @_;
 
-  my $statement = $+;
   if ($statement eq 'if') {
     $XSS_work_idx = @{ $self->{XSStack} };
     push(@{ $self->{XSStack} }, {type => 'if'});
@@ -542,6 +654,20 @@ sub print_preprocessor_statements {
   return ($self, $XSS_work_idx, $BootCode_ref);
 }
 
+=head2 C<set_cond()>
+
+=over 4
+
+=item * Purpose
+
+=item * Arguments
+
+=item * Return Value
+
+=back
+
+=cut
+
 sub set_cond {
   my ($ellipsis, $min_args, $num_args) = @_;
   my $cond;
@@ -557,6 +683,20 @@ sub set_cond {
   return $cond;
 }
 
+=head2 C<Warn()>
+
+=over 4
+
+=item * Purpose
+
+=item * Arguments
+
+=item * Return Value
+
+=back
+
+=cut
+
 sub Warn {
   my $self = shift;
   # work out the line number
@@ -565,18 +705,60 @@ sub Warn {
   print STDERR "@_ in $self->{filename}, line $warn_line_number\n";
 }
 
+=head2 C<blurt()>
+
+=over 4
+
+=item * Purpose
+
+=item * Arguments
+
+=item * Return Value
+
+=back
+
+=cut
+
 sub blurt {
   my $self = shift;
   Warn($self, @_);
   $self->{errors}++
 }
 
+=head2 C<death()>
+
+=over 4
+
+=item * Purpose
+
+=item * Arguments
+
+=item * Return Value
+
+=back
+
+=cut
+
 sub death {
   my $self = shift;
   Warn($self, @_);
   exit 1;
 }
 
+=head2 C<check_conditional_preprocessor_statements()>
+
+=over 4
+
+=item * Purpose
+
+=item * Arguments
+
+=item * Return Value
+
+=back
+
+=cut
+
 sub check_conditional_preprocessor_statements {
   my ($self) = @_;
   my @cpp = grep(/^\#\s*(?:if|e\w+)/, @{ $self->{line} });
diff --git a/dist/ExtUtils-ParseXS/t/104-map_type.t b/dist/ExtUtils-ParseXS/t/104-map_type.t
index 2c5ae30beb..01e784e37c 100644
--- a/dist/ExtUtils-ParseXS/t/104-map_type.t
+++ b/dist/ExtUtils-ParseXS/t/104-map_type.t
@@ -7,61 +7,61 @@ use ExtUtils::ParseXS::Utilities qw(
   map_type
 );
 
-my ($type, $varname, $hiertype);
+my ($self, $type, $varname);
 my ($result, $expected);
 
 $type = 'struct DATA *';
 $varname = 'RETVAL';
-$hiertype = 0;
+$self->{hiertype} = 0;
 $expected = "$type\t$varname";
-$result = map_type($type, $varname, $hiertype);
+$result = map_type($self, $type, $varname);
 is( $result, $expected,
-    "Got expected map_type for <$type>, <$varname>, <$hiertype>" );
+    "Got expected map_type for <$type>, <$varname>, <$self->{hiertype}>" );
 
 $type = 'Crypt::Shark';
 $varname = undef;
-$hiertype = 0;
+$self->{hiertype} = 0;
 $expected = 'Crypt__Shark';
-$result = map_type($type, $varname, $hiertype);
+$result = map_type($self, $type, $varname);
 is( $result, $expected,
-    "Got expected map_type for <$type>, undef, <$hiertype>" );
+    "Got expected map_type for <$type>, undef, <$self->{hiertype}>" );
 
 $type = 'Crypt::Shark';
 $varname = undef;
-$hiertype = 1;
+$self->{hiertype} = 1;
 $expected = 'Crypt::Shark';
-$result = map_type($type, $varname, $hiertype);
+$result = map_type($self, $type, $varname);
 is( $result, $expected,
-    "Got expected map_type for <$type>, undef, <$hiertype>" );
+    "Got expected map_type for <$type>, undef, <$self->{hiertype}>" );
 
 $type = 'Crypt::TC18';
 $varname = 'RETVAL';
-$hiertype = 0;
+$self->{hiertype} = 0;
 $expected = "Crypt__TC18\t$varname";
-$result = map_type($type, $varname, $hiertype);
+$result = map_type($self, $type, $varname);
 is( $result, $expected,
-    "Got expected map_type for <$type>, <$varname>, <$hiertype>" );
+    "Got expected map_type for <$type>, <$varname>, <$self->{hiertype}>" );
 
 $type = 'Crypt::TC18';
 $varname = 'RETVAL';
-$hiertype = 1;
+$self->{hiertype} = 1;
 $expected = "Crypt::TC18\t$varname";
-$result = map_type($type, $varname, $hiertype);
+$result = map_type($self, $type, $varname);
 is( $result, $expected,
-    "Got expected map_type for <$type>, <$varname>, <$hiertype>" );
+    "Got expected map_type for <$type>, <$varname>, <$self->{hiertype}>" );
 
 $type = 'array(alpha,beta) gamma';
 $varname = 'RETVAL';
-$hiertype = 0;
+$self->{hiertype} = 0;
 $expected = "alpha *\t$varname";
-$result = map_type($type, $varname, $hiertype);
+$result = map_type($self, $type, $varname);
 is( $result, $expected,
-    "Got expected map_type for <$type>, <$varname>, <$hiertype>" );
+    "Got expected map_type for <$type>, <$varname>, <$self->{hiertype}>" );
 
 $type = '(*)';
 $varname = 'RETVAL';
-$hiertype = 0;
+$self->{hiertype} = 0;
 $expected = "(* $varname )";
-$result = map_type($type, $varname, $hiertype);
+$result = map_type($self, $type, $varname);
 is( $result, $expected,
-    "Got expected map_type for <$type>, <$varname>, <$hiertype>" );
+    "Got expected map_type for <$type>, <$varname>, <$self->{hiertype}>" );
diff --git a/dist/ExtUtils-ParseXS/t/108-map_type.t b/dist/ExtUtils-ParseXS/t/108-map_type.t
index 7414e54ab7..ba08f6cb04 100644
--- a/dist/ExtUtils-ParseXS/t/108-map_type.t
+++ b/dist/ExtUtils-ParseXS/t/108-map_type.t
@@ -11,4 +11,8 @@ use ExtUtils::ParseXS::Utilities qw(
     map_type
 );
 
+#print "\t" . map_type($self->{ret_type}, 'RETVAL', $self->{hiertype}) . ";\n"
+#print "\t" . map_type($var_type, $var_name, $self->{hiertype});
+#print "\t" . map_type($var_type, undef, $self->{hiertype});
+
 pass("Passed all tests in $0");
diff --git a/dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t b/dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t
index e5594aed11..0cb7493f9d 100644
--- a/dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t
+++ b/dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t
@@ -1,14 +1,27 @@
 #!/usr/bin/perl
 use strict;
 use warnings;
-use Carp;
-use Cwd;
-use File::Spec;
-use File::Temp qw( tempdir );
-use Test::More qw(no_plan); # tests =>  7;
-use lib qw( lib );
+$| = 1;
+use Test::More tests => 5;
+use lib qw( lib t/lib );
 use ExtUtils::ParseXS::Utilities qw(
     standard_XS_defs
 );
+use PrimitiveCapture;
+
+my @statements = (
+    '#ifndef PERL_UNUSED_VAR',
+    '#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE',
+    '#ifdef PERL_IMPLICIT_CONTEXT',
+    '#ifdef newXS_flags',
+);
+
+my $stdout = PrimitiveCapture::capture_stdout(sub {
+  standard_XS_defs();
+});
+
+foreach my $s (@statements) {
+    like( $stdout, qr/$s/s, "Printed <$s>" );
+}
 
 pass("Passed all tests in $0");
diff --git a/dist/ExtUtils-ParseXS/t/110-assign_func_args.t b/dist/ExtUtils-ParseXS/t/110-assign_func_args.t
index 64e9c8f6c0..63d978417b 100644
--- a/dist/ExtUtils-ParseXS/t/110-assign_func_args.t
+++ b/dist/ExtUtils-ParseXS/t/110-assign_func_args.t
@@ -11,4 +11,42 @@ use ExtUtils::ParseXS::Utilities qw(
     assign_func_args
 );
 
+#sub assign_func_args {
+#  my ($self, $argsref, $class) = @_;
+#  return join(", ", @func_args);
+
+my ($self, @args, $class);
+my ($func_args, $expected);
+
+@args = qw( alpha beta gamma );
+$self->{in_out}->{alpha} = 'OUT';
+$expected = q|&alpha, beta, gamma|;
+$func_args = assign_func_args($self, \@args, $class);
+is( $func_args, $expected,
+    "Got expected func_args: in_out true; class undefined" );
+
+@args = ( 'My::Class', qw( beta gamma ) );
+$self->{in_out}->{beta} = 'OUT';
+$class = 'My::Class';
+$expected = q|&beta, gamma|;
+$func_args = assign_func_args($self, \@args, $class);
+is( $func_args, $expected,
+    "Got expected func_args: in_out true; class defined" );
+
+@args = ( 'My::Class', qw( beta gamma ) );
+$self->{in_out}->{beta} = '';
+$class = 'My::Class';
+$expected = q|beta, gamma|;
+$func_args = assign_func_args($self, \@args, $class);
+is( $func_args, $expected,
+    "Got expected func_args: in_out false; class defined" );
+
+@args = qw( alpha beta gamma );
+$self->{in_out}->{alpha} = '';
+$class = undef;
+$expected = q|alpha, beta, gamma|;
+$func_args = assign_func_args($self, \@args, $class);
+is( $func_args, $expected,
+    "Got expected func_args: in_out false; class undefined" );
+
 pass("Passed all tests in $0");
diff --git a/dist/ExtUtils-ParseXS/t/111-print_preprocessor_statements.t b/dist/ExtUtils-ParseXS/t/111-analyze_preprocessor_statements.t
index fdb121065d..b9d6d73b41 100644
--- a/dist/ExtUtils-ParseXS/t/111-print_preprocessor_statements.t
+++ b/dist/ExtUtils-ParseXS/t/111-analyze_preprocessor_statements.t
@@ -1,6 +1,7 @@
 #!/usr/bin/perl
 use strict;
 use warnings;
+$| = 1;
 use Carp;
 use Cwd;
 use File::Spec;
@@ -8,7 +9,14 @@ use File::Temp qw( tempdir );
 use Test::More qw(no_plan); # tests =>  7;
 use lib qw( lib );
 use ExtUtils::ParseXS::Utilities qw(
-    print_preprocessor_statements
+    analyze_preprocessor_statements
 );
 
+#      ( $self, $XSS_work_idx, $BootCode_ref ) =
+#        analyze_preprocessor_statements(
+#          $self, $statement, $XSS_work_idx, $BootCode_ref
+#        );
+
 pass("Passed all tests in $0");
+
+
diff --git a/dist/ExtUtils-ParseXS/t/113-check_cond_preproc_statements.t b/dist/ExtUtils-ParseXS/t/113-check_cond_preproc_statements.t
index a6cbd50175..42f3791ecf 100644
--- a/dist/ExtUtils-ParseXS/t/113-check_cond_preproc_statements.t
+++ b/dist/ExtUtils-ParseXS/t/113-check_cond_preproc_statements.t
@@ -5,12 +5,12 @@ use Carp;
 use Cwd;
 use File::Spec;
 use File::Temp qw( tempdir );
-use Capture::Tiny qw( capture );
 use Test::More tests => 13;
-use lib qw( lib );
+use lib qw( lib t/lib );
 use ExtUtils::ParseXS::Utilities qw(
     check_conditional_preprocessor_statements
 );
+use PrimitiveCapture;
 
 my $self = {};
 $self->{line} = [];
@@ -31,10 +31,10 @@ $self->{XSStack}->[0] = {};
     $self->{XSStack}->[-1]{type} = 'if';
     $self->{filename} = 'myfile1';
 
-    my ($stdout, $stderr, $rv);
-    ($stdout, $stderr) = capture {
+    my $rv;
+    my $stderr = PrimitiveCapture::capture_stderr(sub {
         $rv = check_conditional_preprocessor_statements($self);
-    };
+    });
         
     is( $rv, 0, "Basic case: returned 0: all ifs resolved" );
     ok( ! $stderr, "No warnings captured, as expected" );
@@ -54,10 +54,10 @@ $self->{XSStack}->[0] = {};
     $self->{XSStack}->[-1]{type} = 'if';
     $self->{filename} = 'myfile1';
 
-    my ($stdout, $stderr, $rv);
-    ($stdout, $stderr) = capture {
+    my $rv;
+    my $stderr = PrimitiveCapture::capture_stderr(sub {
         $rv = check_conditional_preprocessor_statements($self);
-    };
+    });
     is( $rv, 0, "One nested if case: returned 0: all ifs resolved" );
     ok( ! $stderr, "No warnings captured, as expected" );
 }
@@ -75,10 +75,10 @@ $self->{XSStack}->[0] = {};
     $self->{XSStack}->[-1]{type} = 'if';
     $self->{filename} = 'myfile1';
 
-    my ($stdout, $stderr, $rv);
-    ($stdout, $stderr) = capture {
+    my $rv;
+    my $stderr = PrimitiveCapture::capture_stderr(sub {
         $rv = check_conditional_preprocessor_statements($self);
-    };
+    });
     is( $rv, undef,
         "Missing 'if' case: returned undef: all ifs resolved" );
     like( $stderr,
@@ -104,10 +104,10 @@ $self->{XSStack}->[0] = {};
     $self->{XSStack}->[-1]{type} = 'file';
     $self->{filename} = 'myfile1';
 
-    my ($stdout, $stderr, $rv);
-    ($stdout, $stderr) = capture {
+    my $rv;
+    my $stderr = PrimitiveCapture::capture_stderr(sub {
         $rv = check_conditional_preprocessor_statements($self);
-    };
+    });
     is( $rv, undef,
         "Missing 'if' case: returned undef: all ifs resolved" );
     like( $stderr,
@@ -133,10 +133,10 @@ $self->{XSStack}->[0] = {};
     $self->{XSStack}->[-1]{type} = 'if';
     $self->{filename} = 'myfile1';
 
-    my ($stdout, $stderr, $rv);
-    ($stdout, $stderr) = capture {
+    my $rv;
+    my $stderr = PrimitiveCapture::capture_stderr(sub {
         $rv = check_conditional_preprocessor_statements($self);
-    };
+    });
     isnt( $rv, 0,
         "Missing 'endif' case: returned non-zero as expected" );
     like( $stderr,
diff --git a/dist/ExtUtils-ParseXS/t/114-blurt_death_Warn.t b/dist/ExtUtils-ParseXS/t/114-blurt_death_Warn.t
index 298bf10a16..71a637eef3 100644
--- a/dist/ExtUtils-ParseXS/t/114-blurt_death_Warn.t
+++ b/dist/ExtUtils-ParseXS/t/114-blurt_death_Warn.t
@@ -1,18 +1,19 @@
 #!/usr/bin/perl
 use strict;
 use warnings;
+$| = 1;
 use Carp;
 use Cwd;
 use File::Spec;
 use File::Temp qw( tempdir );
-use Capture::Tiny qw( capture );
 use Test::More tests =>  7;
-use lib qw( lib );
+use lib qw( lib t/lib );
 use ExtUtils::ParseXS::Utilities qw(
     Warn
     blurt
     death
 );
+use PrimitiveCapture;
 
 my $self = {};
 $self->{line} = [];
@@ -30,9 +31,9 @@ $self->{line_no} = [];
 
     my $message = 'Warning: Ignoring duplicate alias';
     
-    my ($stdout, $stderr) = capture {
+    my $stderr = PrimitiveCapture::capture_stderr(sub {
         Warn( $self, $message);
-    };
+    });
     like( $stderr,
         qr/$message in $self->{filename}, line 20/,
         "Got expected Warn output",
@@ -51,9 +52,9 @@ $self->{line_no} = [];
     $self->{filename} = 'myfile2';
 
     my $message = 'Warning: Ignoring duplicate alias';
-    my ($stdout, $stderr) = capture {
+    my $stderr = PrimitiveCapture::capture_stderr(sub {
         Warn( $self, $message);
-    };
+    });
     like( $stderr,
         qr/$message in $self->{filename}, line 19/,
         "Got expected Warn output",
@@ -71,9 +72,9 @@ $self->{line_no} = [];
     $self->{filename} = 'myfile1';
 
     my $message = 'Warning: Ignoring duplicate alias';
-    my ($stdout, $stderr) = capture {
+    my $stderr = PrimitiveCapture::capture_stderr(sub {
         Warn( $self, $message);
-    };
+    });
     like( $stderr,
         qr/$message in $self->{filename}, line 17/,
         "Got expected Warn output",
@@ -93,9 +94,9 @@ $self->{line_no} = [];
 
 
     my $message = 'Error: Cannot parse function definition';
-    my ($stdout, $stderr) = capture {
+    my $stderr = PrimitiveCapture::capture_stderr(sub {
         blurt( $self, $message);
-    };
+    });
     like( $stderr,
         qr/$message in $self->{filename}, line 20/,
         "Got expected blurt output",
@@ -117,9 +118,9 @@ SKIP: {
 
     my $message = "Code is not inside a function";
     eval {
-        my ($stdout, $stderr) = capture {
+        my $stderr = PrimitiveCapture::capture_stderr(sub {
             death( $self, $message);
-        };
+        });
         like( $stderr,
             qr/$message in $self->{filename}, line 20/,
             "Got expected death output",
diff --git a/dist/ExtUtils-ParseXS/t/lib/PrimitiveCapture.pm b/dist/ExtUtils-ParseXS/t/lib/PrimitiveCapture.pm
new file mode 100644
index 0000000000..aa873d4d4f
--- /dev/null
+++ b/dist/ExtUtils-ParseXS/t/lib/PrimitiveCapture.pm
@@ -0,0 +1,33 @@
+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;
+}
+
+1;