Update autodie to CPAN version 2.20

  [DELTA]

  2.20      2013-06-23 16:08:41 PST8PDT

        Many improvements from Niels Thykier, hero of the
        free people.  From GH #25:

        * SPEED / INTERNAL: Less time is spent computing prototypes

        * SPEED / INTERNAL: Leak guards are more efficient.

        * SPEED : Expanding tags (eg: qw(:all)) is now faster.
          This also improves the speed of checking autodying
          code with Perl::Critic.

        * INTERNAL: Expanding of tags is faster and preserves order.

6 files changed, 193 insertions, 142 deletions

diff --git a/cpan/autodie/lib/Fatal.pm b/cpan/autodie/lib/Fatal.pm
index 8c6536b802..a16cfd6198 100644
--- a/cpan/autodie/lib/Fatal.pm
+++ b/cpan/autodie/lib/Fatal.pm
@@ -42,7 +42,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.19'; # VERSION: Generated by DZP::OurPkg::Version
+our $VERSION = '2.20'; # VERSION: Generated by DZP::OurPkg::Version
 
 our $Debug ||= 0;
 
@@ -135,6 +135,7 @@ my %TAGS = (
     ':2.17'  => [qw(:default)],
     ':2.18'  => [qw(:default)],
     ':2.19'  => [qw(:default)],
+    ':2.20'  => [qw(:default)],
 );
 
 # chmod was only introduced in 2.07
