t/finally.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 30;
   5 use Try::Tiny;
   6
   7 try {
   8   my $a = 1+1;
   9 } catch {
  10   fail('Cannot go into catch block because we did not throw an exception')
  11 } finally {
  12   pass('Moved into finally from try');
  13 };
  14
  15 try {
  16   die('Die');
  17 } catch {
  18   ok($_ =~ /Die/, 'Error text as expected');
  19   pass('Into catch block as we died in try');
  20 } finally {
  21   pass('Moved into finally from catch');
  22 };
  23
  24 try {
  25   die('Die');
  26 } finally {
  27   pass('Moved into finally from catch');
  28 } catch {
  29   ok($_ =~ /Die/, 'Error text as expected');
  30 };
  31
  32 try {
  33   die('Die');
  34 } finally {
  35   pass('Moved into finally block when try throws an exception and we have no catch block');
  36 };
  37
  38 try {
  39   die('Die');
  40 } finally {
  41   pass('First finally clause run');
  42 } finally {
  43   pass('Second finally clause run');
  44 };
  45
  46 try {
  47   # do not die
  48 } finally {
  49   if (@_) {
  50     fail("errors reported: @_");
  51   } else {
  52     pass("no error reported") ;
  53   }
  54 };
  55
  56 try {
  57   die("Die\n");
  58 } finally {
  59   is_deeply(\@_, [ "Die\n" ], "finally got passed the exception");
  60 };
  61
  62 try {
  63   try {
  64     die "foo";
  65   }
  66   catch {
  67     die "bar";
  68   }
  69   finally {
  70     pass("finally called");
  71   };
  72 };
  73
  74 $_ = "foo";
  75 try {
  76   is($_, "foo", "not localized in try");
  77 }
  78 catch {
  79 }
  80 finally {
  81   is(scalar(@_), 0, "nothing in \@_ (finally)");
  82   is($_, "foo", "\$_ not localized (finally)");
  83 };
  84 is($_, "foo", "same afterwards");
  85
  86 $_ = "foo";
  87 try {
  88   is($_, "foo", "not localized in try");
  89   die "bar\n";
  90 }
  91 catch {
  92   is($_[0], "bar\n", "error in \@_ (catch)");
  93   is($_, "bar\n", "error in \$_ (catch)");
  94 }
  95 finally {
  96   is(scalar(@_), 1, "error in \@_ (finally)");
  97   is($_[0], "bar\n", "error in \@_ (finally)");
  98   is($_, "foo", "\$_ not localized (finally)");
  99 };
 100 is($_, "foo", "same afterwards");
 101
 102 {
 103   my @warnings;
 104   local $SIG{__WARN__} = sub {
 105     $_[0] =~ /\QExecution of finally() block CODE(0x\E.+\Q) resulted in an exception/
 106       ? push @warnings, @_
 107       : warn @_
 108   };
 109
 110   try {
 111     die 'tring'
 112   } finally {
 113     die 'fin 1'
 114   } finally {
 115     pass('fin 2 called')
 116   } finally {
 117     die 'fin 3'
 118   };
 119
 120   is( scalar @warnings, 2, 'warnings from both fatal finally blocks' );
 121
 122   my @originals = sort map { $_ =~ /Original exception text follows:\n\n(.+)/s } @warnings;
 123
 124   like $originals[0], qr/fin 1 at/, 'First warning contains original exception';
 125   like $originals[1], qr/fin 3 at/, 'Second warning contains original exception';
 126 }
 127
 128 {
 129   my $finally;
 130   SKIP: {
 131     try {
 132       pass('before skip in try');
 133       skip 'whee', 1;
 134       fail('not reached');
 135     } finally {
 136       $finally = 1;
 137     };
 138   }
 139   ok $finally, 'finally ran';
 140 }