1use strict; 2use warnings; 3BEGIN { $Test2::API::DO_DEPTH_CHECK = 1 } 4use Test2::Tools::Tiny; 5 6use Test2::API qw/context/; 7 8skip_all("known to fail on $]") if $] le "5.006002"; 9 10sub outer { 11 my $code = shift; 12 my $ctx = context(); 13 14 $ctx->note("outer"); 15 16 my $out = eval { $code->() }; 17 18 $ctx->release; 19 20 return $out; 21} 22 23sub dies { 24 my $ctx = context(); 25 $ctx->note("dies"); 26 die "Foo"; 27} 28 29sub bad_store { 30 my $ctx = context(); 31 $ctx->note("bad store"); 32 return $ctx; # Emulate storing it somewhere 33} 34 35sub bad_simple { 36 my $ctx = context(); 37 $ctx->note("bad simple"); 38 return; 39} 40 41my @warnings; 42{ 43 local $SIG{__WARN__} = sub { push @warnings => @_ }; 44 eval { dies() }; 45} 46ok(!@warnings, "no warnings") || diag @warnings; 47 48@warnings = (); 49my $keep = bad_store(); 50eval { my $x = 1 }; # Ensure an eval changing $@ does not meddle. 51{ 52 local $SIG{__WARN__} = sub { push @warnings => @_ }; 53 ok(1, "random event"); 54} 55ok(@warnings, "got warnings"); 56like( 57 $warnings[0], 58 qr/context\(\) was called to retrieve an existing context/, 59 "got expected warning" 60); 61$keep = undef; 62 63{ 64 @warnings = (); 65 local $SIG{__WARN__} = sub { push @warnings => @_ }; 66 bad_simple(); 67} 68ok(@warnings, "got warnings"); 69like( 70 $warnings[0], 71 qr/A context appears to have been destroyed without first calling release/, 72 "got expected warning" 73); 74 75@warnings = (); 76outer(\&dies); 77{ 78 local $SIG{__WARN__} = sub { push @warnings => @_ }; 79 ok(1, "random event"); 80} 81ok(!@warnings, "no warnings") || diag @warnings; 82 83 84 85@warnings = (); 86{ 87 local $SIG{__WARN__} = sub { push @warnings => @_ }; 88 outer(\&bad_store); 89} 90ok(@warnings, "got warnings"); 91like( 92 $warnings[0], 93 qr/A context appears to have been destroyed without first calling release/, 94 "got expected warning" 95); 96 97 98 99{ 100 @warnings = (); 101 local $SIG{__WARN__} = sub { push @warnings => @_ }; 102 outer(\&bad_simple); 103} 104ok(@warnings, "got warnings") || diag @warnings; 105like( 106 $warnings[0], 107 qr/A context appears to have been destroyed without first calling release/, 108 "got expected warning" 109); 110 111 112 113done_testing; 114