t/finally.t

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