G'day Everyone,
Attached is a patch that brings blead up to autodie 2.03. The failing tests
are fixed, and a number of nits have been picked. Full changes below, as
well as in the commit message.
Cheerio,
Paul
Revision history for autodie
* TEST: Removed spurious warning about insufficient credit.
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
* DOCUMENTATION: General copyediting and tidy-up
(Thanks to Toby Corkindale)
* BUGFIX: Warnings are no longer emitted when undefined values
are compared by hinting routines.
* BUGFIX: Hints for File::Copy now operate correctly under
Perl 5.10.1.
* BUGFIX: Inheritance is now considered sufficient to declare
allegiance to the hints provider role under Perl 5.8.x.
(Thanks to Glenn Fowler)
* TEST: hints.t no longer throws failures under Perl 5.10.1.
* TEST: pod-coverage.t (author test) no longer fails if
Sub::Identify is not installed.
(Thanks to Jonathan Yu. RT #47437)
--
Paul Fenwick <pjf@perltraining.com.au> | http://perltraining.com.au/
Director of Training | Ph: +61 3 9354 6001
Perl Training Australia | Fax: +61 3 9354 2681
From
715681c17c0f3f9f7a09971007c4c4de0d122c60 Mon Sep 17 00:00:00 2001
From: Paul Fenwick <pjf@perltraining.com.au>
Date: Wed, 1 Jul 2009 23:30:58 +1000
Subject: [PATCH] Merge autodie 2.03 into core.
Revision history for autodie
* TEST: Removed spurious warning about insufficient credit.
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
* DOCUMENTATION: General copyediting and tidy-up
(Thanks to Toby Corkindale)
* BUGFIX: Warnings are no longer emitted when undefined values
are compared by hinting routines.
* BUGFIX: Hints for File::Copy now operate correctly under
Perl 5.10.1.
* BUGFIX: Inheritance is now considered sufficient to declare
allegiance to the hints provider role under Perl 5.8.x.
(Thanks to Glenn Fowler)
* TEST: hints.t no longer throws failures under Perl 5.10.1.
* TEST: pod-coverage.t (author test) no longer fails if
Sub::Identify is not installed.
(Thanks to Jonathan Yu. RT #47437)
Signed-off-by: H.Merijn Brand <h.m.brand@xs4all.nl>
lib/autodie/t/backcompat.t autodie - More Fatal backcompat
lib/autodie/t/basic_exceptions.t autodie - Basic exception tests
lib/autodie/t/binmode.t autodie - Binmode testing
+lib/autodie/t/blog_hints.t autodie - Tests fro PJF's blog
lib/autodie/t/caller.t autodie - Caller diagnostics
lib/autodie/t/context_lexical.t autodie - Context clobbering lexically
lib/autodie/t/context.t autodie - Context clobbering tests
lib/autodie/t/lib/Hints_provider_isa.pm autodie - Hints/inherit helper
lib/autodie/t/lib/Hints_test.pm autodie - Hints test helper
lib/autodie/t/lib/lethal.pm autodie - with a better name
+lib/autodie/t/lib/my/autodie.pm autodie - blog_hints.t helper
lib/autodie/t/lib/OtherTypes.pm autodie - Format clobberer helper.
lib/autodie/t/lib/pujHa/ghach/Dotlh.pm autodie - With Klingon honour
lib/autodie/t/lib/pujHa/ghach.pm autodie - Like a Klingon
+lib/autodie/t/lib/Some/Module.pm autodie - blog_hints.t helper
lib/autodie/t/mkdir.t autodie - filesystem tests
lib/autodie/t/open.t autodie - Testing open
lib/autodie/t/recv.t autodie - send/recv tests
use constant MIN_IPC_SYS_SIMPLE_VER => 0.12;
# All the Fatal/autodie modules share the same version number.
-our $VERSION = '2.00';
+our $VERSION = '2.03';
our $Debug ||= 0;
':1.999' => [qw(:default)],
':1.999_01' => [qw(:default)],
':2.00' => [qw(:default)],
+ ':2.01' => [qw(:default)],
+ ':2.02' => [qw(:default)],
+ ':2.03' => [qw(:default)],
);
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.
die $class->throw(
function => q{$human_sub_name}, args => [ @argv ],
pragma => q{$class}, errno => \$!,
+ context => \$context, return => \$retval,
)
};
return qq{
+ my \$context = wantarray() ? "list" : "scalar";
+
# Try to flock. If successful, return it immediately.
my \$retval = $call(@argv);
# the 'unopened' warning class here. Especially since they
# then report the wrong line number.
+ # Other warnings are disabled because they produce excessive
+ # complaints from smart-match hints under 5.10.1.
+
my $code = qq[
- no warnings qw(unopened);
+ no warnings qw(unopened uninitialized numeric);
if (wantarray) {
my \@results = $call(@argv);
+ my \$retval = \\\@results;
+ my \$context = "list";
];
# at the result.
$code .= qq{
- my \$result = $call(@argv);
+ my \$retval = $call(@argv);
+ my \$context = "scalar";
};
if ( $hints and ( ref($hints->{scalar} ) || "" ) eq 'CODE' ) {
# 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 };
+ if ( \$retval ~~ \$hints->{scalar} ) { $die };
- return \$result;
+ return \$retval;
};
}
elsif ( $hints ) {
return $code .
( $use_defined_or ? qq{
- $die if not defined \$result;
+ $die if not defined \$retval;
- return \$result;
+ return \$retval;
} : qq{
- return \$result || $die;
+ return \$retval || $die;
} ) ;
our $VERSION;
BEGIN {
- $VERSION = '2.00';
+ $VERSION = '2.03';
}
use constant ERROR_WRONG_FATAL => q{
that no behavorial changes will occur if the C<autodie> module is
upgraded.
-You can enable C<autodie> for all of Perl's built-ins, including
+C<autodie> can be enabled for all of Perl's built-ins, including
C<system> and C<exec> with:
use autodie qw(:all);
=item :void cannot be used with lexical scope
The C<:void> option is supported in L<Fatal>, but not
-C<autodie>. However you can explicitly disable autodie
-end the end of the current block with C<no autodie>.
+C<autodie>. To workaround this, C<autodie> may be explicitly disabled until
+the end of the current block with C<no autodie>.
To disable autodie for only a single function (eg, open)
use C<no autodie qw(open)>.
=head1 BUGS
"Used only once" warnings can be generated when C<autodie> or C<Fatal>
-is used with package filehandles (eg, C<FILE>). It's strongly recommended
-you use scalar filehandles instead.
+is used with package filehandles (eg, C<FILE>). Scalar filehandles are
+strongly recommended instead.
Under Perl 5.8 only, C<autodie> I<does not> propagate into string C<eval>
statements, although it can be explicitly enabled inside a string
use if ($] >= 5.010), overload => '~~' => "matches";
-our $VERSION = '2.00';
+our $VERSION = '2.03';
my $PACKAGE = __PACKAGE__; # Useful to have a scalar for hash keys.
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
my $errno = $E->errno;
args => \@_,
function => "CORE::open",
errno => $!,
+ context => 'scalar',
+ return => undef,
);
$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");
use base 'autodie::exception';
use Carp qw(croak);
-our $VERSION = '2.00';
+our $VERSION = '2.03';
my $PACKAGE = __PACKAGE__;
use strict;
use warnings;
-our $VERSION = '2.00';
+use constant PERL58 => ( $] < 5.009 );
+
+our $VERSION = '2.03';
=head1 NAME
All other return values (including the list of the single zero, and the
list containing a single empty string) are considered successful. However,
real-world code isn't always that easy. Perhaps the code you're working
-with returns a string containing the word "FAIL" in it upon failure, or a
+with returns a string containing the word "FAIL" upon failure, or a
two element list containing C<(undef, "human error message")>. To make
autodie work with these sorts of subroutines, we have
the I<hinting interface>.
A I<hint> is a subroutine or value that is checked against the
return value of an autodying subroutine. If the match returns true,
-C<autodie> considers the subroutine have failed.
+C<autodie> considers the subroutine to have failed.
If the hint provided is a subroutine, then C<autodie> will pass
the complete return value to that subroutine. If the hint is
any other value, then C<autodie> will smart-match against the
-value provided. In Perl 5.8.x, there is no smart-match operator, and as such
+value provided. In Perl 5.8.x there is no smart-match operator, and as such
only subroutine hints are supported in these versions.
-Hints can be provided for both scalar context and list context. Note
+Hints can be provided for both scalar and list contexts. Note
that an autodying subroutine will never see a void context, as
C<autodie> always needs to capture the return value for examination.
Autodying subroutines called in void context act as if they're called
# Scalar failures always return zero explicitly:
{ scalar => '0' }
- # List failures always return empty list:
+ # List failures always return an empty list:
{ list => [] }
# List failures return () or (undef) [default expectation]:
scalar => 0,
list => [0],
}
- );
+ );
This "in all contexts" construction is very common, and can be
abbreviated, using the 'fail' key. This sets both the C<scalar>
In addition, you must define a C<AUTODIE_HINTS> subroutine that returns
a hash-reference containing the hints for your subroutines:
- package Your::Module;
+ package Your::Module;
# We can use the Class::DOES from the CPAN to declare adherence
# to a role.
@_==1 && !$_[0]
};
+use constant SINGLE_TRUE => sub { @_ == 1 and not $_[0] };
+
use constant DEFAULT_HINTS => {
scalar => UNDEF_ONLY,
list => EMPTY_OR_UNDEF,
};
+
use constant HINTS_PROVIDER => 'autodie::hints::provider';
use base qw(Exporter);
# Only ( undef ) is a strange but possible situation for very
# badly written code. It's not supported yet.
-# TODO: Ugh, those sub refs look awful! Give them proper
-# names!
-
my %Hints = (
- 'File::Copy::copy' => {
- scalar => sub { not $_[0] },
- list => sub { @_ == 1 and not $_[0] }
- },
- 'File::Copy::move' => {
- scalar => sub { not $_[0] },
- list => sub { @_ == 1 and not $_[0] }
- },
+ 'File::Copy::copy' => { scalar => SINGLE_TRUE, list => SINGLE_TRUE },
+ 'File::Copy::move' => { scalar => SINGLE_TRUE, list => SINGLE_TRUE },
+ 'File::Copy::cp' => { scalar => SINGLE_TRUE, list => SINGLE_TRUE },
+ 'File::Copy::mv' => { scalar => SINGLE_TRUE, list => SINGLE_TRUE },
);
# Start by using Sub::Identify if it exists on this system.
if ($package->can('DOES') and $package->DOES(HINTS_PROVIDER) ) {
$hints_available = 1;
}
+ elsif ( PERL58 and $package->isa(HINTS_PROVIDER) ) {
+ $hints_available = 1;
+ }
elsif ( ${"${package}::DOES"}{HINTS_PROVIDER.""} ) {
$hints_available = 1;
}
#!/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";
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.
--- /dev/null
+#!/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");
+
+@returns = eval { some_sub(1) };
+
+isnt("$@","");
+is($@->return->[0], undef);
+is($@->return->[1], 'Insufficient credit');
+like("$@", qr/Insufficient credit/);
use constant NO_SUCH_FILE => "this_file_had_better_not_exist";
use constant NO_SUCH_FILE2 => "this_file_had_better_not_exist_xyzzy";
-use constant PERL510 => ( $] >= 5.010 );
+use constant PERL510 => ( $] >= 5.0100 );
+use constant PERL5101 => ( $] >= 5.0101 );
use Hints_test qw(
fail_on_empty fail_on_false fail_on_undef
# Basic hinting tests
is( $hints->sub_fullname(\©), 'File::Copy::copy' , "Id: copy" );
-is( $hints->sub_fullname(\&cp), 'File::Copy::copy' , "Id: cp" );
+is(
+ $hints->sub_fullname(\&cp),
+ PERL5101 ? 'File::Copy::cp' : 'File::Copy::copy' , "Id: cp"
+);
is( $hints->sub_fullname(\&move), 'File::Copy::move' , "Id: move" );
-is( $hints->sub_fullname(\&mv), 'File::Copy::move' , "Id: mv" );
+is( $hints->sub_fullname(\&mv),
+ PERL5101 ? 'File::Copy::mv' : 'File::Copy::move' , "Id: mv"
+);
if (PERL510) {
ok( $hints->get_hints_for(\©)->{scalar}->(0) ,
"copy() hints should fail on 0 for scalars."
);
+ ok( $hints->get_hints_for(\©)->{list}->(0) ,
+ "copy() hints should fail on 0 for lists."
+ );
}
# Scalar context test
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 {
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.
my %tests = (
--- /dev/null
+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;
--- /dev/null
+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;
projects / p5sagit/p5-mst-13.2.git / commitdiff