1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 require './test.pl'; 7} 8 9plan tests => 19; 10 11eval { 12 eval { 13 die "Horribly\n"; 14 }; 15 die if $@; 16}; 17 18like($@, '^Horribly', 'die with no args propagates $@'); 19like($@, 'propagated', '... and appends a phrase'); 20 21{ 22 local $SIG{__DIE__} = sub { is( $_[0], "[\000]\n", 'Embedded null passed to signal handler' )}; 23 24 $err = "[\000]\n"; 25 eval { 26 die $err; 27 }; 28 is( $@, $err, 'Embedded null passed back into $@' ); 29} 30 31{ 32 local $SIG{__DIE__} = sub { 33 isa_ok( $_[0], 'ARRAY', 'pass an array ref as an argument' ); 34 $_[0]->[0]++; 35 }; 36 $x = [3]; 37 eval { die $x; }; 38 39 is( $x->[0], 4, 'actual array, not a copy, passed to signal handler' ); 40 41 eval { 42 eval { 43 die [ 5 ]; 44 }; 45 die if $@; 46 }; 47 48 is($@->[0], 7, 'die with no arguments propagates $@, but leaves references alone'); 49 50 eval { 51 eval { 52 die bless [ 7 ], "Error"; 53 }; 54 isa_ok( $@, 'Error', '$@ is an Error object' ); 55 die if $@; 56 }; 57 58 isa_ok( $@, 'Out', 'returning a different object than what was passed in, via PROPAGATE' ); 59 is($@->[0], 9, 'reference returned correctly'); 60} 61 62{ 63 package Error; 64 65 sub PROPAGATE { 66 bless [$_[0]->[0]], "Out"; 67 } 68} 69 70 71{ 72 # die/warn and utf8 73 use utf8; 74 local $SIG{__DIE__}; 75 my $msg = "ce ºtii tu, bã ?\n"; 76 eval { die $msg }; 77 is( $@, $msg, "Literal passed to die" ); 78 our $err; 79 local $SIG{__WARN__} = $SIG{__DIE__} = sub { $err = shift }; 80 eval { die $msg }; 81 is( $err, $msg, 'die handler with utf8' ); 82 eval { warn $msg }; 83 is( $err, $msg, 'warn handler with utf8' ); 84 eval qq/ use strict; \$\x{3b1} /; 85 like( $@, qr/Global symbol "\$\x{3b1}"/, 'utf8 symbol names show up in $@' ); 86} 87 88# [perl #36470] got uninit warning if $@ was undef 89 90{ 91 use warnings "uninitialized"; 92 my $ok = 1; 93 local $SIG{__DIE__}; 94 local $SIG{__WARN__} = sub { $ok = 0 }; 95 eval { undef $@; die }; 96 is( $ok, 1, 'no warnings if $@ is undef' ); 97} 98