diff options
author | Ben Tilly <ben_tilly@operamail.com> | 2006-10-22 07:07:23 -0700 |
---|---|---|
committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2006-11-14 10:18:00 +0000 |
commit | d735c2efe0b08b05adfb893625476bf4480a2ece (patch) | |
tree | 2af965ced2fc2c8a3d26b65147385f78c4f22cd0 /lib/Carp.t | |
parent | bfb0b58a0ee1c7605d58a3bdb19350b27f738866 (diff) | |
download | perl-d735c2efe0b08b05adfb893625476bf4480a2ece.tar.gz |
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
Diffstat (limited to 'lib/Carp.t')
-rw-r--r-- | lib/Carp.t | 126 |
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 $@; +} |