Perltidy Carp.pm and Carp.t

[committer's note: while we tend to avoid "perltidy this" commits which
 enforce a new author's style upon existing code, Dave's working to
 pick up an existing codebase with a horribly inconsistent style
 and modernize and (hopefully) dual-life it eventually]

2 files changed, 359 insertions, 296 deletions

diff --git a/lib/Carp.pm b/lib/Carp.pm
index a1d743f31d..d85a94085d 100644
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -8,14 +8,14 @@ our $VERSION = '1.19';
 our $MaxEvalLen = 0;
 our $Verbose    = 0;
 our $CarpLevel  = 0;
-our $MaxArgLen  = 64;   # How much of each argument to print. 0 = all.
-our $MaxArgNums = 8;    # How many arguments to print. 0 = all.
+our $MaxArgLen  = 64;    # How much of each argument to print. 0 = all.
+our $MaxArgNums = 8;     # How many arguments to print. 0 = all.
 
 require Exporter;
-our @ISA = ('Exporter');
-our @EXPORT = qw(confess croak carp);
+our @ISA       = ('Exporter');
+our @EXPORT    = qw(confess croak carp);
 our @EXPORT_OK = qw(cluck verbose longmess shortmess);
-our @EXPORT_FAIL = qw(verbose);	# hook to enable verbose mode
+our @EXPORT_FAIL = qw(verbose);    # hook to enable verbose mode
 
 # The members of %Internal are packages that are internal to perl.
 # Carp will not report errors from within these packages if it
@@ -57,97 +57,107 @@ sub longmess {
     # behaviour, so the replacement has to emulate that behaviour.
     my $cgc = _cgc();
     my $call_pack = $cgc ? $cgc->() : caller();
-    if ($Internal{$call_pack} or $CarpInternal{$call_pack}) {
-      return longmess_heavy(@_);
+    if ( $Internal{$call_pack} or $CarpInternal{$call_pack} ) {
+        return longmess_heavy(@_);
     }
     else {
-      local $CarpLevel = $CarpLevel + 1;
-      return longmess_heavy(@_);
+        local $CarpLevel = $CarpLevel + 1;
+        return longmess_heavy(@_);
     }
-};
+}
 
 our @CARP_NOT;
+
 sub shortmess {
     my $cgc = _cgc();
+
     # Icky backwards compatibility wrapper. :-(
     local @CARP_NOT = $cgc ? $cgc->() : caller();
     shortmess_heavy(@_);
-};
+}
 
-sub croak   { die  shortmess @_ }
-sub confess { die  longmess  @_ }
+sub croak   { die shortmess @_ }
+sub confess { die longmess @_ }
 sub carp    { warn shortmess @_ }
