summaryrefslogtreecommitdiff
path: root/cpan/autodie
diff options
context:
space:
mode:
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>2014-01-28 09:19:51 +0000
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>2014-01-28 09:21:17 +0000
commitc7e473585ac77040bae8196bc08e7ef3a5b1ba51 (patch)
treee77eca226e46d16b5acb36639166615dda1521fb /cpan/autodie
parentfb29cc72fe9ef39100123477fffae4fad34866b7 (diff)
downloadperl-c7e473585ac77040bae8196bc08e7ef3a5b1ba51.tar.gz
Update autodie to CPAN version 2.23
[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.
Diffstat (limited to 'cpan/autodie')
-rw-r--r--cpan/autodie/lib/Fatal.pm144
-rw-r--r--cpan/autodie/lib/autodie.pm6
-rw-r--r--cpan/autodie/lib/autodie/exception.pm4
-rw-r--r--cpan/autodie/lib/autodie/exception/system.pm2
-rw-r--r--cpan/autodie/lib/autodie/hints.pm2
-rw-r--r--cpan/autodie/lib/autodie/skip.pm2
-rw-r--r--cpan/autodie/t/Fatal.t2
-rw-r--r--cpan/autodie/t/args.t46
-rw-r--r--cpan/autodie/t/open.t16
-rw-r--r--cpan/autodie/t/rt-74246.t14
10 files changed, 184 insertions, 54 deletions
diff --git a/cpan/autodie/lib/Fatal.pm b/cpan/autodie/lib/Fatal.pm
index bea5231420..e538e20d68 100644
--- a/cpan/autodie/lib/Fatal.pm
+++ b/cpan/autodie/lib/Fatal.pm
@@ -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
diff --git a/cpan/autodie/lib/autodie.pm b/cpan/autodie/lib/autodie.pm
index 1e9f85273c..ed5a612efe 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.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
diff --git a/cpan/autodie/lib/autodie/exception.pm b/cpan/autodie/lib/autodie/exception.pm
index 142e5db692..0081860576 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.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'.");
diff --git a/cpan/autodie/lib/autodie/exception/system.pm b/cpan/autodie/lib/autodie/exception/system.pm
index 7bb1f5f192..2d734fe7f2 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.22'; # VERSION: Generated by DZP::OurPkg:Version
+our $VERSION = '2.23'; # 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 d63849f82d..17c898a900 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.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
diff --git a/cpan/autodie/lib/autodie/skip.pm b/cpan/autodie/lib/autodie/skip.pm
index 9eb4cf4404..af40662810 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.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
diff --git a/cpan/autodie/t/Fatal.t b/cpan/autodie/t/Fatal.t
index a291837d13..b0db13d63e 100644
--- a/cpan/autodie/t/Fatal.t
+++ b/cpan/autodie/t/Fatal.t
@@ -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
index 0000000000..d44bb830d8
--- /dev/null
+++ b/cpan/autodie/t/args.t
@@ -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(@_)];
+}
diff --git a/cpan/autodie/t/open.t b/cpan/autodie/t/open.t
index d11dda5772..51a1f2df20 100644
--- a/cpan/autodie/t/open.t
+++ b/cpan/autodie/t/open.t
@@ -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
index 0000000000..e4d6210609
--- /dev/null
+++ b/cpan/autodie/t/rt-74246.t
@@ -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;"');