r39019 - in /branches/upstream/libautodie-perl/current: ./ lib/ lib/autodie/ lib/autodie/exception/ t/ t/lib/Some/ t/lib/my/
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Wed Jul 1 08:11:21 UTC 2009
Author: angelabad-guest
Date: Wed Jul 1 08:10:59 2009
New Revision: 39019
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=39019
Log:
[svn-upgrade] Integrating new upstream version, libautodie-perl (2.03)
Added:
branches/upstream/libautodie-perl/current/t/blog_hints.t (with props)
branches/upstream/libautodie-perl/current/t/lib/Some/
branches/upstream/libautodie-perl/current/t/lib/Some/Module.pm
branches/upstream/libautodie-perl/current/t/lib/my/
branches/upstream/libautodie-perl/current/t/lib/my/autodie.pm
Modified:
branches/upstream/libautodie-perl/current/Changes
branches/upstream/libautodie-perl/current/MANIFEST
branches/upstream/libautodie-perl/current/META.yml
branches/upstream/libautodie-perl/current/lib/Fatal.pm
branches/upstream/libautodie-perl/current/lib/autodie.pm
branches/upstream/libautodie-perl/current/lib/autodie/exception.pm
branches/upstream/libautodie-perl/current/lib/autodie/exception/system.pm
branches/upstream/libautodie-perl/current/lib/autodie/hints.pm
branches/upstream/libautodie-perl/current/t/basic_exceptions.t
branches/upstream/libautodie-perl/current/t/hints.t
Modified: branches/upstream/libautodie-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautodie-perl/current/Changes?rev=39019&op=diff
==============================================================================
--- branches/upstream/libautodie-perl/current/Changes (original)
+++ branches/upstream/libautodie-perl/current/Changes Wed Jul 1 08:10:59 2009
@@ -1,4 +1,23 @@
Revision history for autodie
+
+2.03 Wed Jul 1 15:39:16 AUSEST 2009
+
+ * BUGFIX: Stopped blog_hints.t from booching under Perl
+ 5.8.x. because parent.pm is not installed.
+
+2.02 Wed Jul 1 15:06:21 AUSEST 2009
+
+ * FEATURE: autodie::exception now supports ->context() to
+ discover the context of the failing subroutine, and
+ ->return() to get a list of what it returned.
+
+ * BUGFIX: ->function from autodie::exception now returns
+ the original name of the dying sub, rather than its imported
+ name. For example, 'File::Copy::copy' rather than 'main::copy'.
+ Core functions continue to always return 'CORE::whatever'.
+
+ * TEST: blog_hints.t tests new hinting features against
+ examples in my blog at http://pjf.id.au/blog/
2.01 Wed Jul 1 01:31:24 AUSEST 2009
Modified: branches/upstream/libautodie-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautodie-perl/current/MANIFEST?rev=39019&op=diff
==============================================================================
--- branches/upstream/libautodie-perl/current/MANIFEST (original)
+++ branches/upstream/libautodie-perl/current/MANIFEST Wed Jul 1 08:10:59 2009
@@ -23,6 +23,7 @@
t/backcompat.t
t/basic_exceptions.t
t/binmode.t
+t/blog_hints.t
t/boilerplate.t
t/caller.t
t/context.t
@@ -61,9 +62,11 @@
t/lib/Hints_provider_isa.pm
t/lib/Hints_test.pm
t/lib/lethal.pm
+t/lib/my/autodie.pm
t/lib/OtherTypes.pm
t/lib/pujHa/ghach.pm
t/lib/pujHa/ghach/Dotlh.pm
+t/lib/Some/Module.pm
t/mkdir.t
t/open.t
t/pod-coverage.t
Modified: branches/upstream/libautodie-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautodie-perl/current/META.yml?rev=39019&op=diff
==============================================================================
--- branches/upstream/libautodie-perl/current/META.yml (original)
+++ branches/upstream/libautodie-perl/current/META.yml Wed Jul 1 08:10:59 2009
@@ -27,4 +27,4 @@
bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=autodie
license: http://dev.perl.org/licenses/
repository: http://github.com/pfenwick/autodie/tree/master
-version: 2.01
+version: 2.03
Modified: branches/upstream/libautodie-perl/current/lib/Fatal.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautodie-perl/current/lib/Fatal.pm?rev=39019&op=diff
==============================================================================
--- branches/upstream/libautodie-perl/current/lib/Fatal.pm (original)
+++ branches/upstream/libautodie-perl/current/lib/Fatal.pm Wed Jul 1 08:10:59 2009
@@ -39,7 +39,7 @@
use constant MIN_IPC_SYS_SIMPLE_VER => 0.12;
# All the Fatal/autodie modules share the same version number.
-our $VERSION = '2.01';
+our $VERSION = '2.03';
our $Debug ||= 0;
@@ -96,6 +96,8 @@
':1.999_01' => [qw(:default)],
':2.00' => [qw(:default)],
':2.01' => [qw(:default)],
+ ':2.02' => [qw(:default)],
+ ':2.03' => [qw(:default)],
);
@@ -631,6 +633,13 @@
require autodie::hints;
$hints = autodie::hints->get_hints_for( $sref );
+
+ # We'll look up the sub's fullname. This means we
+ # get better reports of where it came from in our
+ # error messages, rather than what imported it.
+
+ $human_sub_name = autodie::hints->sub_fullname( $sref );
+
}
# Checks for special core subs.
@@ -686,6 +695,7 @@
die $class->throw(
function => q{$human_sub_name}, args => [ @argv ],
pragma => q{$class}, errno => \$!,
+ context => \$context, return => \$retval,
)
};
@@ -710,6 +720,8 @@
require Fcntl; # For Fcntl::LOCK_NB
return qq{
+
+ my \$context = wantarray() ? "list" : "scalar";
# Try to flock. If successful, return it immediately.
@@ -743,6 +755,8 @@
if (wantarray) {
my \@results = $call(@argv);
+ my \$retval = \\\@results;
+ my \$context = "list";
];
@@ -787,7 +801,8 @@
# at the result.
$code .= qq{
- my \$result = $call(@argv);
+ my \$retval = $call(@argv);
+ my \$context = "scalar";
};
if ( $hints and ( ref($hints->{scalar} ) || "" ) eq 'CODE' ) {
@@ -796,17 +811,17 @@
# works in 5.8.x, and always works in 5.10.1
return $code .= qq{
- if ( \$hints->{scalar}->(\$result) ) { $die };
- return \$result;
+ if ( \$hints->{scalar}->(\$retval) ) { $die };
+ return \$retval;
};
}
elsif (PERL510 and $hints) {
return $code . qq{
- if ( \$result ~~ \$hints->{scalar} ) { $die };
-
- return \$result;
+ if ( \$retval ~~ \$hints->{scalar} ) { $die };
+
+ return \$retval;
};
}
elsif ( $hints ) {
@@ -816,13 +831,13 @@
return $code .
( $use_defined_or ? qq{
- $die if not defined \$result;
-
- return \$result;
+ $die if not defined \$retval;
+
+ return \$retval;
} : qq{
- return \$result || $die;
+ return \$retval || $die;
} ) ;
Modified: branches/upstream/libautodie-perl/current/lib/autodie.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautodie-perl/current/lib/autodie.pm?rev=39019&op=diff
==============================================================================
--- branches/upstream/libautodie-perl/current/lib/autodie.pm (original)
+++ branches/upstream/libautodie-perl/current/lib/autodie.pm Wed Jul 1 08:10:59 2009
@@ -8,7 +8,7 @@
our $VERSION;
BEGIN {
- $VERSION = '2.01';
+ $VERSION = '2.03';
}
use constant ERROR_WRONG_FATAL => q{
Modified: branches/upstream/libautodie-perl/current/lib/autodie/exception.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautodie-perl/current/lib/autodie/exception.pm?rev=39019&op=diff
==============================================================================
--- branches/upstream/libautodie-perl/current/lib/autodie/exception.pm (original)
+++ branches/upstream/libautodie-perl/current/lib/autodie/exception.pm Wed Jul 1 08:10:59 2009
@@ -14,7 +14,7 @@
use if ($] >= 5.010), overload => '~~' => "matches";
-our $VERSION = '2.01';
+our $VERSION = '2.03';
my $PACKAGE = __PACKAGE__; # Useful to have a scalar for hash keys.
@@ -126,6 +126,31 @@
=cut
sub line { return $_[0]->{$PACKAGE}{line}; }
+
+=head3 context
+
+ my $context = $E->context;
+
+The context in which the subroutine was called. This can be
+'list', 'scalar', or undefined (unknown). It will never be 'void', as
+C<autodie> always captures the return value in one way or another.
+
+=cut
+
+sub context { return $_[0]->{$PACKAGE}{context} }
+
+=head3 return
+
+ my $return_value = $E->return;
+
+The value(s) returned by the failed subroutine. When the subroutine
+was called in a list context, this will always be a reference to an
+array containing the results. When the subroutine was called in
+a scalar context, this will be the actual scalar returned.
+
+=cut
+
+sub return { return $_[0]->{$PACKAGE}{return} }
=head3 errno
@@ -558,6 +583,8 @@
args => \@_,
function => "CORE::open",
errno => $!,
+ context => 'scalar',
+ return => undef,
);
@@ -658,6 +685,9 @@
$this->{$PACKAGE}{errno} = $args{errno} || 0;
+ $this->{$PACKAGE}{context} = $args{context};
+ $this->{$PACKAGE}{return} = $args{return};
+
$this->{$PACKAGE}{args} = $args{args} || [];
$this->{$PACKAGE}{function}= $args{function} or
croak("$class->new() called without function arg");
Modified: branches/upstream/libautodie-perl/current/lib/autodie/exception/system.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautodie-perl/current/lib/autodie/exception/system.pm?rev=39019&op=diff
==============================================================================
--- branches/upstream/libautodie-perl/current/lib/autodie/exception/system.pm (original)
+++ branches/upstream/libautodie-perl/current/lib/autodie/exception/system.pm Wed Jul 1 08:10:59 2009
@@ -5,7 +5,7 @@
use base 'autodie::exception';
use Carp qw(croak);
-our $VERSION = '2.01';
+our $VERSION = '2.03';
my $PACKAGE = __PACKAGE__;
Modified: branches/upstream/libautodie-perl/current/lib/autodie/hints.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautodie-perl/current/lib/autodie/hints.pm?rev=39019&op=diff
==============================================================================
--- branches/upstream/libautodie-perl/current/lib/autodie/hints.pm (original)
+++ branches/upstream/libautodie-perl/current/lib/autodie/hints.pm Wed Jul 1 08:10:59 2009
@@ -5,7 +5,7 @@
use constant PERL58 => ( $] < 5.009 );
-our $VERSION = '2.01';
+our $VERSION = '2.03';
=head1 NAME
Modified: branches/upstream/libautodie-perl/current/t/basic_exceptions.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautodie-perl/current/t/basic_exceptions.t?rev=39019&op=diff
==============================================================================
--- branches/upstream/libautodie-perl/current/t/basic_exceptions.t (original)
+++ branches/upstream/libautodie-perl/current/t/basic_exceptions.t Wed Jul 1 08:10:59 2009
@@ -1,7 +1,7 @@
#!/usr/bin/perl -w
use strict;
-use Test::More tests => 17;
+use Test::More tests => 19;
use constant NO_SUCH_FILE => "this_file_had_better_not_exist";
@@ -28,6 +28,8 @@
is($@->args->[2], NO_SUCH_FILE, 'Correct filename arg');
ok($@->matches('open'), 'Looks like an error from open');
ok($@->matches(':io'), 'Looks like an error from :io');
+is($@->context, 'scalar', 'Open called in scalar/void context');
+is($@->return,undef,'Open should return undef on failure');
# Testing of caller info with a real subroutine.
Added: branches/upstream/libautodie-perl/current/t/blog_hints.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautodie-perl/current/t/blog_hints.t?rev=39019&op=file
==============================================================================
--- branches/upstream/libautodie-perl/current/t/blog_hints.t (added)
+++ branches/upstream/libautodie-perl/current/t/blog_hints.t Wed Jul 1 08:10:59 2009
@@ -1,0 +1,32 @@
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+use Test::More 'no_plan';
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Some::Module qw(some_sub);
+use my::autodie qw(! some_sub);
+
+eval { some_sub() };
+
+isnt("$@", "", "some_sub should die in void/scalar context");
+
+isa_ok($@, 'autodie::exception');
+is($@->context, 'scalar');
+is($@->function, 'Some::Module::some_sub');
+like("$@", qr/can't be called in scalar context/);
+
+my @returns = eval { some_sub(0); };
+is($@, "", "Good call to some_sub");
+is_deeply(\@returns, [1,2,3], "Returns unmolested");
+
+ at returns = eval { some_sub(1) };
+
+isnt("$@","");
+is($@->return->[0], undef);
+is($@->return->[1], 'Insufficient credit');
+like("$@", qr/Insufficient credit/);
+
+warn $@;
Propchange: branches/upstream/libautodie-perl/current/t/blog_hints.t
------------------------------------------------------------------------------
svn:executable = *
Modified: branches/upstream/libautodie-perl/current/t/hints.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautodie-perl/current/t/hints.t?rev=39019&op=diff
==============================================================================
--- branches/upstream/libautodie-perl/current/t/hints.t (original)
+++ branches/upstream/libautodie-perl/current/t/hints.t Wed Jul 1 08:10:59 2009
@@ -60,6 +60,10 @@
isnt("$@", "", "Copying in scalar context should throw an error.");
isa_ok($@, "autodie::exception");
+is($@->function, "File::Copy::copy", "Function should be original name");
+is($@->return, 0, "File::Copy returns zero on failure");
+is($@->context, "scalar", "File::Copy called in scalar context");
+
# List context test.
eval {
@@ -70,6 +74,10 @@
isnt("$@", "", "Copying in list context should throw an error.");
isa_ok($@, "autodie::exception");
+
+is($@->function, "File::Copy::copy", "Function should be original name");
+is_deeply($@->return, [0], "File::Copy returns zero on failure");
+is($@->context, "list", "File::Copy called in list context");
# Tests on loaded funcs.
Added: branches/upstream/libautodie-perl/current/t/lib/Some/Module.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautodie-perl/current/t/lib/Some/Module.pm?rev=39019&op=file
==============================================================================
--- branches/upstream/libautodie-perl/current/t/lib/Some/Module.pm (added)
+++ branches/upstream/libautodie-perl/current/t/lib/Some/Module.pm Wed Jul 1 08:10:59 2009
@@ -1,0 +1,21 @@
+package Some::Module;
+use strict;
+use warnings;
+use base qw(Exporter);
+
+our @EXPORT_OK = qw(some_sub);
+
+# This is an example of a subroutine that returns (undef, $msg)
+# to signal failure.
+
+sub some_sub {
+ my ($arg) = @_;
+
+ if ($arg) {
+ return (undef, "Insufficient credit");
+ }
+
+ return (1,2,3);
+}
+
+1;
Added: branches/upstream/libautodie-perl/current/t/lib/my/autodie.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautodie-perl/current/t/lib/my/autodie.pm?rev=39019&op=file
==============================================================================
--- branches/upstream/libautodie-perl/current/t/lib/my/autodie.pm (added)
+++ branches/upstream/libautodie-perl/current/t/lib/my/autodie.pm Wed Jul 1 08:10:59 2009
@@ -1,0 +1,30 @@
+package my::autodie;
+use strict;
+use warnings;
+
+use base qw(autodie);
+use autodie::exception;
+use autodie::hints;
+
+autodie::hints->set_hints_for(
+ 'Some::Module::some_sub' => {
+ scalar => sub { 1 }, # No calling in scalar/void context
+ list => sub { @_ == 2 and not defined $_[0] }
+ },
+);
+
+autodie::exception->register(
+ 'Some::Module::some_sub' => sub {
+ my ($E) = @_;
+
+ if ($E->context eq "scalar") {
+ return "some_sub() can't be called in scalar context";
+ }
+
+ my $error = $E->return->[1];
+
+ return "some_sub() failed: $error";
+ }
+);
+
+1;
More information about the Pkg-perl-cvs-commits
mailing list