svleak.t: Disable crashing test

[perl5.git] / t / op / die.t

diff --git a/t/op/die.t b/t/op/die.t
index 0ed4983..ef2b85f 100644 (file)
--- a/t/op/die.t
+++ b/t/op/die.t
@@ -2,11 +2,21 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
-plan tests => 14;
+plan tests => 20;
+
+eval {
+    eval {
+       die "Horribly\n";
+    };
+    die if $@;
+};
+
+like($@, qr/^Horribly/, 'die with no args propagates $@');
+like($@, qr/\.{3}propagated at/, '... and appends a phrase');
 
 {
     local $SIG{__DIE__} = sub { is( $_[0], "[\000]\n", 'Embedded null passed to signal handler' )};
@@ -19,30 +29,14 @@ plan tests => 14;
 }
 
 {
-    local $SIG{__DIE__} = sub { isa_ok( $_[0], 'ARRAY', 'pass an array ref as an argument' ); };
+    local $SIG{__DIE__} = sub {
+       isa_ok( $_[0], 'ARRAY', 'pass an array ref as an argument' );
+       $_[0]->[0]++;
+    };
     $x = [3];
     eval { die $x; };
 
-    $SIG{__DIE__} = sub { $_[0]->[0]++; } ;
-    $x = [3];
-    eval { die $x; };
     is( $x->[0], 4, 'actual array, not a copy, passed to signal handler' );
-}
-
-$SIG{__DIE__} = 'DEFAULT';
-
-eval {
-    eval {
-       die "Horribly\n";
-    };
-    die if $@;
-};
-
-like($@, '^Horribly', 'die with no args propagates $@');
-like($@, 'propagated', '... and appends a phrase');
-
-{
-    local $SIG{__DIE__} = sub { $_[0]->[0]++ };
 
     eval {
         eval {
@@ -52,6 +46,17 @@ like($@, 'propagated', '... and appends a phrase');
     };
 
     is($@->[0], 7, 'die with no arguments propagates $@, but leaves references alone');
+
+    eval {
+       eval {
+           die bless [ 7 ], "Error";
+       };
+       isa_ok( $@, 'Error', '$@ is an Error object' );
+       die if $@;
+    };
+
+    isa_ok( $@, 'Out', 'returning a different object than what was passed in, via PROPAGATE' );
+    is($@->[0], 9, 'reference returned correctly');
 }
 
 {
@@ -62,15 +67,6 @@ like($@, 'propagated', '... and appends a phrase');
     }
 }
 
-eval {
-    eval {
-       die bless [ 7 ], "Error";
-    };
-    isa_ok( $@, 'Error', '$@ is an Error object' );
-    die if $@;
-};
-
-isa_ok( $@, 'Out', 'returning a different object than what was passed in, via PROPAGATE' );
 
 {
     # die/warn and utf8
@@ -92,9 +88,17 @@ isa_ok( $@, 'Out', 'returning a different object than what was passed in, via PR
 # [perl #36470] got uninit warning if $@ was undef
 
 {
+    use warnings "uninitialized";
     my $ok = 1;
     local $SIG{__DIE__};
     local $SIG{__WARN__} = sub { $ok = 0 };
     eval { undef $@; die };
     is( $ok, 1, 'no warnings if $@ is undef' );
 }
+
+TODO: {
+    local $TODO = 'RT #4821: die qr{x} does not check termination';
+    my $out = runperl(prog => 'die qr{x}', stderr => 1);
+    like($out, qr/at -e line 1./, 'RT #4821: output from die qr{x}');
+}
+