1use strict;
2use warnings;
3use Config;
4use IPC::Open3 1.0103 qw(open3);
5
6BEGIN {
7    if ($^O eq 'VMS') {
8        print "1..0 # IPC::Open3 needs porting\n";
9        exit;
10    }
11}
12
13my @tests=(
14    # Make sure we don’t try to load modules on demand in the presence of over-
15    # loaded args.  If there has been a syntax error, they won’t load.
16    [   'Carp does not try to load modules on demand for overloaded args',
17        "", qr/Looks lark.*o=ARRAY.* CODE/s,
18    ],
19    # Run the test also in the presence of
20    #  a) A UNIVERSAL::can module
21    #  b) A UNIVERSAL::isa module
22    #  c) Both
23    # since they follow slightly different code paths on old pre-5.10.1 perls.
24    [   'StrVal fallback in the presence of UNIVERSAL::isa',
25        'BEGIN { $UNIVERSAL::isa::VERSION = 1 }',
26        qr/Looks lark.*o=ARRAY.* CODE/s,
27    ],
28    [   'StrVal fallback in the presence of UNIVERSAL::can',
29        'BEGIN { $UNIVERSAL::can::VERSION = 1 }',
30        qr/Looks lark.*o=ARRAY.* CODE/s,
31    ],
32    [   'StrVal fallback in the presence of UNIVERSAL::can/isa',
33        'BEGIN { $UNIVERSAL::can::VERSION = $UNIVERSAL::isa::VERSION = 1 }',
34        qr/Looks lark.*o=ARRAY.* CODE/s,
35    ],
36);
37
38my ($test_num)= @ARGV;
39if (!$test_num) {
40    eval sprintf "use Test::More tests => %d; 1", 0+@tests
41        or die "Failed to use Test::More: $@";
42    local $ENV{PERL5LIB} = join ($Config::Config{path_sep}, @INC);
43    foreach my $i (1 .. @tests) {
44        my($w, $r);
45        my $pid = open3($w, $r, undef, $^X, $0, $i);
46        close $w;
47        my $output = do{ local $/; <$r> };
48        waitpid($pid, 0);
49        like($output, $tests[$i-1][2], $tests[$i-1][0]);
50    }
51} else {
52    eval $tests[$test_num-1][1] . <<'END_OF_TEST_CODE'
53        no strict;
54        no warnings;
55        use Carp;
56        sub foom {
57          Carp::confess("Looks lark we got a error: $_[0]")
58        }
59        BEGIN {
60          *{"o::()"} = sub {};
61          *{'o::(""'} = sub {"hay"};
62          $o::OVERLOAD{dummy}++; # perls before 5.18 need this
63          *{"CODE::()"} = sub {};
64          $SIG{__DIE__} = sub { foom (@_, bless([], o), sub {}) }
65        }
66        $a +
67END_OF_TEST_CODE
68    or die $@;
69}
70