Update autodie to CPAN version 2.27

[DELTA] 2.27 2015-06-10 19:19:49+10:00 Australia/Melbourne * DEPRECATION: Deprecate the use of "Fatal qw(:lexcial)". It is an implementation detail of autodie and is about to change. * SPEED: Allow wrappers for CORE::exec and CORE::system to be reused as they are not dependent on the calling package. * TEST: Avoid hard-coded directory separator in t/system.t. Thanks to A. Sinan Unur for reporting it and providing a patch. (GH#62) * TEST: Add missing "require autodie" in import-into test and ensure Import::Into remains an optional test dependency. * TEST / INTERNAL / TRAVIS: Set "sudo: false" to gain access to the Travis container based infrastructure. * TEST: Bump version of Import::Into to 1.002004 as older versions are insufficient for our test. Thanks to Olivier Mengué for reporting it. (RT#101377)
Perl · Jun 12, 2015 · 35c0561 · 35c0561
1 parent f3f2f48
commit 35c0561
Show file tree

Hide file tree

Showing 17 changed files with 452 additions and 274 deletions.
diff --git a/MANIFEST b/MANIFEST
@@ -47,8 +47,8 @@ cpan/autodie/lib/autodie/hints.pm	Hinting interface for autodie
 cpan/autodie/lib/autodie.pm		Functions succeed or die with lexical scope
 cpan/autodie/lib/autodie/Scope/Guard.pm
 cpan/autodie/lib/autodie/Scope/GuardStack.pm
-cpan/autodie/lib/autodie/ScopeUtil.pm
 cpan/autodie/lib/autodie/skip.pm
+cpan/autodie/lib/autodie/Util.pm
 cpan/autodie/lib/Fatal.pm		Make errors in functions/builtins fatal
 cpan/autodie/t/00-load.t		autodie - basic load
 cpan/autodie/t/args.t

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
@@ -133,7 +133,7 @@ package Maintainers;
     },
 
     'autodie' => {
-        'DISTRIBUTION' => 'NTHYKIER/autodie-2.26.tar.gz',
+        'DISTRIBUTION' => 'PJF/autodie-2.27.tar.gz',
         'FILES'        => q[cpan/autodie],
         'EXCLUDED'     => [
             qr{benchmarks},

diff --git a/cpan/autodie/lib/Fatal.pm b/cpan/autodie/lib/Fatal.pm
@@ -10,7 +10,12 @@ use Tie::RefHash;   # To cache subroutine refs
 use Config;
 use Scalar::Util qw(set_prototype);
 
-use autodie::ScopeUtil qw(on_end_of_compile_scope);
+use autodie::Util qw(
+  fill_protos
+  install_subs
+  make_core_trampoline
+  on_end_of_compile_scope
+);
 
 use constant PERL510     => ( $] >= 5.010 );
 
@@ -50,7 +55,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;
 
-our $VERSION = '2.26'; # VERSION: Generated by DZP::OurPkg::Version
+our $VERSION = '2.27'; # VERSION: Generated by DZP::OurPkg::Version
 
 our $Debug ||= 0;
 
@@ -157,6 +162,7 @@ my %TAGS = (
     ':2.24'  => [qw(:v225)],
     ':2.25'  => [qw(:v225)],
     ':2.26'  => [qw(:default)],
+    ':2.27'  => [qw(:default)],
 );
 
 
@@ -293,6 +299,8 @@ my %reusable_builtins;
     CORE::shmctl
     CORE::shmget
     CORE::shmread
+    CORE::exec
+    CORE::system
 )} = ();
 
 # Cached_fatalised_sub caches the various versions of our
@@ -359,6 +367,41 @@ sub import {
         $lexical = 1;
         shift @_;
 
+        # It is currently an implementation detail that autodie is
+        # implemented as "use Fatal qw(:lexical ...)".  For backwards
+        # compatibility, we allow it - but not without a warning.
+        # NB: Optimise for autodie as it is quite possibly the most
+        # freq. consumer of this case.
+        if ($class ne 'autodie' and not $class->isa('autodie')) {
+            if ($class eq 'Fatal') {
+                warnings::warnif(
+                    'deprecated',
+                    '[deprecated] The "use Fatal qw(:lexical ...)" '
+                    . 'should be replaced by "use autodie qw(...)". '
+                    . 'Seen' # warnif appends " at <...>"
+                    );
+            } else {
+                warnings::warnif(
+                    'deprecated',
+                    "[deprecated] The class/Package $class is a "
+                    . 'subclass of Fatal and used the :lexical. '
+                    . 'If $class provides lexical error checking '
+                    . 'it should extend autodie instead of using :lexical. '
+                    . 'Seen' # warnif appends " at <...>"
+                    );
+            }
+            # "Promote" the call to autodie from here on.  This is
+            # already mostly the case (e.g. use Fatal qw(:lexical ...)
+            # would throw autodie::exceptions on error rather than the
+            # Fatal errors.
+            $class = 'autodie';
+            # This requires that autodie is in fact loaded; otherwise
+            # the "$class->X()" method calls below will explode.
+            require autodie;
+            # TODO, when autodie and Fatal are cleanly separated, we
+            # should go a "goto &autodie::import" here instead.
+        }
+
         # If we see no arguments and :lexical, we assume they
         # wanted ':default'.
 
@@ -460,7 +503,7 @@ sub import {
         }
     }
 
