t/finally.t

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