From: Peter Rabbitson <ribasushi@cpan.org>
Date: Thu, 4 Jul 2013 08:25:02 +0000 (+0200)
Subject: Make sure users are properly notified of (useless) exceptions in finally blocks
X-Git-Tag: Try-Tiny-0.13~6^2~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5f5e92c0e36725a449c010c445eba40589ac8bf6;p=p5sagit%2FTry-Tiny.git

Make sure users are properly notified of (useless) exceptions in finally blocks

It is possible to rewrite Try::Tiny to invoke the finally blocks without
the use of scope guards, however to do this an extra eval frame around
catch will have to be introduced. Furthermore code in the wild may rely
on the "ignorance" of a finally() exception.

In short - the proper fix may no longer be feasible due to backcompat
issues, therefore the current warning seems like the only feasible
compromise.
---

diff --git a/Changes b/Changes
index 840f0b3..2b18bc3 100644
--- a/Changes
+++ b/Changes
@@ -7,6 +7,7 @@
   - clarify exception occuring on unterminated try block (RT#75712)
   - fix the prototypes shown in docs to match code (RT#79590; thanks, Pushtaev
     Vadim)
+  - warn loudly on exceptions in finally() blocks
 
 0.12
   - doc fixes
diff --git a/lib/Try/Tiny.pm b/lib/Try/Tiny.pm
index 54d3417..3331660 100644
--- a/lib/Try/Tiny.pm
+++ b/lib/Try/Tiny.pm
@@ -127,15 +127,30 @@ sub finally (&;@) {
   package # hide from PAUSE
     Try::Tiny::ScopeGuard;
 
+  use constant UNSTABLE_DOLLARAT => ($] < '5.013002') ? 1 : 0;
+
   sub _new {
     shift;
     bless [ @_ ];
   }
 
   sub DESTROY {
-    my @guts = @{ shift() };
-    my $code = shift @guts;
-    $code->(@guts);
+    my ($code, @args) = @{ $_[0] };
+
+    local $@ if UNSTABLE_DOLLARAT;
+    eval {
+      $code->(@args);
+      1;
+    } or do {
+      warn
+        "Execution of finally() block $code resulted in an exception, which "
+      . '*CAN NOT BE PROPAGATED* due to fundamental limitations of Perl. '
+      . 'Your program will continue as if this event never took place. '
+      . "Original exception text follows:\n\n"
+      . (defined $@ ? $@ : '$@ left undefined...')
+      . "\n"
+      ;
+    }
   }
 }
 
@@ -306,6 +321,11 @@ B<You must always do your own error handling in the C<finally> block>. C<Try::Ti
 not do anything about handling possible errors coming from code located in these
 blocks.
 
+Furthermore B<exceptions in C<finally> blocks are not trappable and are unable
+to influence the execution of your program>. This is due to limitation of
+C<DESTROY>-based scope guards, which C<finally> is implemented on top of. This
+may change in a future version of Try::Tiny.
+
 In the same way C<catch()> blesses the code reference this subroutine does the same
 except it bless them as C<Try::Tiny::Finally>.
 
diff --git a/t/finally.t b/t/finally.t
index 789d80c..1c969de 100644
--- a/t/finally.t
+++ b/t/finally.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 24;
+use Test::More tests => 28;
 
 BEGIN { use_ok 'Try::Tiny' };
 
@@ -101,4 +101,31 @@ finally {
   is($_, "foo", "\$_ not localized (finally)");
 };
 is($_, "foo", "same afterwards");
+
+{
+  my @warnings;
+  local $SIG{__WARN__} = sub {
+    $_[0] =~ /\QExecution of finally() block CODE(0x\E.+\Q) resulted in an exception/
+      ? push @warnings, @_
+      : warn @_
+  };
+
+  try {
+    die 'tring'
+  } finally {
+    die 'fin 1'
+  } finally {
+    pass('fin 2 called')
+  } finally {
+    die 'fin 3'
+  };
+
+  is( scalar @warnings, 2, 'warnings from both fatal finally blocks' );
+
+  my @originals = sort map { $_ =~ /Original exception text follows:\n\n(.+)/s } @warnings;
+
+  like $originals[0], qr/fin 1 at/, 'First warning contains original exception';
+  like $originals[1], qr/fin 3 at/, 'Second warning contains original exception';
+}
+
 1;