Re: Why aren't %Carp::Internal and %Carp::CarpInternal documented?

From: "Ben Tilly" <btilly@gmail.com>
Message-ID: <acc274b30610221407o39e0157gad44ad5828c2bc21@mail.gmail.com>

p4raw-id: //depot/perl@29270

1 files changed, 124 insertions, 2 deletions

diff --git a/lib/Carp.t b/lib/Carp.t
index 2ce5eb4dff..63e15654d1 100644
--- a/lib/Carp.t
+++ b/lib/Carp.t
@@ -8,7 +8,7 @@ my $Is_VMS = $^O eq 'VMS';
 
 use Carp qw(carp cluck croak confess);
 
-plan tests => 21;
+plan tests => 36;
 
 ok 1;
 
@@ -72,6 +72,87 @@ eval {
 };
 ok !$warning, q/'...::CARP_NOT used only once' warning from Carp::Heavy/;
 
+# Test the location of error messages.
+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");
+}
+
+{
+    local @D::ISA = "C";
+    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");
+}
+
+{
+    local @B::ISA = "D";
+    local @C::ISA = "B";
+    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");
+}
+
+{
+    local @D::CARP_NOT = "C";
+    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");
+}
+
+{
+    local @B::CARP_NOT = "D";
+    local @C::CARP_NOT = "B";
+    like(A::short(), qr/^Error at A/, "\@CARP_NOT is transitive");
+}
+
+{
+    local @D::ISA = "C";
+    local @D::CARP_NOT = "B";
+    like(A::short(), qr/^Error at C/, "\@CARP_NOT overrides inheritance");
+}
+
+{
+    local @D::ISA = "B";
+    local @D::CARP_NOT = "C";
+    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");
+}
+
+{
+    local $Carp::Internal{D} = 1;
+    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");
+}
+
+{
+    local $Carp::CarpInternal{D} = 1;
+    like(A::long(), qr/^Error at C/, "Long doesn't report CarpInternal");
+}
 
 # tests for global variables
 sub x { carp @_ }
@@ -158,7 +239,6 @@ sub w { cluck @_ }
     }
 }
 
-
 {
     local $TODO = "VMS exit status semantics don't work this way" if $Is_VMS;
 
@@ -173,3 +253,45 @@ sub w { cluck @_ }
 
     is($?>>8, 42, 'confess() doesn\'t clobber $!');
 }
+
+# line 1 "A"
+package A;
+sub short {
+    B::short();
+}
+
+sub long {
+    B::long();
+}
+
+# line 1 "B"
+package B;
+sub short {
+    C::short();
+}
+
+sub long {
+    C::long();
+}
+
+# line 1 "C"
+package C;
+sub short {
+    D::short();
+}
+
+sub long {
+    D::long();
+}
+
+# line 1 "D"
+package D;
+sub short {
+    eval{ Carp::croak("Error") };
+    return $@;
+}
+
+sub long {
+    eval{ Carp::confess("Error") };
+    return $@;
+}