-sub cluck   { warn longmess  @_ }
+sub cluck   { warn longmess @_ }
 
 sub caller_info {
-  my $i = shift(@_) + 1;
-  my %call_info;
-  my $cgc = _cgc();
-  {
-  package DB;
-  @DB::args = \$i; # A sentinel, which no-one else has the address of
-  @call_info{
-    qw(pack file line sub has_args wantarray evaltext is_require)
-  } = $cgc ? $cgc->($i) : caller($i);
-  }
-  
-  unless (defined $call_info{pack}) {
-    return ();
-  }
-
-  my $sub_name = Carp::get_subname(\%call_info);
-  if ($call_info{has_args}) {
-    my @args;
-    if (@DB::args == 1 && ref $DB::args[0] eq ref \$i && $DB::args[0] == \$i) {
-      @DB::args = (); # Don't let anyone see the address of $i
-      local $@;
-      my $where = eval {
-	my $func = $cgc or return '';
-	my $gv = B::svref_2object($func)->GV;
-	my $package = $gv->STASH->NAME;
-	my $subname = $gv->NAME;
-	return unless defined $package && defined $subname;
-	# returning CORE::GLOBAL::caller isn't useful for tracing the cause:
-	return if $package eq 'CORE::GLOBAL' && $subname eq 'caller';
-	" in &${package}::$subname";
-      } // '';
-      @args = "** Incomplete caller override detected$where; \@DB::args were not set **";
-    } else {
-      @args = map {Carp::format_arg($_)} @DB::args;
+    my $i = shift(@_) + 1;
+    my %call_info;
+    my $cgc = _cgc();
+    {
+        package DB;
+        @DB::args = \$i;    # A sentinel, which no-one else has the address of
+        @call_info{
+            qw(pack file line sub has_args wantarray evaltext is_require) }
+            = $cgc ? $cgc->($i) : caller($i);
     }
-    if ($MaxArgNums and @args > $MaxArgNums) { # More than we want to show?
-      $#args = $MaxArgNums;
-      push @args, '...';
+
+    unless ( defined $call_info{pack} ) {
+        return ();
+    }
+
+    my $sub_name = Carp::get_subname( \%call_info );
+    if ( $call_info{has_args} ) {
+        my @args;
+        if (   @DB::args == 1
+            && ref $DB::args[0] eq ref \$i
+            && $DB::args[0] == \$i ) {
+            @DB::args = ();    # Don't let anyone see the address of $i
+            local $@;
+            my $where = eval {
+                my $func    = $cgc or return '';
+                my $gv      = B::svref_2object($func)->GV;
+                my $package = $gv->STASH->NAME;
+                my $subname = $gv->NAME;
+                return unless defined $package && defined $subname;
+
+                # returning CORE::GLOBAL::caller isn't useful for tracing the cause:
+                return if $package eq 'CORE::GLOBAL' && $subname eq 'caller';
+                " in &${package}::$subname";
+            } // '';
+            @args
+                = "** Incomplete caller override detected$where; \@DB::args were not set **";
+        }
+        else {
+            @args = map { Carp::format_arg($_) } @DB::args;
+        }
+        if ( $MaxArgNums and @args > $MaxArgNums )
+        {    # More than we want to show?
+            $#args = $MaxArgNums;
+            push @args, '...';
+        }
+
+        # Push the args onto the subroutine
+        $sub_name .= '(' . join( ', ', @args ) . ')';
     }
-    # Push the args onto the subroutine
-    $sub_name .= '(' . join (', ', @args) . ')';
-  }
-  $call_info{sub_name} = $sub_name;
-  return wantarray() ? %call_info : \%call_info;
+    $call_info{sub_name} = $sub_name;
+    return wantarray() ? %call_info : \%call_info;
 }
 
 # Transform an argument to a function into a string.
 sub format_arg {
-  my $arg = shift;
-  if (ref($arg)) {
-      $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
-  }
-  if (defined($arg)) {
-      $arg =~ s/'/\\'/g;
-      $arg = str_len_trim($arg, $MaxArgLen);
-  
-      # Quote it?
-      $arg = "'$arg'" unless $arg =~ /^-?[\d.]+\z/;
-  } else {
-      $arg = 'undef';
-  }
-
-  # The following handling of "control chars" is direct from
-  # the original code - it is broken on Unicode though.
-  # Suggestions?
-  utf8::is_utf8($arg)
-    or $arg =~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord($1))/eg;
-  return $arg;
+    my $arg = shift;
+    if ( ref($arg) ) {
+        $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
+    }
+    if ( defined($arg) ) {
+        $arg =~ s/'/\\'/g;
+        $arg = str_len_trim( $arg, $MaxArgLen );
+
+        # Quote it?
+        $arg = "'$arg'" unless $arg =~ /^-?[\d.]+\z/;
+    }
+    else {
+        $arg = 'undef';
+    }
+
+    # The following handling of "control chars" is direct from
+    # the original code - it is broken on Unicode though.
+    # Suggestions?
+    utf8::is_utf8($arg)
+        or $arg =~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord($1))/eg;
+    return $arg;
 }
 
 # Takes an inheritance cache and a package and returns
