rework Carp/t/stack_after_err.t to not use perl -e

1 files changed, 55 insertions, 63 deletions

diff --git a/dist/Carp/t/stack_after_err.t b/dist/Carp/t/stack_after_err.t
index 8bf5be965a..0e7a30acbc 100644
--- a/dist/Carp/t/stack_after_err.t
+++ b/dist/Carp/t/stack_after_err.t
@@ -1,73 +1,65 @@
+use strict;
+use warnings;
 use Config;
 use IPC::Open3 1.0103 qw(open3);
-use Test::More tests => 4;
 
-sub runperl {
-    my(%args) = @_;
-    my($w, $r);
 
-    local $ENV{PERL5LIB} = join ($Config::Config{path_sep}, @INC);
-
-    my $pid = open3($w, $r, undef, $^X, "-e", $args{prog});
-    close $w;
-    my $output = "";
-    while(<$r>) { $output .= $_; }
-    waitpid($pid, 0);
-    return $output;
-}
 
 
-# Make sure we don’t try to load modules on demand in the presence of over-
-# loaded args.  If there has been a syntax error, they won’t load.
-like(
-    runperl(
-        prog => q<
-          use Carp;
-          sub foom {
-              Carp::confess("Looks lark we got a error: $_[0]")
-          }
-          BEGIN {
-              *{"o::()"} = sub {};
-              *{'o::(""'} = sub {"hay"};
-              $o::OVERLOAD{dummy}++; # perls before 5.18 need this
-              *{"CODE::()"} = sub {};
-              $SIG{__DIE__} = sub { foom (@_, bless([], o), sub {}) }
-          }
-        $a +
-        >,
-    ),
-    qr 'Looks lark.*o=ARRAY.* CODE's,
-   'Carp does not try to load modules on demand for overloaded args',
+my @tests=(
+    # Make sure we don’t try to load modules on demand in the presence of over-
+    # loaded args.  If there has been a syntax error, they won’t load.
+    [   'Carp does not try to load modules on demand for overloaded args',
+        "", qr/Looks lark.*o=ARRAY.* CODE/s,
+    ],
+    # Run the test also in the presence of
+    #  a) A UNIVERSAL::can module
+    #  b) A UNIVERSAL::isa module
+    #  c) Both
+    # since they follow slightly different code paths on old pre-5.10.1 perls.
+    [   'StrVal fallback in the presence of UNIVERSAL::isa',
+        'BEGIN { $UNIVERSAL::isa::VERSION = 1 }',
+        qr/Looks lark.*o=ARRAY.* CODE/s,
+    ],
+    [   'StrVal fallback in the presence of UNIVERSAL::can',
+        'BEGIN { $UNIVERSAL::can::VERSION = 1 }',
+        qr/Looks lark.*o=ARRAY.* CODE/s,
+    ],
+    [   'StrVal fallback in the presence of UNIVERSAL::can/isa',
+        'BEGIN { $UNIVERSAL::can::VERSION = $UNIVERSAL::isa::VERSION = 1 }',
+        qr/Looks lark.*o=ARRAY.* CODE/s,
+    ],
 );
 
-# Run the test also in the presence of
-#  a) A UNIVERSAL::can module
-#  b) A UNIVERSAL::isa module
-#  c) Both
-# since they follow slightly different code paths on old pre-5.10.1 perls.
-my $prog = q<
-          use Carp;
-          sub foom {
-              Carp::confess("Looks lark we got a error: $_[0]")
-          }
-          BEGIN {
-              *{"o::()"} = sub {};
-              *{'o::(""'} = sub {"hay"};
-              $o::OVERLOAD{dummy}++; # perls before 5.18 need this
-              *{"CODE::()"} = sub {};
-              $SIG{__DIE__} = sub { foom (@_, bless([], o), sub{}) }
-          }
+my ($test_num)= @ARGV;
+if (!$test_num) {
+    eval sprintf "use Test::More tests => %d; 1", 0+@tests
+        or die "Failed to use Test::More: $@";
+    local $ENV{PERL5LIB} = join ($Config::Config{path_sep}, @INC);
+    foreach my $i (1 .. @tests) {
+        my($w, $r);
+        my $pid = open3($w, $r, undef, $^X, $0, $i);
+        close $w;
+        my $output = do{ local $/; <$r> };
+        waitpid($pid, 0);
+        like($output, $tests[$i-1][2], $tests[$i-1][0]);
+    }
+} else {
+    eval $tests[$test_num-1][1] . <<'END_OF_TEST_CODE'
+        no strict;
+        no warnings;
+        use Carp;
+        sub foom {
+          Carp::confess("Looks lark we got a error: $_[0]")
+        }
+        BEGIN {
+          *{"o::()"} = sub {};
+          *{'o::(""'} = sub {"hay"};
+          $o::OVERLOAD{dummy}++; # perls before 5.18 need this
+          *{"CODE::()"} = sub {};
+          $SIG{__DIE__} = sub { foom (@_, bless([], o), sub {}) }
+        }
         $a +
->;
-for (
- ["UNIVERSAL::isa", 'BEGIN { $UNIVERSAL::isa::VERSION = 1 }'],
- ["UNIVERSAL::can", 'BEGIN { $UNIVERSAL::can::VERSION = 1 }'],
- ["UNIVERSAL::can/isa", 'BEGIN { $UNIVERSAL::can::VERSION =
-                                 $UNIVERSAL::isa::VERSION = 1 }'],
-) {
-    my ($tn, $preamble) = @$_;
-    like(runperl( prog => "$preamble$prog" ),
-         qr 'Looks lark.*o=ARRAY.* CODE's,
-        "StrVal fallback in the presence of $tn",
-    )
+END_OF_TEST_CODE
+    or die $@;
 }