This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update autodie to CPAN version 2.23
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Tue, 28 Jan 2014 09:19:51 +0000 (09:19 +0000)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Tue, 28 Jan 2014 09:21:17 +0000 (09:21 +0000)
  [DELTA]

2.23      2014-01-27 13:50:55EST+1100 Australia/Melbourne

        * TEST / BUGFIX: Improved testing support on Android
          and Blackberry devices. (GH #44, thanks to
          Hugmeir.)

        * TEST / INTERNAL / TRAVIS: Various non-code
          tweaks to make travis-ci more happy with testing
          autodie.

        * BUGFIX: autodie no longer weakens strict by allowing
          undeclared variables with the same name as built-ins.
          (RT #74246, thanks to Neils Thykier and Father
          Chrysostomos.)

        * BUGFIX: `use autodie qw( foo ! foo);` now correctly
          insists that we have hints for foo. (Thanks Niels Thykier)

        * INTERNAL: Improved benchmarking code, thanks to
          Niels Thykier.

12 files changed:
MANIFEST
Porting/Maintainers.pl
cpan/autodie/lib/Fatal.pm
cpan/autodie/lib/autodie.pm
cpan/autodie/lib/autodie/exception.pm
cpan/autodie/lib/autodie/exception/system.pm
cpan/autodie/lib/autodie/hints.pm
cpan/autodie/lib/autodie/skip.pm
cpan/autodie/t/Fatal.t
cpan/autodie/t/args.t [new file with mode: 0644]
cpan/autodie/t/open.t
cpan/autodie/t/rt-74246.t [new file with mode: 0644]

index e62ffb9..5e47478 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -46,6 +46,7 @@ cpan/autodie/lib/autodie.pm           Functions succeed or die with lexical scope
 cpan/autodie/lib/autodie/skip.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
 cpan/autodie/t/autodie_skippy.pm
 cpan/autodie/t/autodie.t               autodie - Basic functionality
 cpan/autodie/t/autodie_test_module.pm  autodie - test helper
@@ -101,6 +102,7 @@ cpan/autodie/t/no_carp.t
 cpan/autodie/t/open.t                  autodie - Testing open
 cpan/autodie/t/recv.t                  autodie - send/recv tests
 cpan/autodie/t/repeat.t                        autodie - repeat autodie leak tests
+cpan/autodie/t/rt-74246.t
 cpan/autodie/t/scope_leak.t            autodie - file scope leak tests
 cpan/autodie/t/skip.t
 cpan/autodie/t/string-eval-basic.t     autodie - Basic string eval test