@@ -346,13 +347,20 @@ sub import {
     # Thiese subs will get unloaded at the end of lexical scope.
     my %unload_later;
 
-    # This hash helps us track if we've already done work.
-    my %done_this;
-
-    # NB: we're using while/shift rather than foreach, since
-    # we'll be modifying the array as we walk through it.
-
-    while (my $func = shift @fatalise_these) {
+    # Use _translate_import_args to expand tags for us.  It will
+    # pass-through unknown tags (i.e. we have to manually handle
+    # VOID_TAG).
+    #
+    # TODO: Consider how to handle stuff like:
+    #   use autodie qw(:defaults ! :io);
+    #   use Fatal qw(:defaults :void :io);
+    #
+    # The ! and :void is currently not applied to anything in the
+    # example above since duplicates are filtered out.  This has been
+    # autodie's behaviour for quite a while, but it might make sense
+    # to change it so "!" or ":void" applies to stuff after they
+    # appear (even if they are all duplicates).
+    for my $func ($class->_translate_import_args(@fatalise_these)) {
 
         if ($func eq VOID_TAG) {
 
@@ -363,11 +371,6 @@ sub import {
 
             $insist_hints = 1;
 
-        } elsif (exists $TAGS{$func}) {
-
-            # When it's a tag, expand it.
-            push(@fatalise_these, @{ $TAGS{$func} });
-
         } else {
 
             # Otherwise, fatalise it.
@@ -380,14 +383,6 @@ sub import {
                 $insist_this = 1;
             }
 
-            # TODO: Even if we've already fatalised, we should
-            # check we've done it with hints (if $insist_hints).
-
-            # If we've already made something fatal this call,
-            # then don't do it twice.
-
-            next if $done_this{$func};
-
             # We're going to make a subroutine fatalistic.
             # However if we're being invoked with 'use Fatal qw(x)'
             # and we've already been called with 'no autodie qw(x)'
@@ -416,8 +411,6 @@ sub import {
                 ( $insist_this || $insist_hints )
             );
 
-            $done_this{$func}++;
-
             $Original_user_sub{$sub} ||= $sub_ref;
 
             # If we're making lexical changes, we need to arrange
@@ -508,7 +501,7 @@ sub _install_subs {
         if ($sub_ref) {
 
             no strict;  ## no critic
-            *{ $pkg_sym . $sub_name } = $sub_ref;
+            *{ $full_path } = $sub_ref;
         }
     }
 
@@ -533,15 +526,7 @@ sub unimport {
 
     my @unimport_these = @_ ? @_ : ':all';
 
-    while (my $symbol = shift @unimport_these) {
-
-        if ($symbol =~ /^:/) {
-
-            # Looks like a tag!  Expand it!
-            push(@unimport_these, @{ $TAGS{$symbol} });
-
-            next;
-        }
+    for my $symbol ($class->_translate_import_args(@unimport_these)) {
 
         my $sub = $symbol;
         $sub = "${pkg}::$sub" unless $sub =~ /::/;
@@ -576,7 +561,36 @@ sub unimport {
 
 }
 
-# TODO - This is rather terribly inefficient right now.
+sub _translate_import_args {
+    my ($class, @args) = @_;
+    my @result;
+    for my $a (@args){
+        if (exists $TAGS{$a}) {
+            my $expanded = $class->_expand_tag($a);
+            # Strip "CORE::" from all elements in the list as import and
+            # unimport does not handle the "CORE::" prefix too well.
+            #
+            # NB: we use substr as it is faster than s/^CORE::// and
+            # it does not change the elements.
+            push @result, map { substr($_, 6) } @{$expanded};
+        } else {
+            #pass through
+            push @result, $a;
+        }
+    }
+    # If @args < 2, then we have no duplicates (because _expand_tag
+    # does not have duplicates and if it is not a tag, it is just a
+    # single value).  We optimize for this because it is a fairly
+    # common case (e.g. use autodie; or use autodie qw(:all); both
+    # trigger this).
+    return @result if @args < 2;
+
+    my %seen = ();
+    # Yes, this is basically List::MoreUtils's uniq/distinct, but
+    # List::MoreUtils is not in the Perl core and autodie is
+    return grep { !$seen{$_}++ } @result;
+}
+
 
 # NB: Perl::Critic's dump-autodie-tag-contents depends upon this
 # continuing to work.
@@ -584,6 +598,11 @@ sub unimport {
 {
     my %tag_cache;
 
+    # Expand a given tag (e.g. ":default") into a listref containing
+    # all sub names covered by that tag.  Each sub is returned as
+    # "CORE::<name>" (i.e. "CORE::open" rather than "open").
+    #
+    # NB: the listref must not be modified.
     sub _expand_tag {
         my ($class, $tag) = @_;
 
@@ -597,15 +616,37 @@ sub unimport {
 
         my @to_process = @{$TAGS{$tag}};
 
+        # If the tag is basically an alias of another tag (like e.g. ":2.11"),
+        # then just share the resulting reference with the original content (so
+        # we only pay for an extra reference for the alias memory-wise).
+        if (@to_process == 1 && substr($to_process[0], 0, 1) eq ':') {
+            # We could do this for "non-tags" as well, but that only occurs
+            # once at the time of writing (":threads" => ["fork"]), so
+            # probably not worth it.
+            my $expanded = $class->_expand_tag($to_process[0]);
+            $tag_cache{$tag} = $expanded;
+            return $expanded;
+        }
+
+        my %seen = ();
         my @taglist = ();
 
-        while (my $item = shift @to_process) {
-            if ($item =~ /^:/) {
-                # Expand :tags
-                push(@to_process, @{$TAGS{$item}} );
-            }
-            else {
-                push(@taglist, "CORE::$item");
+        for my $item (@to_process) {
+            # substr is more efficient than m/^:/ for stuff like this,
+            # at the price of being a bit more verbose/low-level.
+            if (substr($item, 0, 1) eq ':') {
+                # Use recursion here to ensure we expand a tag at most once.
+                #
+                # TODO: Improve handling of :all so we don't expand
+                # all those aliases (e.g :2.00..:2.07 are all aliases
+                # of v2.07).
+
+                my $expanded = $class->_expand_tag($item);
+                push @taglist, grep { !$seen{$_}++ } @{$expanded};
+            } else {
+                my $subname = "CORE::$item";
+                push @taglist, $subname
+                    unless $seen{$subname}++;
             }
         }
 
@@ -624,6 +665,12 @@ sub unimport {
 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;
@@ -676,7 +723,7 @@ sub _write_invocation {
 
             my $condition = "\@_ == $n";
 
-            if (@argv and $argv[-1] =~ /#_/) {
+            if (@argv and $argv[-1] =~ /[#@]_/) {
                 # This argv ends with '@' in the prototype, so it matches
                 # any number of args >= the number of expressions in the
                 # argv.
@@ -1199,14 +1246,6 @@ sub _make_fatal {
         $call = "CORE::$name";
     }
 
-
-    if (defined $proto) {
-        $real_proto = " ($proto)";
-    } else {
-        $real_proto = '';
-        $proto = '@';
-    }
-
     my $true_name = $core ? $call : $sub;
 
     # TODO: This caching works, but I don't like using $void and
@@ -1238,10 +1277,16 @@ sub _make_fatal {
         }
     }
 
-    my @protos = fill_protos($proto);
+    if (defined $proto) {
+        $real_proto = " ($proto)";
+    } else {
+        $real_proto = '';
+        $proto = '@';
+    }
 
     if (!defined($code)) {
         # No code available, generate it now.
+        my @protos = fill_protos($proto);
 
         $code = qq[
             sub$real_proto {
@@ -1305,20 +1350,8 @@ sub _make_fatal {
     my $leak_guard;
 
     if ($lexical) {
-        # Do a little dance because set_prototype does not accept code
-        # refs (i.e. "my $s = sub {}; set_prototype($s, '$$);" fails)
-        if ($real_proto ne '') {
-            $leak_guard = set_prototype(sub {
-                    unshift @_, [$filename, $code, $sref, $call, \@protos, $pkg];
-                    goto \&_leak_guard;
-                }, $proto);
-
-        } else {
-            $leak_guard = sub {
-                unshift @_, [$filename, $code, $sref, $call, \@protos, $pkg];
-                goto \&_leak_guard;
-            };
-        }
+        $leak_guard = _make_leak_guard($filename, $code, $sref, $call,
+                                       $pkg, $proto, $real_proto);
     }
 
     my $installed_sub = $leak_guard || $code;
@@ -1386,102 +1419,120 @@ sub exception_class { return "autodie::exception" };
     }
 }
 
-sub _leak_guard {
-    my $call_data = shift;
-    my ($filename, $wrapped_sub, $orig_sub, $call, $protos, $pkg) = @{$call_data};
-    my $caller_level = 0;
-    my $caller;
-    my $leaked = 0;
+# Creates and returns a leak guard (with prototype if needed).
+sub _make_leak_guard {
+    my ($filename, $wrapped_sub, $orig_sub, $call, $pkg, $proto, $real_proto) = @_;
 
-    # NB: if we are wrapping a CORE sub, $orig_sub will be undef.
+    # The leak guard is rather lengthly (in fact it makes up the most
+    # of _make_leak_guard).  It is possible to split it into a large
+    # "generic" part and a small wrapper with call-specific
+    # information.  This was done in v2.19 and profiling suggested
+    # that we ended up using a substantial amount of runtime in "goto"
+    # between the leak guard(s) and the final sub.  Therefore, the two
+    # parts were merged into one to reduce the runtime overhead.
 
-    while ( ($caller = (caller $caller_level)[1]) =~ m{^\(eval \d+\)$} ) {
+    my $leak_guard = sub {
+        my $caller_level = 0;
+        my $caller;
 
-        # If our filename is actually an eval, and we
-        # reach it, then go to our autodying code immediatately.
+        while ( ($caller = (caller $caller_level)[1]) =~ m{^\(eval \d+\)$} ) {
 
-        last if ($caller eq $filename);
-        $caller_level++;
-    }
-    # We're now out of the eval stack.
+            # If our filename is actually an eval, and we
+            # reach it, then go to our autodying code immediatately.
 
-    if ($caller ne $filename) {
-        # Oh bother, we've leaked into another file.
-        $leaked = 1;
-    }
+            last if ($caller eq $filename);
+            $caller_level++;
+        }
 
-    if (defined($orig_sub)) {
-        # User sub.
-        goto $wrapped_sub unless $leaked;
-        goto $orig_sub;
-    }
+        # We're now out of the eval stack.
+
+        if ($caller eq $filename) {
+            # No leak, call the wrapper.  NB: In this case, it doesn't
+            # matter if it is a CORE sub or not.
+            goto $wrapped_sub;
+        }
 
-    # Core sub
-    if ($leaked) {
-        # If we're here, it must have been a core subroutine called.
+        # We leaked, time to call the original function.
+        # - for non-core functions that will be $orig_sub
+        goto $orig_sub if defined($orig_sub);
+
+        # We are wrapping a CORE sub
 
         # If we've cached a trampoline, then use it.
         my $trampoline_sub = $Trampoline_cache{$pkg}{$call};
 
         if (not $trampoline_sub) {
             # If we don't have a trampoline, we need to build it.
-
-            # We need to build a 'trampoline'. 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.
-            #
-            # We only generate trampolines when we need them, and we can cache
-            # them by subroutine + package.
+            # We only generate trampolines when we need them, and
+            # we can cache them by subroutine + package.
 
             # TODO: Consider caching on reusable_builtins status as well.
-            #       (In which case we can also remove the package line in the eval
-            #       later in this block.)
-
-            # TODO: It may be possible to combine this with write_invocation().
-
-            my $trampoline_code = 'sub {';
-
-            foreach my $proto (@{$protos}) {
-                local $" = ", ";    # So @args is formatted correctly.
-                my ($count, @args) = @$proto;
-                if ($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;
+            $trampoline_sub = _make_core_trampoline($call, $pkg, $proto);
 
-            {
-                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;
-
-            # Phew! Let's cache that, so we don't have to do it again.
+            # Let's cache that, so we don't have to do it again.
             $Trampoline_cache{$pkg}{$call} = $trampoline_sub;
         }
 
         # Bounce to our trampoline, which takes us to our core sub.
         goto \&$trampoline_sub;
+    };  # <-- end of leak guard
+
+    # If there is a prototype on the original sub, copy it to the leak
+    # guard.
+    if ($real_proto ne '') {
+        # The "\&" may appear to be redundant but set_prototype
+        # croaks when it is removed.
+        set_prototype(\&$leak_guard, $proto);
+    }
+
+    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;
 
-    # No leak, do a regular goto.
-    goto $wrapped_sub;
+    return $trampoline_sub;
 }
 
 # For some reason, dying while replacing our subs doesn't
diff --git a/cpan/autodie/lib/autodie.pm b/cpan/autodie/lib/autodie.pm
index 6416d2cbb7..60d1a46fec 100644
--- a/cpan/autodie/lib/autodie.pm
+++ b/cpan/autodie/lib/autodie.pm
@@ -10,7 +10,7 @@ our $VERSION;
 # ABSTRACT: Replace functions with ones that succeed or die with lexical scope
 
 BEGIN {
-    our $VERSION = '2.19'; # VERSION: Generated by DZP::OurPkg::Version
+    our $VERSION = '2.20'; # VERSION: Generated by DZP::OurPkg::Version
 }
 
 use constant ERROR_WRONG_FATAL => q{
@@ -427,6 +427,6 @@ Mark Reed and Roland Giersig -- Klingon translators.
 
 See the F<AUTHORS> file for full credits.  The latest version of this
 file can be found at
-L<http://github.com/pjf/autodie/tree/master/AUTHORS> .
+L<https://github.com/pjf/autodie/tree/master/AUTHORS> .
 
 =cut
diff --git a/cpan/autodie/lib/autodie/exception.pm b/cpan/autodie/lib/autodie/exception.pm
index ffdd4c804f..e5efc617a1 100644
--- a/cpan/autodie/lib/autodie/exception.pm
+++ b/cpan/autodie/lib/autodie/exception.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use Carp qw(croak);
 
-our $VERSION = '2.19'; # VERSION: Generated by DZP::OurPkg:Version
+our $VERSION = '2.20'; # VERSION: Generated by DZP::OurPkg:Version
 # ABSTRACT: Exceptions from autodying functions.
 
 our $DEBUG = 0;
diff --git a/cpan/autodie/lib/autodie/exception/system.pm b/cpan/autodie/lib/autodie/exception/system.pm
index 137bff1654..8a2a10190c 100644
--- a/cpan/autodie/lib/autodie/exception/system.pm
+++ b/cpan/autodie/lib/autodie/exception/system.pm
@@ -5,7 +5,7 @@ use warnings;
 use base 'autodie::exception';
 use Carp qw(croak);
 
-our $VERSION = '2.19'; # VERSION: Generated by DZP::OurPkg:Version
+our $VERSION = '2.20'; # VERSION: Generated by DZP::OurPkg:Version
 
 # ABSTRACT: Exceptions from autodying system().
 
diff --git a/cpan/autodie/lib/autodie/hints.pm b/cpan/autodie/lib/autodie/hints.pm
index 350738e18a..c9e6275c7d 100644
--- a/cpan/autodie/lib/autodie/hints.pm
+++ b/cpan/autodie/lib/autodie/hints.pm
@@ -5,7 +5,7 @@ use warnings;
 
 use constant PERL58 => ( $] < 5.009 );
 
-our $VERSION = '2.19'; # VERSION: Generated by DZP::OurPkg:Version
+our $VERSION = '2.20'; # VERSION: Generated by DZP::OurPkg:Version
 
 # ABSTRACT: Provide hints about user subroutines to autodie
 
diff --git a/cpan/autodie/lib/autodie/skip.pm b/cpan/autodie/lib/autodie/skip.pm
index a9bac8300c..6519d5ef20 100644
--- a/cpan/autodie/lib/autodie/skip.pm
+++ b/cpan/autodie/lib/autodie/skip.pm
@@ -2,7 +2,7 @@ package autodie::skip;
 use strict;
 use warnings;
 
-our $VERSION = '2.19'; # VERSION
+our $VERSION = '2.20'; # VERSION
 
 # This package exists purely so people can inherit from it,
 # which isn't at all how roles are supposed to work, but it's