autodie 2.03
authorPaul Fenwick <pjf@perltraining.com.au>
Wed, 1 Jul 2009 13:34:21 +0000 (23:34 +1000)
committerH.Merijn Brand <h.m.brand@xs4all.nl>
Wed, 1 Jul 2009 14:13:32 +0000 (16:13 +0200)
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>
MANIFEST
lib/Fatal.pm
lib/autodie.pm
lib/autodie/exception.pm
lib/autodie/exception/system.pm
lib/autodie/hints.pm
lib/autodie/t/basic_exceptions.t
lib/autodie/t/blog_hints.t [new file with mode: 0755]
lib/autodie/t/hints.t
lib/autodie/t/lib/Some/Module.pm [new file with mode: 0644]
lib/autodie/t/lib/my/autodie.pm [new file with mode: 0644]

index e839825..ded3e46 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1779,6 +1779,7 @@ lib/autodie/t/autodie_test_module.pm      autodie - test helper
 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
@@ -1812,9 +1813,11 @@ lib/autodie/t/lib/Hints_provider_easy_does_it.pm    autodie - Hints/easy helper
 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
index 9caa01e..e65cc57 100644 (file)
@@ -39,7 +39,7 @@ use constant ERROR_58_HINTS => q{Non-subroutine %s hints for %s are not supporte
 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;
 
@@ -95,6 +95,9 @@ my %TAGS = (
     ':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)],
 
 );
 
@@ -630,6 +633,13 @@ sub _one_invocation {
         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.
@@ -685,6 +695,7 @@ sub _one_invocation {
         die $class->throw(
             function => q{$human_sub_name}, args => [ @argv ],
             pragma => q{$class}, errno => \$!,
+            context => \$context, return => \$retval,
         )
     };
 
@@ -710,6 +721,8 @@ sub _one_invocation {
 
         return qq{
 
+            my \$context = wantarray() ? "list" : "scalar";
+
             # Try to flock.  If successful, return it immediately.
 
             my \$retval = $call(@argv);
@@ -734,11 +747,16 @@ sub _one_invocation {
     # 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";
 
     ];
 
@@ -783,7 +801,8 @@ sub _one_invocation {
     # at the result.
 
     $code .= qq{
-        my \$result = $call(@argv);
+        my \$retval  = $call(@argv);
+        my \$context = "scalar";
     };
 
     if ( $hints and ( ref($hints->{scalar} ) || "" ) eq 'CODE' ) {
@@ -792,17 +811,17 @@ sub _one_invocation {
         # 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 ) {
@@ -812,13 +831,13 @@ sub _one_invocation {
     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;
 
     } ) ;
 
index b5756d4..72f312e 100644 (file)
@@ -8,7 +8,7 @@ our @ISA = qw(Fatal);
 our $VERSION;
 
 BEGIN {
-    $VERSION = '2.00';
+    $VERSION = '2.03';
 }
 
 use constant ERROR_WRONG_FATAL => q{
@@ -254,7 +254,7 @@ provides the convenience of using the default methods, but the surety
 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);
@@ -329,8 +329,8 @@ element.
 =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)>.
 
@@ -348,8 +348,8 @@ See also L<Fatal/DIAGNOSTICS>.
 =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
index 05f3f7d..364b134 100644 (file)
@@ -14,7 +14,7 @@ use overload
 
 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.
 
@@ -127,6 +127,31 @@ The line in C<< $E->file >> where the exceptional code was called.
 
 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;
@@ -558,6 +583,8 @@ sub format_default {
         args => \@_,
         function => "CORE::open",
         errno => $!,
+        context => 'scalar',
+        return => undef,
     );
 
 
@@ -658,6 +685,9 @@ sub _init {
 
     $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");
index d51398b..d7be816 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 use base 'autodie::exception';
 use Carp qw(croak);
 
-our $VERSION = '2.00';
+our $VERSION = '2.03';
 
 my $PACKAGE = __PACKAGE__;
 
index bd42118..71b371a 100644 (file)
@@ -3,7 +3,9 @@ package autodie::hints;
 use strict;
 use warnings;
 
-our $VERSION = '2.00';
+use constant PERL58 => ( $] < 5.009 );
+
+our $VERSION = '2.03';
 
 =head1 NAME
 
@@ -79,7 +81,7 @@ A list containing a single undef, in list context
 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>.
@@ -94,15 +96,15 @@ of C<autodie> itself.
 
 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
@@ -129,7 +131,7 @@ The most common context-specific hints are:
         # 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]:
@@ -158,7 +160,7 @@ The most common context-specific hints are:
                 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>
@@ -256,7 +258,7 @@ CPAN to allow it.
 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.
@@ -333,11 +335,14 @@ use constant EMPTY_OR_FALSE => sub {
     @_==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);
@@ -347,18 +352,11 @@ our $DEBUG = 0;
 # 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.
@@ -418,6 +416,9 @@ sub load_hints {
         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;
         }
index 56876be..c732dd5 100755 (executable)
@@ -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->[1], '<', 'Correct mode arg');
 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.
 
diff --git a/lib/autodie/t/blog_hints.t b/lib/autodie/t/blog_hints.t
new file mode 100755 (executable)
index 0000000..395cb14
--- /dev/null
@@ -0,0 +1,30 @@
+#!/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/);
index a097dab..ec1ef32 100755 (executable)
@@ -13,7 +13,8 @@ use Test::More 'no_plan';
 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
@@ -29,15 +30,23 @@ my $hints = "autodie::hints";
 # Basic hinting tests
 
 is( $hints->sub_fullname(\&copy), '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(\&copy)->{scalar}->(0) ,
         "copy() hints should fail on 0 for scalars."
     );
+    ok( $hints->get_hints_for(\&copy)->{list}->(0) ,
+        "copy() hints should fail on 0 for lists."
+    );
 }
 
 # Scalar context test
@@ -51,6 +60,10 @@ eval {
 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 {
@@ -62,6 +75,10 @@ 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 = (
diff --git a/lib/autodie/t/lib/Some/Module.pm b/lib/autodie/t/lib/Some/Module.pm
new file mode 100644 (file)
index 0000000..a24ec93
--- /dev/null
@@ -0,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;
diff --git a/lib/autodie/t/lib/my/autodie.pm b/lib/autodie/t/lib/my/autodie.pm
new file mode 100644 (file)
index 0000000..1ad1250
--- /dev/null
@@ -0,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;