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