@@ -156,149 +166,148 @@ sub format_arg {
 # for.
 sub get_status {
     my $cache = shift;
-    my $pkg = shift;
-    $cache->{$pkg} ||= [{$pkg => $pkg}, [trusts_directly($pkg)]];
-    return @{$cache->{$pkg}};
+    my $pkg   = shift;
+    $cache->{$pkg} ||= [ { $pkg => $pkg }, [ trusts_directly($pkg) ] ];
+    return @{ $cache->{$pkg} };
 }
 
 # Takes the info from caller() and figures out the name of
 # the sub/require/eval
 sub get_subname {
-  my $info = shift;
-  if (defined($info->{evaltext})) {
-    my $eval = $info->{evaltext};
-    if ($info->{is_require}) {
-      return "require $eval";
-    }
-    else {
-      $eval =~ s/([\\\'])/\\$1/g;
-      return "eval '" . str_len_trim($eval, $MaxEvalLen) . "'";
+    my $info = shift;
+    if ( defined( $info->{evaltext} ) ) {
+        my $eval = $info->{evaltext};
+        if ( $info->{is_require} ) {
+            return "require $eval";
+        }
+        else {
+            $eval =~ s/([\\\'])/\\$1/g;
+            return "eval '" . str_len_trim( $eval, $MaxEvalLen ) . "'";
+        }
     }
-  }
 
-  return ($info->{sub} eq '(eval)') ? 'eval {...}' : $info->{sub};
+    return ( $info->{sub} eq '(eval)' ) ? 'eval {...}' : $info->{sub};
 }
 
 # Figures out what call (from the point of view of the caller)
 # the long error backtrace should start at.
 sub long_error_loc {
-  my $i;
-  my $lvl = $CarpLevel;
-  {
-    ++$i;
-    my $cgc = _cgc();
-    my $pkg = $cgc ? $cgc->($i) : caller($i);
-    unless(defined($pkg)) {
-      # This *shouldn't* happen.
-      if (%Internal) {
-        local %Internal;
-        $i = long_error_loc();
-        last;
-      }
-      else {
-        # OK, now I am irritated.
-        return 2;
-      }
+    my $i;
+    my $lvl = $CarpLevel;
+    {
+        ++$i;
+        my $cgc = _cgc();
+        my $pkg = $cgc ? $cgc->($i) : caller($i);
+        unless ( defined($pkg) ) {
+
+            # This *shouldn't* happen.
+            if (%Internal) {
+                local %Internal;
+                $i = long_error_loc();
+                last;
+            }
+            else {
+
+                # OK, now I am irritated.
+                return 2;
+            }
+        }
+        redo if $CarpInternal{$pkg};
+        redo unless 0 > --$lvl;
+        redo if $Internal{$pkg};
     }
-    redo if $CarpInternal{$pkg};
-    redo unless 0 > --$lvl;
-    redo if $Internal{$pkg};
-  }
-  return $i - 1;
+    return $i - 1;
 }
 
-
 sub longmess_heavy {
-  return @_ if ref($_[0]); # don't break references as exceptions
-  my $i = long_error_loc();
-  return ret_backtrace($i, @_);
+    return @_ if ref( $_[0] );    # don't break references as exceptions
+    my $i = long_error_loc();
+    return ret_backtrace( $i, @_ );
 }
 
 # Returns a full stack backtrace starting from where it is
 # told.
 sub ret_backtrace {
-  my ($i, @error) = @_;
-  my $mess;
-  my $err = join '', @error;
-  $i++;
-
-  my $tid_msg = '';
-  if (defined &threads::tid) {
-    my $tid = threads->tid;
-    $tid_msg = " thread $tid" if $tid;
-  }
-
-  my %i = caller_info($i);
-  $mess = "$err at $i{file} line $i{line}$tid_msg\n";
-
-  while (my %i = caller_info(++$i)) {
-      $mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
-  }
-  
-  return $mess;
+    my ( $i, @error ) = @_;
+    my $mess;
+    my $err = join '', @error;
+    $i++;
+
+    my $tid_msg = '';
+    if ( defined &threads::tid ) {
+        my $tid = threads->tid;
+        $tid_msg = " thread $tid" if $tid;
+    }
+
+    my %i = caller_info($i);
+    $mess = "$err at $i{file} line $i{line}$tid_msg\n";
+
+    while ( my %i = caller_info( ++$i ) ) {
+        $mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
+    }
+
+    return $mess;
 }
 
 sub ret_summary {
-  my ($i, @error) = @_;
-  my $err = join '', @error;
-  $i++;
-
-  my $tid_msg = '';
-  if (defined &threads::tid) {
-    my $tid = threads->tid;
-    $tid_msg = " thread $tid" if $tid;
-  }
-
-  my %i = caller_info($i);
-  return "$err at $i{file} line $i{line}$tid_msg\n";
-}
+    my ( $i, @error ) = @_;
+    my $err = join '', @error;
+    $i++;
 
+    my $tid_msg = '';
+    if ( defined &threads::tid ) {
+        my $tid = threads->tid;
+        $tid_msg = " thread $tid" if $tid;
+    }
 
-sub short_error_loc {
-  # You have to create your (hash)ref out here, rather than defaulting it
-  # inside trusts *on a lexical*, as you want it to persist across calls.
-  # (You can default it on $_[2], but that gets messy)
-  my $cache = {};
-  my $i = 1;
-  my $lvl = $CarpLevel;
-  {
-    my $cgc = _cgc();
-    my $called = $cgc ? $cgc->($i) : caller($i);
-    $i++;
-    my $caller = $cgc ? $cgc->($i) : caller($i);
-
-    return 0 unless defined($caller); # What happened?
-    redo if $Internal{$caller};
-    redo if $CarpInternal{$caller};
-    redo if $CarpInternal{$called};
-    redo if trusts($called, $caller, $cache);
-    redo if trusts($caller, $called, $cache);
-    redo unless 0 > --$lvl;
-  }
-  return $i - 1;
+    my %i = caller_info($i);
+    return "$err at $i{file} line $i{line}$tid_msg\n";
 }
 
+sub short_error_loc {
+    # You have to create your (hash)ref out here, rather than defaulting it
+    # inside trusts *on a lexical*, as you want it to persist across calls.
+    # (You can default it on $_[2], but that gets messy)
+    my $cache = {};
+    my $i     = 1;
+    my $lvl   = $CarpLevel;
+    {
+        my $cgc = _cgc();
+        my $called = $cgc ? $cgc->($i) : caller($i);
+        $i++;
+        my $caller = $cgc ? $cgc->($i) : caller($i);
+
+        return 0 unless defined($caller);    # What happened?
+        redo if $Internal{$caller};
+        redo if $CarpInternal{$caller};
+        redo if $CarpInternal{$called};
+        redo if trusts( $called, $caller, $cache );
+        redo if trusts( $caller, $called, $cache );
+        redo unless 0 > --$lvl;
+    }
+    return $i - 1;
+}
 
 sub shortmess_heavy {
-  return longmess_heavy(@_) if $Verbose;
-  return @_ if ref($_[0]); # don't break references as exceptions
-  my $i = short_error_loc();
-  if ($i) {
-    ret_summary($i, @_);
-  }
-  else {
-    longmess_heavy(@_);
-  }
+    return longmess_heavy(@_) if $Verbose;
+    return @_ if ref( $_[0] );    # don't break references as exceptions
+    my $i = short_error_loc();
+    if ($i) {
+        ret_summary( $i, @_ );
+    }
+    else {
+        longmess_heavy(@_);
+    }
 }
 
 # If a string is too long, trims it with ...
 sub str_len_trim {
-  my $str = shift;
-  my $max = shift || 0;
-  if (2 < $max and $max < length($str)) {
-    substr($str, $max - 3) = '...';
-  }
-  return $str;
+    my $str = shift;
+    my $max = shift || 0;
+    if ( 2 < $max and $max < length($str) ) {
+        substr( $str, $max - 3 ) = '...';
+    }
+    return $str;
 }
 
 # Takes two packages and an optional cache.  Says whether the
@@ -308,16 +317,17 @@ sub str_len_trim {
 # possible endless loops, and when following long chains of
 # inheritance are less efficient.
 sub trusts {
-    my $child = shift;
+    my $child  = shift;
     my $parent = shift;
-    my $cache = shift;
-    my ($known, $partial) = get_status($cache, $child);
+    my $cache  = shift;
+    my ( $known, $partial ) = get_status( $cache, $child );
+
     # Figure out consequences until we have an answer
-    while (@$partial and not exists $known->{$parent}) {
+    while ( @$partial and not exists $known->{$parent} ) {
         my $anc = shift @$partial;
         next if exists $known->{$anc};
         $known->{$anc}++;
-        my ($anc_knows, $anc_partial) = get_status($cache, $anc);
+        my ( $anc_knows, $anc_partial ) = get_status( $cache, $anc );
         my @found = keys %$anc_knows;
         @$known{@found} = ();
         push @$partial, @$anc_partial;
@@ -329,10 +339,10 @@ sub trusts {
 sub trusts_directly {
     my $class = shift;
     no strict 'refs';
-    no warnings 'once'; 
+    no warnings 'once';
     return @{"$class\::CARP_NOT"}
-      ? @{"$class\::CARP_NOT"}
-      : @{"$class\::ISA"};
+        ? @{"$class\::CARP_NOT"}
+        : @{"$class\::ISA"};
 }
 
 1;
diff --git a/lib/Carp.t b/lib/Carp.t
index ffbb22226d..9a785f52d0 100644
--- a/lib/Carp.t
+++ b/lib/Carp.t
@@ -1,7 +1,7 @@
 BEGIN {
-	chdir 't' if -d 't';
-	@INC = '../lib';
-	require './test.pl';
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
 }
 
 use warnings;
@@ -12,48 +12,58 @@ my $Is_VMS = $^O eq 'VMS';
 use Carp qw(carp cluck croak confess);
 
 BEGIN {
-	plan tests => 56;
+    plan tests => 56;
 
-	# This test must be run at BEGIN time, because code later in this file
-	# sets CORE::GLOBAL::caller
-	ok !exists $CORE::GLOBAL::{caller},
-	  "Loading doesn't create CORE::GLOBAL::caller"
+    # This test must be run at BEGIN time, because code later in this file
+    # sets CORE::GLOBAL::caller
+    ok !exists $CORE::GLOBAL::{caller},
+        "Loading doesn't create CORE::GLOBAL::caller";
 }
 
-{ local $SIG{__WARN__} = sub {
-    like $_[0], qr/ok (\d+)\n at.+\b(?i:carp\.t) line \d+$/, 'ok 2\n' };
-
-  carp  "ok 2\n";
+{
+    local $SIG{__WARN__} = sub {
+        like $_[0], qr/ok (\d+)\n at.+\b(?i:carp\.t) line \d+$/, 'ok 2\n';
+    };
 
+    carp "ok 2\n";
 }
 
-{ local $SIG{__WARN__} = sub {
-    like $_[0], qr/(\d+) at.+\b(?i:carp\.t) line \d+$/, 'carp 3' };
-
-  carp 3;
+{
+    local $SIG{__WARN__} = sub {
+        like $_[0], qr/(\d+) at.+\b(?i:carp\.t) line \d+$/, 'carp 3';
+    };
 
+    carp 3;
 }
 
 sub sub_4 {
+    local $SIG{__WARN__} = sub {
+        like $_[0],
+            qr/^(\d+) at.+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at.+\b(?i:carp\.t) line \d+$/,
+            'cluck 4';
+    };
 
-local $SIG{__WARN__} = sub {
-    like $_[0], qr/^(\d+) at.+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at.+\b(?i:carp\.t) line \d+$/, 'cluck 4' };
-
-cluck 4;
-
+    cluck 4;
 }
 
 sub_4;
 
-{ local $SIG{__DIE__} = sub {
-    like $_[0], qr/^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+$/, 'croak 5' };
+{
+    local $SIG{__DIE__} = sub {
+        like $_[0],
+            qr/^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+$/,
+            'croak 5';
+    };
 
-  eval { croak 5 };
+    eval { croak 5 };
 }
 
 sub sub_6 {
     local $SIG{__DIE__} = sub {
-	like $_[0], qr/^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+\n\tmain::sub_6\(\) called at.+\b(?i:carp\.t) line \d+$/, 'confess 6' };
+        like $_[0],
+            qr/^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+\n\tmain::sub_6\(\) called at.+\b(?i:carp\.t) line \d+$/,
+            'confess 6';
+    };
 
     eval { confess 6 };
 }
@@ -65,100 +75,108 @@ ok(1);
 # test for caller_info API
 my $eval = "use Carp; return Carp::caller_info(0);";
 my %info = eval($eval);
-is($info{sub_name}, "eval '$eval'", 'caller_info API');
+is( $info{sub_name}, "eval '$eval'", 'caller_info API' );
 
 # test for '...::CARP_NOT used only once' warning from Carp
 my $warning;
 eval {
     BEGIN {
-	local $SIG{__WARN__} =
-	    sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } }
+        local $SIG{__WARN__} = sub {
+            if   ( defined $^S ) { warn $_[0] }
+            else                 { $warning = $_[0] }
+            }
     }
+
     package Z;
-    BEGIN { eval { Carp::croak() } }
+
+    BEGIN {
+        eval { Carp::croak() };
+    }
 };
 ok !$warning, q/'...::CARP_NOT used only once' warning from Carp/;
 
 # Test the location of error messages.
-like(A::short(), qr/^Error at C/, "Short messages skip carped package");
+like( A::short(), qr/^Error at C/, "Short messages skip carped package" );
 
 {
     local @C::ISA = "D";
-    like(A::short(), qr/^Error at B/, "Short messages skip inheritance");
+    like( A::short(), qr/^Error at B/, "Short messages skip inheritance" );
 }
 
 {
     local @D::ISA = "C";
-    like(A::short(), qr/^Error at B/, "Short messages skip inheritance");
+    like( A::short(), qr/^Error at B/, "Short messages skip inheritance" );
 }
 
 {
     local @D::ISA = "B";
     local @B::ISA = "C";
-    like(A::short(), qr/^Error at A/, "Inheritance is transitive");
+    like( A::short(), qr/^Error at A/, "Inheritance is transitive" );
 }
 
 {
     local @B::ISA = "D";
     local @C::ISA = "B";
-    like(A::short(), qr/^Error at A/, "Inheritance is transitive");
+    like( A::short(), qr/^Error at A/, "Inheritance is transitive" );
 }
 
 {
     local @C::CARP_NOT = "D";
-    like(A::short(), qr/^Error at B/, "Short messages see \@CARP_NOT");
+    like( A::short(), qr/^Error at B/, "Short messages see \@CARP_NOT" );
 }
 
 {
     local @D::CARP_NOT = "C";
-    like(A::short(), qr/^Error at B/, "Short messages see \@CARP_NOT");
+    like( A::short(), qr/^Error at B/, "Short messages see \@CARP_NOT" );
 }
 
 {
     local @D::CARP_NOT = "B";
     local @B::CARP_NOT = "C";
-    like(A::short(), qr/^Error at A/, "\@CARP_NOT is transitive");
+    like( A::short(), qr/^Error at A/, "\@CARP_NOT is transitive" );
 }
 
 {
     local @B::CARP_NOT = "D";
     local @C::CARP_NOT = "B";
-    like(A::short(), qr/^Error at A/, "\@CARP_NOT is transitive");
+    like( A::short(), qr/^Error at A/, "\@CARP_NOT is transitive" );
 }
 
 {
-    local @D::ISA = "C";
+    local @D::ISA      = "C";
     local @D::CARP_NOT = "B";
-    like(A::short(), qr/^Error at C/, "\@CARP_NOT overrides inheritance");
+    like( A::short(), qr/^Error at C/, "\@CARP_NOT overrides inheritance" );
 }
 
 {
-    local @D::ISA = "B";
+    local @D::ISA      = "B";
     local @D::CARP_NOT = "C";
-    like(A::short(), qr/^Error at B/, "\@CARP_NOT overrides inheritance");
+    like( A::short(), qr/^Error at B/, "\@CARP_NOT overrides inheritance" );
 }
 
 # %Carp::Internal
 {
     local $Carp::Internal{C} = 1;
-    like(A::short(), qr/^Error at B/, "Short doesn't report Internal");
+    like( A::short(), qr/^Error at B/, "Short doesn't report Internal" );
 }
 
 {
     local $Carp::Internal{D} = 1;
-    like(A::long(), qr/^Error at C/, "Long doesn't report Internal");
+    like( A::long(), qr/^Error at C/, "Long doesn't report Internal" );
 }
 
 # %Carp::CarpInternal
 {
     local $Carp::CarpInternal{D} = 1;
-    like(A::short(), qr/^Error at B/
-      , "Short doesn't report calls to CarpInternal");
+    like(
+        A::short(), qr/^Error at B/,
+        "Short doesn't report calls to CarpInternal"
+    );
 }
 
 {
     local $Carp::CarpInternal{D} = 1;
-    like(A::long(), qr/^Error at C/, "Long doesn't report CarpInternal");
+    like( A::long(), qr/^Error at C/, "Long doesn't report CarpInternal" );
 }
 
 # tests for global variables
@@ -166,7 +184,8 @@ sub x { carp @_ }
 sub w { cluck @_ }
 
 # $Carp::Verbose;
-{   my $aref = [
+{
+    my $aref = [
         qr/t at \S*(?i:carp.t) line \d+/,
         qr/t at \S*(?i:carp.t) line \d+\n\s*main::x\('t'\) called at \S*(?i:carp.t) line \d+/
     ];
@@ -176,34 +195,41 @@ sub w { cluck @_ }
         local $Carp::Verbose = $i++;
         local $SIG{__WARN__} = sub {
             like $_[0], $re, 'Verbose';
-	};
+        };
+
         package Z;
         main::x('t');
     }
 }
 
 # $Carp::MaxEvalLen
-{   my $test_num = 1;
-    for(0,4) {
+{
+    my $test_num = 1;
+    for ( 0, 4 ) {
         my $txt = "Carp::cluck($test_num)";
         local $Carp::MaxEvalLen = $_;
         local $SIG{__WARN__} = sub {
-	    "@_"=~/'(.+?)(?:\n|')/s;
-            is length($1), length($_?substr($txt,0,$_):substr($txt,0)), 'MaxEvalLen';
-	};
-        eval "$txt"; $test_num++;
+            "@_" =~ /'(.+?)(?:\n|')/s;
+            is length($1),
+                length( $_ ? substr( $txt, 0, $_ ) : substr( $txt, 0 ) ),
+                'MaxEvalLen';
+        };
+        eval "$txt";
+        $test_num++;
     }
 }
 
 # $Carp::MaxArgLen
 {
-    for(0,4) {
+    for ( 0, 4 ) {
         my $arg = 'testtest';
         local $Carp::MaxArgLen = $_;
         local $SIG{__WARN__} = sub {
-	    "@_"=~/'(.+?)'/;
-	    is length($1), length($_?substr($arg,0,$_):substr($arg,0)), 'MaxArgLen';
-	};
+            "@_" =~ /'(.+?)'/;
+            is length($1),
+                length( $_ ? substr( $arg, 0, $_ ) : substr( $arg, 0 ) ),
+                'MaxArgLen';
+        };
 
         package Z;
         main::w($arg);
@@ -211,25 +237,27 @@ sub w { cluck @_ }
 }
 
 # $Carp::MaxArgNums
-{   my $i = 0;
+{
+    my $i    = 0;
     my $aref = [
         qr/1234 at \S*(?i:carp.t) line \d+\n\s*main::w\(1, 2, 3, 4\) called at \S*(?i:carp.t) line \d+/,
         qr/1234 at \S*(?i:carp.t) line \d+\n\s*main::w\(1, 2, \.\.\.\) called at \S*(?i:carp.t) line \d+/,
     ];
 
-    for(@$aref) {
+    for (@$aref) {
         local $Carp::MaxArgNums = $i++;
         local $SIG{__WARN__} = sub {
-	    like "@_", $_, 'MaxArgNums';
-	};
+            like "@_", $_, 'MaxArgNums';
+        };
 
         package Z;
-        main::w(1..4);
+        main::w( 1 .. 4 );
     }
 }
 
 # $Carp::CarpLevel
-{   my $i = 0;
+{
+    my $i    = 0;
     my $aref = [
         qr/1 at \S*(?i:carp.t) line \d+\n\s*main::w\(1\) called at \S*(?i:carp.t) line \d+/,
         qr/1 at \S*(?i:carp.t) line \d+$/,
@@ -238,8 +266,8 @@ sub w { cluck @_ }
     for (@$aref) {
         local $Carp::CarpLevel = $i++;
         local $SIG{__WARN__} = sub {
-	    like "@_", $_, 'CarpLevel';
-	};
+            like "@_", $_, 'CarpLevel';
+        };
 
         package Z;
         main::w(1);
@@ -250,68 +278,86 @@ sub w { cluck @_ }
     local $TODO = "VMS exit status semantics don't work this way" if $Is_VMS;
 
     # Check that croak() and confess() don't clobber $!
-    runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; croak(q{Dead})', 
-	    stderr => 1);
+    runperl(
+        prog   => 'use Carp; $@=q{Phooey}; $!=42; croak(q{Dead})',
+        stderr => 1
+    );
 
-    is($?>>8, 42, 'croak() doesn\'t clobber $!');
+    is( $? >> 8, 42, 'croak() doesn\'t clobber $!' );
 
-    runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; confess(q{Dead})', 
-	    stderr => 1);
+    runperl(
+        prog   => 'use Carp; $@=q{Phooey}; $!=42; confess(q{Dead})',
+        stderr => 1
+    );
 
-    is($?>>8, 42, 'confess() doesn\'t clobber $!');
+    is( $? >> 8, 42, 'confess() doesn\'t clobber $!' );
 }
 
 # undef used to be incorrectly reported as the string "undef"
 sub cluck_undef {
 
-local $SIG{__WARN__} = sub {
-    like $_[0], qr/^Bang! at.+\b(?i:carp\.t) line \d+\n\tmain::cluck_undef\(0, 'undef', 2, undef, 4\) called at.+\b(?i:carp\.t) line \d+$/, "cluck doesn't quote undef" };
+    local $SIG{__WARN__} = sub {
+        like $_[0],
+            qr/^Bang! at.+\b(?i:carp\.t) line \d+\n\tmain::cluck_undef\(0, 'undef', 2, undef, 4\) called at.+\b(?i:carp\.t) line \d+$/,
+            "cluck doesn't quote undef";
+    };
 
-cluck "Bang!"
+    cluck "Bang!"
 
 }
 
-cluck_undef (0, "undef", 2, undef, 4);
+cluck_undef( 0, "undef", 2, undef, 4 );
 
 # check that Carp respects CORE::GLOBAL::caller override after Carp
 # has been compiled
-for my $bodge_job (2, 1, 0) {
-    print '# ', ($bodge_job ? 'Not ' : ''), "setting \@DB::args in caller override\n";
-    if ($bodge_job == 1) {
-	require B;
-	print "# required B\n";
+for my $bodge_job ( 2, 1, 0 ) {
+    print '# ', ( $bodge_job ? 'Not ' : '' ),
+        "setting \@DB::args in caller override\n";
+    if ( $bodge_job == 1 ) {
+        require B;
+        print "# required B\n";
     }
     my $accum = '';
     local *CORE::GLOBAL::caller = sub {
-        local *__ANON__="fakecaller";
-        my @c=CORE::caller(@_);
+        local *__ANON__ = "fakecaller";
+        my @c = CORE::caller(@_);
         $c[0] ||= 'undef';
         $accum .= "@c[0..3]\n";
-        if (!$bodge_job && CORE::caller() eq 'DB') {
+        if ( !$bodge_job && CORE::caller() eq 'DB' ) {
+
             package DB;
-            return CORE::caller(($_[0]||0)+1);
-        } else {
-            return CORE::caller(($_[0]||0)+1);
+            return CORE::caller( ( $_[0] || 0 ) + 1 );
+        }
+        else {
+            return CORE::caller( ( $_[0] || 0 ) + 1 );
         }
     };
     eval "scalar caller()";
-    like( $accum, qr/main::fakecaller/, "test CORE::GLOBAL::caller override in eval");
+    like( $accum, qr/main::fakecaller/,
+        "test CORE::GLOBAL::caller override in eval" );
     $accum = '';
     my $got = A::long(42);
-    like( $accum, qr/main::fakecaller/, "test CORE::GLOBAL::caller override in Carp");
+    like( $accum, qr/main::fakecaller/,
+        "test CORE::GLOBAL::caller override in Carp" );
     my $package = 'A';
     my $where = $bodge_job == 1 ? ' in &main::__ANON__' : '';
-    my $warning = $bodge_job ?
-	"\Q** Incomplete caller override detected$where; \@DB::args were not set **\E"
-	    : '';
-    for (0..2) {
-	my $previous_package = $package;
-	++$package;
-	like( $got, qr/${package}::long\($warning\) called at $previous_package line \d+/, "Correct arguments for $package" );
+    my $warning
+        = $bodge_job
+        ? "\Q** Incomplete caller override detected$where; \@DB::args were not set **\E"
+        : '';
+
+    for ( 0 .. 2 ) {
+        my $previous_package = $package;
+        ++$package;
+        like( $got,
+            qr/${package}::long\($warning\) called at $previous_package line \d+/,
+            "Correct arguments for $package" );
     }
     my $arg = $bodge_job ? $warning : 42;
-    like( $got, qr!A::long\($arg\) called at.+\b(?i:carp\.t) line \d+!,
-	  'Correct arguments for A' );
+    like(
+        $got, qr!A::long\($arg\) called at.+\b(?i:carp\.t) line \d+!,
+        'Correct arguments for A'
+    );
 }
 
 eval <<'EOT';
@@ -325,13 +371,17 @@ EOT
 
 my $got = A::long(42);
 
-like( $got, qr!A::long\(\Q** Incomplete caller override detected; \E\@DB::args\Q were not set **\E\) called at.+\b(?i:carp\.t) line \d+!,
-	  'Correct arguments for A' );
+like(
+    $got,
+    qr!A::long\(\Q** Incomplete caller override detected; \E\@DB::args\Q were not set **\E\) called at.+\b(?i:carp\.t) line \d+!,
+    'Correct arguments for A'
+);
 
 # New tests go here
 
 # line 1 "A"
 package A;
+
 sub short {
     B::short();
 }
@@ -342,6 +392,7 @@ sub long {
 
 # line 1 "B"
 package B;
+
 sub short {
     C::short();
 }
@@ -352,6 +403,7 @@ sub long {
 
 # line 1 "C"
 package C;
+
 sub short {
     D::short();
 }
@@ -362,13 +414,14 @@ sub long {
 
 # line 1 "D"
 package D;
+
 sub short {
-    eval{ Carp::croak("Error") };
+    eval { Carp::croak("Error") };
     return $@;
 }
 
 sub long {
-    eval{ Carp::confess("Error") };
+    eval { Carp::confess("Error") };
     return $@;
 }