r51481 - in /branches/upstream/libtry-tiny-perl/current: Changes MANIFEST META.yml SIGNATURE lib/Try/Tiny.pm t/basic.t t/finally.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sun Jan 24 18:12:31 UTC 2010
Author: jawnsy-guest
Date: Sun Jan 24 18:12:24 2010
New Revision: 51481
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=51481
Log:
[svn-upgrade] Integrating new upstream version, libtry-tiny-perl (0.04)
Added:
branches/upstream/libtry-tiny-perl/current/t/finally.t
Modified:
branches/upstream/libtry-tiny-perl/current/Changes
branches/upstream/libtry-tiny-perl/current/MANIFEST
branches/upstream/libtry-tiny-perl/current/META.yml
branches/upstream/libtry-tiny-perl/current/SIGNATURE
branches/upstream/libtry-tiny-perl/current/lib/Try/Tiny.pm
branches/upstream/libtry-tiny-perl/current/t/basic.t
Modified: branches/upstream/libtry-tiny-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtry-tiny-perl/current/Changes?rev=51481&op=diff
==============================================================================
--- branches/upstream/libtry-tiny-perl/current/Changes (original)
+++ branches/upstream/libtry-tiny-perl/current/Changes Sun Jan 24 18:12:24 2010
@@ -1,3 +1,13 @@
+0.04
+ - Restore list context propagation for catch blocks
+ - Fix a bug where finally blocks weren't always invoked
+
+0.03
+ - Support for 'finally' blocks (Andy Yates)
+ - More documentation and tests (many people)
+ - Sets $@ to the previous value at the beginning of the eval, to allow
+ the capture of an error stack when calling die.
+
0.02
- Doc fixes from chromatic
- Various minor fixes from Adam Kennedy
Modified: branches/upstream/libtry-tiny-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtry-tiny-perl/current/MANIFEST?rev=51481&op=diff
==============================================================================
--- branches/upstream/libtry-tiny-perl/current/MANIFEST (original)
+++ branches/upstream/libtry-tiny-perl/current/MANIFEST Sun Jan 24 18:12:24 2010
@@ -4,6 +4,7 @@
MANIFEST This list of files
MANIFEST.SKIP
t/basic.t
+t/finally.t
t/when.t
META.yml Module meta-data (added by MakeMaker)
SIGNATURE Public-key signature (added by MakeMaker)
Modified: branches/upstream/libtry-tiny-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtry-tiny-perl/current/META.yml?rev=51481&op=diff
==============================================================================
--- branches/upstream/libtry-tiny-perl/current/META.yml (original)
+++ branches/upstream/libtry-tiny-perl/current/META.yml Sun Jan 24 18:12:24 2010
@@ -1,13 +1,21 @@
--- #YAML:1.0
-name: Try-Tiny
-version: 0.02
-abstract: ~
-license: ~
-author: ~
-generated_by: ExtUtils::MakeMaker version 6.42
-distribution_type: module
-requires:
- Test::More: 0
+name: Try-Tiny
+version: 0.04
+abstract: ~
+author: []
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ Test::More: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.55_02
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: branches/upstream/libtry-tiny-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtry-tiny-perl/current/SIGNATURE?rev=51481&op=diff
==============================================================================
--- branches/upstream/libtry-tiny-perl/current/SIGNATURE (original)
+++ branches/upstream/libtry-tiny-perl/current/SIGNATURE Sun Jan 24 18:12:24 2010
@@ -1,5 +1,5 @@
This file contains message digests of all files listed in MANIFEST,
-signed via the Module::Signature module, version 0.55.
+signed via the Module::Signature module, version 0.61.
To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:
@@ -14,18 +14,19 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 d150077b59fe9b327023d1b32e746c8fff661983 Changes
-SHA1 0f7f01d0d9d133529eccfe396cf4c71a37a197ad MANIFEST
+SHA1 6ac3ace209467c2102863c6b598da0f6d9cb019a Changes
+SHA1 ddef902deeadd5075a417ba50041f8ffc9ca8a5b MANIFEST
SHA1 606bd6424682249397d63caf905f651178a4d6cc MANIFEST.SKIP
-SHA1 85e16f502eb5ec72cccd91a8e25fdaf4fe88a3e1 META.yml
+SHA1 1a2378a6084537f42285b7faed60da0aec42f952 META.yml
SHA1 6adc37b24473f070c318abfe77a8531fbf1eefca Makefile.PL
-SHA1 10edc1903fdbc5a81a28b05a5a33ce3da9bc11bb lib/Try/Tiny.pm
-SHA1 85cdb50e91e46c74bdff5a3c147655e060190c76 t/basic.t
+SHA1 d9d03f47653d6a711bf02869ea7a1572875641f7 lib/Try/Tiny.pm
+SHA1 f87be39d1cb320cd0ac206143f59accdecf21814 t/basic.t
+SHA1 567bd02fb537a942cb00333bf6f31981c20532bb t/finally.t
SHA1 c75ffed79f4936105b81aa82443b0a0a87c78873 t/when.t
-----BEGIN PGP SIGNATURE-----
-Version: GnuPG v1.4.7 (Darwin)
+Version: GnuPG/MacGPG2 v2.0.12 (Darwin)
-iD8DBQFKnq77VCwRwOvSdBgRAnU4AJ9TFIkNbNVAWKADeeH2E5Ug4lyC7gCfeoZu
-Bh881ePwvmPrrFSNPhgVlhM=
-=vbpJ
+iEYEARECAAYFAktaBXIACgkQVCwRwOvSdBhnggCgtF8boUpi3GEqoj1+MQf3vra9
+K/QAnjnS+6aScM4HHAx91kjWf7pUhl3L
+=jGZm
-----END PGP SIGNATURE-----
Modified: branches/upstream/libtry-tiny-perl/current/lib/Try/Tiny.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtry-tiny-perl/current/lib/Try/Tiny.pm?rev=51481&op=diff
==============================================================================
--- branches/upstream/libtry-tiny-perl/current/lib/Try/Tiny.pm (original)
+++ branches/upstream/libtry-tiny-perl/current/lib/Try/Tiny.pm Sun Jan 24 18:12:24 2010
@@ -10,22 +10,50 @@
@ISA = qw(Exporter);
}
-$VERSION = "0.02";
+$VERSION = "0.04";
$VERSION = eval $VERSION;
- at EXPORT = @EXPORT_OK = qw(try catch);
-
-sub try (&;$) {
- my ( $try, $catch ) = @_;
+ at EXPORT = @EXPORT_OK = qw(try catch finally);
+
+$Carp::Internal{+__PACKAGE__}++;
+
+# Need to prototype as @ not $$ because of the way Perl evaluates the prototype.
+# Keeping it at $$ means you only ever get 1 sub because we need to eval in a list
+# context & not a scalar one
+
+sub try (&;@) {
+ my ( $try, @code_refs ) = @_;
# we need to save this here, the eval block will be in scalar context due
# to $failed
my $wantarray = wantarray;
+ my ( $catch, $finally );
+
+ # find labeled blocks in the argument list.
+ # catch and finally tag the blocks by blessing a scalar reference to them.
+ foreach my $code_ref (@code_refs) {
+ next unless $code_ref;
+
+ my $ref = ref($code_ref);
+
+ if ( $ref eq 'Try::Tiny::Catch' ) {
+ $catch = ${$code_ref};
+ } elsif ( $ref eq 'Try::Tiny::Finally' ) {
+ $finally = ${$code_ref};
+ } else {
+ use Carp;
+ confess("Unknown code ref type given '${ref}'. Check your usage & try again");
+ }
+ }
+
+ # save the value of $@ so we can set $@ back to it in the beginning of the eval
+ my $prev_error = $@;
+
my ( @ret, $error, $failed );
- # FIXME consider using local $SIG{__DIE__} to accumilate all errors. It's
+ # FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's
# not perfect, but we could provide a list of additional errors for
# $catch->();
@@ -37,6 +65,7 @@
# failed will be true if the eval dies, because 1 will not be returned
# from the eval body
$failed = not eval {
+ $@ = $prev_error;
# evaluate the try block in the correct context
if ( $wantarray ) {
@@ -50,13 +79,16 @@
return 1; # properly set $fail to false
};
- # copy $@ to $error, when we leave this scope local $@ will revert $@
+ # copy $@ to $error; when we leave this scope, local $@ will revert $@
# back to its previous value
$error = $@;
}
- # at this point $failed contains a true value if the eval died even if some
- # destructor overwrite $@ as the eval was unwinding.
+ # set up a scope guard to invoke the finally block at the end
+ my $guard = $finally && bless \$finally, "Try::Tiny::ScopeGuard";
+
+ # at this point $failed contains a true value if the eval died, even if some
+ # destructor overwrote $@ as the eval was unwinding.
if ( $failed ) {
# if we got an error, invoke the catch block.
if ( $catch ) {
@@ -77,10 +109,28 @@
}
}
-sub catch (&) {
- return $_[0];
+sub catch (&;@) {
+ my ( $block, @rest ) = @_;
+
+ return (
+ bless(\$block, 'Try::Tiny::Catch'),
+ @rest,
+ );
}
+sub finally (&;@) {
+ my ( $block, @rest ) = @_;
+
+ return (
+ bless(\$block, 'Try::Tiny::Finally'),
+ @rest,
+ );
+}
+
+sub Try::Tiny::ScopeGuard::DESTROY {
+ my $self = shift;
+ $$self->();
+}
__PACKAGE__
@@ -108,7 +158,7 @@
=head1 DESCRIPTION
-This module provides bare bones C<try>/C<catch> statements that are designed to
+This module provides bare bones C<try>/C<catch>/C<finally> statements that are designed to
minimize common mistakes with eval blocks, and NOTHING else.
This is unlike L<TryCatch> which provides a nice syntax and avoids adding
@@ -126,18 +176,37 @@
pathological edge cases (see L<BACKGROUND>) and to be compatible with any style
of error values (simple strings, references, objects, overloaded objects, etc).
+If the try block dies, it returns the value of the last statement executed in
+the catch block, if there is one. Otherwise, it returns C<undef> in scalar
+context or the empty list in list context. The following two examples both
+assign C<"bar"> to C<$x>.
+
+ my $x = try { die "foo" } catch { "bar" };
+
+ my $x = eval { die "foo" } || "bar";
+
+You can add finally blocks making the following true.
+
+ my $x;
+ try { die 'foo' } finally { $x = 'bar' };
+ try { die 'foo' } catch { warn "Got a die: $_" } finally { $x = 'bar' };
+
+Finally blocks are always executed making them suitable for cleanup code
+which cannot be handled using local.
+
=head1 EXPORTS
All functions are exported by default using L<Exporter>.
-In the future L<Sub::Exporter> may be used to allow the keywords to be renamed,
-but this technically does not satisfy Adam Kennedy's definition of "Tiny".
+If you need to rename the C<try>, C<catch> or C<finally> keyword consider using
+L<Sub::Import> to get L<Sub::Exporter>'s flexibility.
=over 4
-=item try (&;$)
-
-Takes one mandatory try subroutine and one optional catch subroutine.
+=item try (&;@)
+
+Takes one mandatory try subroutine, an optional catch subroutine & finally
+subroutine.
The mandatory subroutine is evaluated in the context of an C<eval> block.
@@ -149,19 +218,52 @@
argument.
Note that the error may be false, but if that happens the C<catch> block will
-still be invoked..
-
-=item catch (&)
+still be invoked.
+
+Once all execution is finished then the finally block if given will execute.
+
+=item catch (&;$)
Intended to be used in the second argument position of C<try>.
-Just returns the subroutine it was given.
+Returns a reference to the subroutine it was given but blessed as
+C<Try::Tiny::Catch> which allows try to decode correctly what to do
+with this code reference.
catch { ... }
-is the same as
-
- sub { ... }
+Inside the catch block the previous value of C<$@> is still available for use.
+This value may or may not be meaningful depending on what happened before the
+C<try>, but it might be a good idea to preserve it in an error stack.
+
+=item finally (&;$)
+
+ try { ... }
+ catch { ... }
+ finally { ... };
+
+Or
+
+ try { ... }
+ finally { ... };
+
+Or even
+
+ try { ... }
+ finally { ... }
+ catch { ... };
+
+Intended to be the second or third element of C<try>. Finally blocks are always
+executed in the event of a successful C<try> or if C<catch> is run. This allows
+you to locate cleanup code which cannot be done via C<local()> e.g. closing a file
+handle.
+
+B<You must always do your own error handling in the finally block>. C<Try::Tiny> will
+not do anything about handling possible errors coming from code located in these
+blocks.
+
+In the same way C<catch()> blesses the code reference this subroutine does the same
+except it bless them as C<Try::Tiny::Finally>.
=back
@@ -180,12 +282,19 @@
C<$@> must be properly localized before invoking C<eval> in order to avoid this
issue.
+More specifically, C<$@> is clobbered at the begining of the C<eval>, which
+also makes it impossible to capture the previous error before you die (for
+instance when making exception objects with error stacks).
+
+For this reason C<try> will actually set C<$@> to its previous value (before
+the localization) in the beginning of the C<eval> block.
+
=head2 Localizing $@ silently masks errors
Inside an eval block C<die> behaves sort of like:
sub die {
- $@_ = $_[0];
+ $@ = $_[0];
return_undef_from_eval();
}
@@ -213,8 +322,8 @@
because due to the previous caveats it may have been unset.
-C<$@> could also an overloaded error object that evaluates to false, but that's
-asking for trouble anyway.
+C<$@> could also be an overloaded error object that evaluates to false, but
+that's asking for trouble anyway.
The classic failure mode is:
@@ -233,7 +342,7 @@
}
In this case since C<Object::DESTROY> is not localizing C<$@> but still uses
-C<eval> it will set C<$@> to C<"">.
+C<eval>, it will set C<$@> to C<"">.
The destructor is called when the stack is unwound, after C<die> sets C<$@> to
C<"foo at Foo.pm line 42\n">, so by the time C<if ( $@ )> is evaluated it has
@@ -276,15 +385,53 @@
=item *
+C<@_> is not available, you need to name your args:
+
+ sub foo {
+ my ( $self, @args ) = @_;
+ try { $self->bar(@args) }
+ }
+
+=item *
+
+C<return> returns from the C<try> block, not from the parent sub (note that
+this is also how C<eval> works, but not how L<TryCatch> works):
+
+ sub bar {
+ try { return "foo" };
+ return "baz";
+ }
+
+ say bar(); # "baz"
+
+=item *
+
C<try> introduces another caller stack frame. L<Sub::Uplevel> is not used. L<Carp>
will report this when using full stack traces. This lack of magic is considered
a feature.
=item *
-The value of C<$_> in the C<catch> block is not guaranteed to be preserved,
-there is no safe way to ensure this if C<eval> is used unhygenically in
-destructors. It's only guaranteeed that the C<catch> will be called.
+The value of C<$_> in the C<catch> block is not guaranteed to be the value of
+the exception thrown (C<$@>) in the C<try> block. There is no safe way to
+ensure this, since C<eval> may be used unhygenically in destructors. The only
+guarantee is that the C<catch> will be called if an exception is thrown.
+
+=item *
+
+The return value of the C<catch> block is not ignored, so if testing the result
+of the expression for truth on success, be sure to return a false value from
+the C<catch> block:
+
+ my $obj = try {
+ MightFail->new;
+ } catch {
+ ...
+
+ return; # avoid returning a true value;
+ };
+
+ return unless $obj;
=back
@@ -317,9 +464,20 @@
responsibility.
The C<try> keyword pushes C<$@> onto an error stack, avoiding some of the
-issues with C<$@> but you still need to localize to prevent clobbering.
+issues with C<$@>, but you still need to localize to prevent clobbering.
=back
+
+=head1 LIGHTNING TALK
+
+I gave a lightning talk about this module, you can see the slides (Firefox
+only):
+
+L<http://nothingmuch.woobling.org/talks/takahashi.xul?data=try_tiny.txt>
+
+Or read the source:
+
+L<http://nothingmuch.woobling.org/talks/yapc_asia_2009/try_tiny.yml>
=head1 VERSION CONTROL
Modified: branches/upstream/libtry-tiny-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtry-tiny-perl/current/t/basic.t?rev=51481&op=diff
==============================================================================
--- branches/upstream/libtry-tiny-perl/current/t/basic.t (original)
+++ branches/upstream/libtry-tiny-perl/current/t/basic.t Sun Jan 24 18:12:24 2010
@@ -3,7 +3,7 @@
use strict;
#use warnings;
-use Test::More tests => 15;
+use Test::More tests => 26;
BEGIN { use_ok 'Try::Tiny' };
@@ -39,6 +39,8 @@
}
+my $prev;
+
lives_ok {
try {
die "foo";
@@ -70,9 +72,47 @@
is( $@, "magic", '$@ untouched' );
}
-is( scalar(try { "foo", "bar", "gorch" }), "gorch", "scalar context" );
-is_deeply( [ try {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context" );
+is( scalar(try { "foo", "bar", "gorch" }), "gorch", "scalar context try" );
+is_deeply( [ try {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context try" );
+is( scalar(try { die } catch { "foo", "bar", "gorch" }), "gorch", "scalar context catch" );
+is_deeply( [ try { die } catch {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context catch" );
+
+
+{
+ my ($sub) = catch { my $a = $_; };
+ is(ref($sub), 'Try::Tiny::Catch', 'Checking catch subroutine scalar reference is correctly blessed');
+ my ($sub) = finally { my $a = $_; };
+ is(ref($sub), 'Try::Tiny::Finally', 'Checking finally subroutine scalar reference is correctly blessed');
+}
+
+lives_ok {
+ try {
+ die "foo";
+ } catch {
+ my $err = shift;
+
+ try {
+ like $err, qr/foo/;
+ } catch {
+ fail("shouldn't happen");
+ };
+
+ pass "got here";
+ }
+} "try in try catch block";
+
+throws_ok {
+ try {
+ die "foo";
+ } catch {
+ my $err = shift;
+
+ try { } catch { };
+
+ die "rethrowing $err";
+ }
+} qr/rethrowing foo/, "rethrow with try in catch block";
sub Evil::DESTROY {
@@ -97,3 +137,27 @@
is( $@, "magic", '$@ untouched' );
is( $_, "other magic", '$_ untouched' );
}
+
+{
+ my ( $caught, $prev );
+
+ {
+ local $@;
+
+ eval { die "bar\n" };
+
+ is( $@, "bar\n", 'previous value of $@' );
+
+ try {
+ die {
+ prev => $@,
+ }
+ } catch {
+ $caught = $_;
+ $prev = $@;
+ }
+ }
+
+ is_deeply( $caught, { prev => "bar\n" }, 'previous value of $@ available for capture' );
+ is( $prev, "bar\n", 'previous value of $@ also available in catch block' );
+}
Added: branches/upstream/libtry-tiny-perl/current/t/finally.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtry-tiny-perl/current/t/finally.t?rev=51481&op=file
==============================================================================
--- branches/upstream/libtry-tiny-perl/current/t/finally.t (added)
+++ branches/upstream/libtry-tiny-perl/current/t/finally.t Sun Jan 24 18:12:24 2010
@@ -1,0 +1,42 @@
+#!/usr/bin/perl
+
+use strict;
+#use warnings;
+
+use Test::More tests => 8;
+
+BEGIN { use_ok 'Try::Tiny' };
+
+try {
+ my $a = 1+1;
+} catch {
+ fail('Cannot go into catch block because we did not throw an exception')
+} finally {
+ pass('Moved into finally from try');
+};
+
+try {
+ die('Die');
+} catch {
+ ok($_ =~ /Die/, 'Error text as expected');
+ pass('Into catch block as we died in try');
+} finally {
+ pass('Moved into finally from catch');
+};
+
+try {
+ die('Die');
+} finally {
+ pass('Moved into finally from catch');
+} catch {
+ ok($_ =~ /Die/, 'Error text as expected');
+};
+
+try {
+ die('Die');
+} finally {
+ pass('Moved into finally block when try throws an exception and we have no catch block');
+};
+
+
+1;
More information about the Pkg-perl-cvs-commits
mailing list