lib/Carp.t

   1 BEGIN {
   2         chdir 't' if -d 't';
   3         @INC = '../lib';
   4 }
   5
   6 use Carp qw(carp cluck croak confess);
   7
   8 print "1..9\n";
   9
  10 print "ok 1\n";
  11
  12 $SIG{__WARN__} = sub {
  13     print "ok $1\n"
  14         if $_[0] =~ m!ok (\d+)$! };
  15
  16 carp  "ok 2\n";
  17
  18 $SIG{__WARN__} = sub {
  19     print "ok $1\n"
  20         if $_[0] =~ m!(\d+) at .+\b(?i:carp\.t) line \d+$! };
  21
  22 carp 3;
  23
  24 sub sub_4 {
  25
  26 $SIG{__WARN__} = sub {
  27     print "ok $1\n"
  28         if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at .+\b(?i:carp\.t) line \d+$! };
  29
  30 cluck 4;
  31
  32 }
  33
  34 sub_4;
  35
  36 $SIG{__DIE__} = sub {
  37     print "ok $1\n"
  38         if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at .+\b(?i:carp\.t) line \d+$! };
  39
  40 eval { croak 5 };
  41
  42 sub sub_6 {
  43     $SIG{__DIE__} = sub {
  44         print "ok $1\n"
  45             if $_[0] =~ m!^(\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+$! };
  46
  47     eval { confess 6 };
  48 }
  49
  50 sub_6;
  51
  52 print "ok 7\n";
  53
  54 # test for caller_info API
  55 my $eval = "use Carp::Heavy; return Carp::caller_info(0);";
  56 my %info = eval($eval);
  57 print "not " if ($info{sub_name} ne "eval '$eval'");
  58 print "ok 8\n";
  59
  60 # test for '...::CARP_NOT used only once' warning from Carp::Heavy
  61 my $warning;
  62 eval {
  63     BEGIN {
  64         $^W = 1;
  65         $SIG{__WARN__} =
  66             sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } }
  67     }
  68     package Z;
  69     BEGIN { eval { Carp::croak() } }
  70 };
  71 print $warning ? "not ok 9\n#$warning" : "ok 9\n";