-    $class->_install_subs($pkg, \%install_subs);
+    install_subs($pkg, \%install_subs);
 
     if ($lexical) {
 
@@ -477,7 +520,7 @@ sub import {
         # scope.
 
         on_end_of_compile_scope(sub {
-            $class->_install_subs($pkg, \%unload_later);
+            install_subs($pkg, \%unload_later);
         });
 
         # To allow others to determine when autodie was in scope,
@@ -496,63 +539,6 @@ sub import {
 
 }
 
-# The code here is originally lifted from namespace::clean,
-# by Robert "phaylon" Sedlacek.
-#
-# It's been redesigned after feedback from ikegami on perlmonks.
-# See http://perlmonks.org/?node_id=693338 .  Ikegami rocks.
-#
-# Given a package, and hash of (subname => subref) pairs,
-# we install the given subroutines into the package.  If
-# a subref is undef, the subroutine is removed.  Otherwise
-# it replaces any existing subs which were already there.
-
-sub _install_subs {
-    my ($class, $pkg, $subs_to_reinstate) = @_;
-
-    my $pkg_sym = "${pkg}::";
-
-    # It does not hurt to do this in a predictable order, and might help debugging.
-    foreach my $sub_name (sort keys %$subs_to_reinstate) {
-
-        # We will repeatedly mess with stuff that strict "refs" does
-        # not like.  So lets just disable it once for this entire
-        # scope.
-        no strict qw(refs);   ## no critic
-
-        my $sub_ref= $subs_to_reinstate->{$sub_name};
-
-        my $full_path = $pkg_sym.$sub_name;
-        my $oldglob = *$full_path;
-
-        # Nuke the old glob.
-        delete $pkg_sym->{$sub_name};
-
-        # For some reason this local *alias = *$full_path triggers an
-        # "only used once" warning.  Not entirely sure why, but at
-        # least it is easy to silence.
-        no warnings qw(once);
-        local *alias = *$full_path;
-        use warnings qw(once);
-
-        # Copy innocent bystanders back.  Note that we lose
-        # formats; it seems that Perl versions up to 5.10.0
-        # have a bug which causes copying formats to end up in
-        # the scalar slot.  Thanks to Ben Morrow for spotting this.
-
-        foreach my $slot (qw( SCALAR ARRAY HASH IO ) ) {
-            next unless defined *$oldglob{$slot};
-            *alias = *$oldglob{$slot};
-        }
-
-        if ($sub_ref) {
-            *$full_path = $sub_ref;
-        }
-    }
-
-    return;
-}
-
 sub unimport {
     my $class = shift;
 
@@ -597,9 +583,9 @@ sub unimport {
 
     }
 
-    $class->_install_subs($pkg, \%uninstall_subs);
+    install_subs($pkg, \%uninstall_subs);
     on_end_of_compile_scope(sub {
-        $class->_install_subs($pkg, \%reinstall_subs);
+        install_subs($pkg, \%reinstall_subs);
     });
 
     return;
@@ -755,32 +741,6 @@ sub _translate_import_args {
 
 }
 
-# This code is from the original Fatal.  It scares me.
-# It is 100% compatible with the 5.10.0 Fatal module, right down
-# to the scary 'XXXX' comment.  ;)
-
-sub fill_protos {
-    my $proto = shift;
-    my ($n, $isref, @out, @out1, $seen_semi) = -1;
-    if ($proto =~ m{^\s* (?: [;] \s*)? \@}x) {
-        # prototype is entirely slurp - special case that does not
-        # require any handling.
-        return ([0, '@_']);
-    }
-
-    while ($proto =~ /\S/) {
-        $n++;
-        push(@out1,[$n,@out]) if $seen_semi;
-        push(@out, $1 . "{\$_[$n]}"), next if $proto =~ s/^\s*\\([\@%\$\&])//;
-        push(@out, "\$_[$n]"),        next if $proto =~ s/^\s*([_*\$&])//;
-        push(@out, "\@_[$n..\$#_]"),  last if $proto =~ s/^\s*(;\s*)?\@//;
-        $seen_semi = 1, $n--,         next if $proto =~ s/^\s*;//; # XXXX ????
-        die "Internal error: Unknown prototype letters: \"$proto\"";
-    }
-    push(@out1,[$n+1,@out]);
-    return @out1;
-}
-
 # This is a backwards compatible version of _write_invocation.  It's
 # recommended you don't use it.
 
@@ -1620,7 +1580,7 @@ sub _make_leak_guard {
             # As $orig_sub is "closed over", updating its value will
             # be "remembered" for the next call.
 
-            $orig_sub = _make_core_trampoline($call, $pkg, $proto);
+            $orig_sub = make_core_trampoline($call, $pkg, $proto);
 
             # We still cache it despite remembering it in $orig_sub as
             # well.  In particularly, we rely on this to avoid
@@ -1643,51 +1603,6 @@ sub _make_leak_guard {
     return $leak_guard;
 }
 
-# Create a trampoline for calling a core sub.  Essentially, a tiny sub
-# that figures out how we should be calling our core sub, puts in the
-# arguments in the right way, and bounces our control over to it.
-#
-# If we could use `goto &` on core builtins, we wouldn't need this.
-sub _make_core_trampoline {
-    my ($call, $pkg, $proto_str) = @_;
-    my $trampoline_code = 'sub {';
-    my $trampoline_sub;
-    my @protos = fill_protos($proto_str);
-
-    # TODO: It may be possible to combine this with write_invocation().
-
-    foreach my $proto (@protos) {
-        local $" = ", ";    # So @args is formatted correctly.
-        my ($count, @args) = @$proto;
-        if (@args && $args[-1] =~ m/[@#]_/) {
-            $trampoline_code .= qq/
-                if (\@_ >= $count) {
-                    return $call(@args);
-                }
-             /;
-        } else {
-            $trampoline_code .= qq<
-                if (\@_ == $count) {
-                    return $call(@args);
-                }
-             >;
-        }
-    }
-
-    $trampoline_code .= qq< Carp::croak("Internal error in Fatal/autodie.  Leak-guard failure"); } >;
-    my $E;
-
-    {
-        local $@;
-        $trampoline_sub = eval "package $pkg;\n $trampoline_code"; ## no critic
-        $E = $@;
-    }
-    die "Internal error in Fatal/autodie: Leak-guard installation failure: $E"
-        if $E;
-
-    return $trampoline_sub;
-}
-
 sub _compile_wrapper {
     my ($class, $wrapper_pkg, $core, $call, $name, $void, $lexical, $sub, $sref, $hints, $proto) = @_;
     my $real_proto = '';

diff --git a/cpan/autodie/lib/autodie.pm b/cpan/autodie/lib/autodie.pm
@@ -9,7 +9,7 @@ our $VERSION;
 # ABSTRACT: Replace functions with ones that succeed or die with lexical scope
 
 BEGIN {
-    our $VERSION = '2.26'; # VERSION: Generated by DZP::OurPkg::Version
+    our $VERSION = '2.27'; # VERSION: Generated by DZP::OurPkg::Version
 }
 
 use constant ERROR_WRONG_FATAL => q{

diff --git a/cpan/autodie/lib/autodie/Scope/Guard.pm b/cpan/autodie/lib/autodie/Scope/Guard.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 
 # ABSTRACT: Wrapper class for calling subs at end of scope
-our $VERSION = '2.26'; # VERSION
+our $VERSION = '2.27'; # VERSION
 
 # This code schedules the cleanup of subroutines at the end of
 # scope.  It's directly inspired by chocolateboy's excellent

diff --git a/cpan/autodie/lib/autodie/Scope/GuardStack.pm b/cpan/autodie/lib/autodie/Scope/GuardStack.pm
@@ -6,7 +6,7 @@ use warnings;
 use autodie::Scope::Guard;
 
 # ABSTRACT: Hook stack for managing scopes via %^H
-our $VERSION = '2.26'; # VERSION
+our $VERSION = '2.27'; # VERSION
 
 my $H_KEY_STEM = __PACKAGE__ . '/guard';
 my $COUNTER = 0;

diff --git a/cpan/autodie/lib/autodie/ScopeUtil.pm b/cpan/autodie/lib/autodie/ScopeUtil.pm