index b7445d0..9ad3e00 100755 (executable)
@@ -130,7 +130,7 @@ use File::Glob qw(:case);
     },
 
     'autodie' => {
-        'DISTRIBUTION' => 'PJF/autodie-2.22.tar.gz',
+        'DISTRIBUTION' => 'PJF/autodie-2.23.tar.gz',
         'FILES'        => q[cpan/autodie],
         'EXCLUDED'     => [
             qr{benchmarks},
index bea5231..e538e20 100644 (file)
@@ -48,7 +48,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.22'; # VERSION: Generated by DZP::OurPkg::Version
+our $VERSION = '2.23'; # VERSION: Generated by DZP::OurPkg::Version
 
 our $Debug ||= 0;
 
@@ -144,6 +144,7 @@ my %TAGS = (
     ':2.20'  => [qw(:default)],
     ':2.21'  => [qw(:default)],
     ':2.22'  => [qw(:default)],
+    ':2.23'  => [qw(:default)],
 );
 
 # chmod was only introduced in 2.07
@@ -378,15 +379,16 @@ sub import {
     # 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);
+    # NB: _translate_import_args re-orders everything for us, so
+    # we don't have to worry about stuff like:
     #
-    # 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).
+    #     :default :void :io
+    #
+    # That will (correctly) translated into
+    #
+    #     expand(:defaults-without-io) :void :io
+    #
+    # by _translate_import_args.
     for my $func ($class->_translate_import_args(@fatalise_these)) {
 
         if ($func eq VOID_TAG) {
@@ -503,18 +505,26 @@ sub _install_subs {
 
     # It does not hurt to do this in a predictable order, and might help debugging.
     foreach my $sub_name (sort keys %$subs_to_reinstate) {
-        my $sub_ref= $subs_to_reinstate->{$sub_name};
 
-        my $full_path = $pkg_sym.$sub_name;
-
-        # Copy symbols across to temp area.
+        # 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
 
-        no strict 'refs';   ## no critic
+        my $sub_ref= $subs_to_reinstate->{$sub_name};
 
-        local *__tmp = *{ $full_path };
+        my $full_path = $pkg_sym.$sub_name;
+        my $oldglob = *$full_path;
 
         # Nuke the old glob.
-        { no strict; delete $pkg_sym->{$sub_name}; }    ## no critic
+        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
@@ -522,16 +532,12 @@ sub _install_subs {
         # the scalar slot.  Thanks to Ben Morrow for spotting this.
 
         foreach my $slot (qw( SCALAR ARRAY HASH IO ) ) {
-            next unless defined *__tmp{ $slot };
-            *{ $full_path } = *__tmp{ $slot };
+            next unless defined *$oldglob{$slot};
+            *alias = *$oldglob{$slot};
         }
 
-        # Put back the old sub (if there was one).
-
         if ($sub_ref) {
-
-            no strict;  ## no critic
-            *{ $full_path } = $sub_ref;
+            *$full_path = $sub_ref;
         }
     }
 
@@ -597,31 +603,83 @@ sub unimport {
 sub _translate_import_args {
     my ($class, @args) = @_;
     my @result;
-    for my $a (@args){
+    my %seen;
+
+    if (@args < 2) {
+        # Optimize for this case, as it is fairly common.  (e.g. use
+        # autodie; or use autodie qw(:all); both trigger this).
+        return unless @args;
+
+        # Not a (known) tag, pass through.
+        return @args unless exists($TAGS{$args[0]});
+
+        # 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.
+        return map { substr($_, 6) } @{ $class->_expand_tag($args[0]) };
+    }
+
+    # We want to translate
+    #
+    #     :default :void :io
+    #
+    # into (pseudo-ish):
+    #
+    #     expanded(:threads) :void expanded(:io)
+    #
+    # We accomplish this by "reverse, expand + filter, reverse".
+    for my $a (reverse(@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};
+            push(@result,
+                 # Remove duplicates after ...
+                 grep { !$seen{$_}++ }
+                 # we have stripped CORE:: (see above)
+                 map { substr($_, 6) }
+                 # We take the elements in reverse order
+                 # (as @result be reversed later).
+                 reverse(@{$expanded}));
         } else {
-            #pass through
+            # pass through - no filtering here for tags.
+            #
+            # The reason for not filtering tags cases like:
+            #
+            #    ":default :void :io :void :threads"
+            #
+            # As we have reversed args, we see this as:
+            #
+            #    ":threads :void :io :void* :default*"
+            #
+            # (Entries marked with "*" will be filtered out completely).  When
+            # reversed again, this will be:
+            #
+            #    ":io :void :threads"
+            #
+            # But we would rather want it to be:
+            #
+            #    ":void :io :threads" or ":void :io :void :threads"
+            #
+
+            my $letter = substr($a, 0, 1);
+            if ($letter ne ':' && $a ne INSIST_TAG) {
+                next if $seen{$a}++;
+                if ($letter eq '!' and $seen{substr($a, 1)}++) {
+                    my $name = substr($a, 1);
+                    # People are being silly and doing:
+                    #
+                    #    use autodie qw(!a a);
+                    #
+                    # Enjoy this little O(n) clean up...
+                    @result = grep { $_ ne $name } @result;
+                }
+            }
             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;
+    # Reverse the result to restore the input order
+    return reverse(@result);
 }
 
 
@@ -1849,6 +1907,6 @@ L<autodie> for a nicer way to use lexical Fatal.
 L<IPC::System::Simple> for a similar idea for calls to C<system()>
 and backticks.
 
-=for Pod::Coverage exception_class fill_protos one_invocation throw write_invocation
+=for Pod::Coverage exception_class fill_protos one_invocation throw write_invocation ERROR_NO_IPC_SYS_SIMPLE LEXICAL_TAG
 
 =cut
index 1e9f852..ed5a612 100644 (file)
@@ -10,7 +10,7 @@ our $VERSION;
 # ABSTRACT: Replace functions with ones that succeed or die with lexical scope
 
 BEGIN {
-    our $VERSION = '2.22'; # VERSION: Generated by DZP::OurPkg::Version
+    our $VERSION = '2.23'; # VERSION: Generated by DZP::OurPkg::Version
 }
 
 use constant ERROR_WRONG_FATAL => q{
@@ -265,6 +265,10 @@ C<system> and C<exec> with:
 
 =head1 FUNCTION SPECIFIC NOTES
 
+=head2 print
+
+The autodie pragma B<<does not check calls to C<print>>>.
+
 =head2 flock
 
 It is not considered an error for C<flock> to return false if it fails
index 142e5db..0081860 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use Carp qw(croak);
 
-our $VERSION = '2.22'; # VERSION: Generated by DZP::OurPkg:Version
+our $VERSION = '2.23'; # VERSION: Generated by DZP::OurPkg:Version
 # ABSTRACT: Exceptions from autodying functions.
 
 our $DEBUG = 0;
@@ -404,6 +404,8 @@ sub _format_open_with_mode {
     elsif ($mode eq '>')  { $wordy_mode = 'writing';   }
     elsif ($mode eq '>>') { $wordy_mode = 'appending'; }
 
+    $file = '<undef>' if not defined $file;
+
     return sprintf _FORMAT_OPEN, $file, $wordy_mode, $error if $wordy_mode;
 
     Carp::confess("Internal autodie::exception error: Don't know how to format mode '$mode'.");
index 7bb1f5f..2d734fe 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 use base 'autodie::exception';
 use Carp qw(croak);
 
-our $VERSION = '2.22'; # VERSION: Generated by DZP::OurPkg:Version
+our $VERSION = '2.23'; # VERSION: Generated by DZP::OurPkg:Version
 
 # ABSTRACT: Exceptions from autodying system().
 
index d63849f..17c898a 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 use constant PERL58 => ( $] < 5.009 );
 
-our $VERSION = '2.22'; # VERSION: Generated by DZP::OurPkg:Version
+our $VERSION = '2.23'; # VERSION: Generated by DZP::OurPkg:Version
 
 # ABSTRACT: Provide hints about user subroutines to autodie
 
index 9eb4cf4..af40662 100644 (file)
@@ -2,7 +2,7 @@ package autodie::skip;
 use strict;
 use warnings;
 
-our $VERSION = '2.22'; # VERSION
+our $VERSION = '2.23'; # 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
index a291837..b0db13d 100644 (file)
@@ -5,7 +5,7 @@ use constant NO_SUCH_FILE => "this_file_or_dir_had_better_not_exist_XYZZY";
 
 use Test::More tests => 17;
 
-use Fatal qw(open close :void opendir);
+use Fatal qw(:io :void opendir);
 
 eval { open FOO, "<".NO_SUCH_FILE };   # Two arg open
 like($@, qr/^Can't open/, q{Package Fatal::open});
diff --git a/cpan/autodie/t/args.t b/cpan/autodie/t/args.t
new file mode 100644 (file)
index 0000000..d44bb83
--- /dev/null
@@ -0,0 +1,46 @@
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+require Fatal;
+
+my @default = expand(':default');
+my @threads = expand(':threads');
+my @io = expand(':io');
+my %io_hash = map { $_ => 1 } @io;
+my @default_minus_io = grep { !exists($io_hash{$_}) } @default;
+
+is_deeply(translate('!a', 'a'), ['!a'], 'Keeps insist variant');
+
+is_deeply(translate(':default'), \@default,
+          'translate and expand agrees');
+
+is_deeply(translate(':default', ':void', ':io'),
+          [@default_minus_io, ':void', @io],
+          ':void position is respected');
+
+is_deeply(translate(':default', ':void', ':io', ':void', ':threads'),
+          [':void', @io, ':void', @threads],
+          ':void (twice) position are respected');
+
+is_deeply(translate(':default', '!', ':io'),
+    [@default_minus_io, '!', @io], '! position is respected');
+
+is_deeply(translate(':default', '!', ':io', '!', ':threads'),
+          ['!', @io, '!', @threads],
+          '! (twice) positions are respected');
+
+is_deeply(translate(':default', '!open', '!', ':io'),
+    [@default_minus_io, '!open', '!', grep { $_ ne 'open' } @io],
+          '!open ! :io works as well');
+
+sub expand {
+    # substr is to strip "CORE::" without modifying $_
+    return map { substr($_, 6) } @{Fatal->_expand_tag(@_)};
+}
+
+sub translate {
+    return [Fatal->_translate_import_args(@_)];
+}
index d11dda5..51a1f2d 100644 (file)
@@ -53,12 +53,18 @@ unlike($@, qr/at \S+ line \d+\s+at \S+ line \d+/, "...but not too mentions");
 # Sniff to see if we can run 'true' on this system.  Changes we can't
 # on non-Unix systems.
 
+use Config;
+my @true = ($^O =~ /android/
+            || ($Config{usecrosscompile} && $^O eq 'nto' ))
+        ? ('sh', '-c', 'true $@', '--')
+        : 'true';
+
 eval {
     use autodie;
 
     die "Windows and VMS do not support multi-arg pipe" if $^O eq "MSWin32" or $^O eq 'VMS';
 
-    open(my $fh, '-|', "true");
+    open(my $fh, '-|', @true);
 };
 
 SKIP: {
@@ -68,10 +74,10 @@ SKIP: {
         use autodie;
 
         my $fh;
-        open $fh, "-|", "true";
-        open $fh, "-|", "true", "foo";
-        open $fh, "-|", "true", "foo", "bar";
-        open $fh, "-|", "true", "foo", "bar", "baz";
+        open $fh, "-|", @true;
+        open $fh, "-|", @true, "foo";
+        open $fh, "-|", @true, "foo", "bar";
+        open $fh, "-|", @true, "foo", "bar", "baz";
     };
 
     is $@, '', "multi arg piped open does not fail";
diff --git a/cpan/autodie/t/rt-74246.t b/cpan/autodie/t/rt-74246.t
new file mode 100644 (file)
index 0000000..e4d6210
--- /dev/null
@@ -0,0 +1,14 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 1;
+
+eval q{
+    use strict;
+    no warnings; # Suppress a "helpful" warning on STDERR
+    use autodie qw(open);
+    $open = 1;
+};
+like($@, qr/Global symbol "\$open" requires explicit package name/,
+     'autodie does not break "use strict;"');