The Error.pm shipped with Git as a fallback if there was no Error.pm
on the system was released in April 2006, there's been dozens of
releases since then, the latest at August 7, 2017, let's update to
that.
This undoes a local hack we'd accumulated in 96bc4de85c ("Eliminate
Scalar::Util usage from private-Error.pm", 2006-07-26), it's been
redundant since my d48b284183 ("perl: bump the required Perl version
to 5.8 from 5.6.[21]", 2010-09-24).
This also undoes 3a51467b94 ("Typo fix: replacing it's -> its",
2013-04-13). This is the Nth time I find that some upstream code of
ours (in contrib/, in sha1dc/ and now in perl/ ...) has diverged from
upstream because of some tree-wide typo fixing. Let's not do those
fixes against upstream projects, it's more valuable that we have a 1=1
mapping to upstream than to fix typos in docs we never even generate
from this code. If someone wants to fix typos in them fine, but they
should do it with a patch to upstream which git.git can then
incorporate.
The upstream code doesn't cleanly pass a --check, so I'm adding a
.gitattributes file for similar reasons as done for sha1dc in
5d184f468e ("sha1dc: ignore indent-with-non-tab whitespace
violations", 2017-06-06).
Signed-off-by: Ævar Arnfjörð Bjarmason
---
perl/Git/FromCPAN/.gitattributes | 1 +
perl/Git/FromCPAN/Error.pm | 296 +--
2 files changed, 256 insertions(+), 41 deletions(-)
create mode 100644 perl/Git/FromCPAN/.gitattributes
diff --git a/perl/Git/FromCPAN/.gitattributes b/perl/Git/FromCPAN/.gitattributes
new file mode 100644
index 00..8b64fc5e22
--- /dev/null
+++ b/perl/Git/FromCPAN/.gitattributes
@@ -0,0 +1 @@
+/Error.pm whitespace=-blank-at-eof
diff --git a/perl/Git/FromCPAN/Error.pm b/perl/Git/FromCPAN/Error.pm
index 6098135ae2..f9c36e9e98 100644
--- a/perl/Git/FromCPAN/Error.pm
+++ b/perl/Git/FromCPAN/Error.pm
@@ -12,10 +12,12 @@
package Error;
use strict;
+use warnings;
+
use vars qw($VERSION);
use 5.004;
-$VERSION = "0.15009";
+$VERSION = "0.17025";
use overload (
'""' => 'stringify',
@@ -32,21 +34,35 @@ $Error::THROWN = undef; # last error thrown, a
workaround until die $ref works
my $LAST; # Last error created
my %ERROR; # Last error associated with package
-sub throw_Error_Simple
+sub _throw_Error_Simple
{
my $args = shift;
return Error::Simple->new($args->{'text'});
}
-$Error::ObjectifyCallback = \_Error_Simple;
+$Error::ObjectifyCallback = \&_throw_Error_Simple;
# Exported subs are defined in Error::subs
+use Scalar::Util ();
+
sub import {
shift;
+my @tags = @_;
local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
-Error::subs->import(@_);
+
+@tags = grep {
+ if( $_ eq ':warndie' ) {
+ Error::WarnDie->import();
+ 0;
+ }
+ else {
+ 1;
+ }
+} @tags;
+
+Error::subs->import(@tags);
}
# I really want to use last for the name of this method, but it is a keyword
@@ -107,10 +123,6 @@ sub stacktrace {
$text;
}
-# Allow error propagation, ie
-#
-# $ber->encode(...) or
-#return Error->prior($ber)->associate($ldap);
sub associate {
my $err = shift;
@@ -130,6 +142,7 @@ sub associate {
return;
}
+
sub new {
my $self = shift;
my($pkg,$file,$line) = caller($Error::Depth);
@@ -246,6 +259,10 @@ sub value {
package Error::Simple;
+use vars qw($VERSION);
+
+$VERSION = "0.17025";
+
@Error::Simple::ISA = qw(Error);
sub new {
@@ -288,14 +305,6 @@ use vars qw(@EXPORT_OK @ISA %EXPORT_TAGS);
@ISA = qw(Exporter);
-
-sub blessed {
- my $item = shift;
- local $@; # don't kill an outer $@
- ref $item and eval { $item->can('can') };
-}
-
-
sub run_clauses ($$$\@) {
my($clauses,$err,$wantarray,$result) = @_;
my $code = undef;
@@ -314,16 +323,17 @@ sub run_clauses ($$$\@) {
my $pkg = $catch->[$i];
unless(defined $pkg) {
#except
- splice(@$catch,$i,2,$catch->[$i+1]->());
+ splice(@$catch,$i,2,$catch->[$i+1]->($err));
$i -= 2;
next CATCHLOOP;
}
- elsif(blessed($err) && $err->isa($pkg)) {
+ elsif(Scalar::Util::blessed($err) && $err->isa($pkg)) {
$code = $catch->[$i+1];
while(1) {
my $more = 0;
- local($Error::THROWN);
+ local($Error::THROWN, $@);
my $ok = eval {
+ $@ = $err;
if($wantarray) {
@{$result} = $code->($err,\$more);
}
@@ -341,10 +351,9 @@ sub run_clauses ($$$\@) {
undef $err;
}
else {
- $err =
