lib/Carp.t

   1 BEGIN {
   2         chdir 't' if -d 't';
   3         @INC = '../lib';
   4         require './test.pl';
   5 }
   6
   7 use Carp qw(carp cluck croak confess);
   8
   9 plan tests => 19;
  10
  11 ok 1;
  12
  13 { local $SIG{__WARN__} = sub {
  14     like $_[0], qr/ok (\d+)\n at.+\b(?i:carp\.t) line \d+$/, 'ok 2\n' };
  15
  16   carp  "ok 2\n";
  17
  18 }
  19
  20 { local $SIG{__WARN__} = sub {
  21     like $_[0], qr/(\d+) at.+\b(?i:carp\.t) line \d+$/, 'carp 3' };
  22
  23   carp 3;
  24
  25 }
  26
  27 sub sub_4 {
  28
  29 local $SIG{__WARN__} = sub {
  30     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' };
  31
  32 cluck 4;
  33
  34 }
  35
  36 sub_4;
  37
  38 { local $SIG{__DIE__} = sub {
  39     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' };
  40
  41   eval { croak 5 };
  42 }
  43
  44 sub sub_6 {
  45     local $SIG{__DIE__} = sub {
  46         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' };
  47
  48     eval { confess 6 };
  49 }
  50
  51 sub_6;
  52
  53 ok(1);
  54
  55 # test for caller_info API
  56 my $eval = "use Carp::Heavy; return Carp::caller_info(0);";
  57 my %info = eval($eval);
  58 is($info{sub_name}, "eval '$eval'", 'caller_info API');
  59
  60 # test for '...::CARP_NOT used only once' warning from Carp::Heavy
  61 my $warning;
  62 eval {
  63     BEGIN {
  64         $^W = 1;
  65         local $SIG{__WARN__} =
  66             sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } }
  67     }
  68     package Z;
  69     BEGIN { eval { Carp::croak() } }
  70 };
  71 ok !$warning, q/'...::CARP_NOT used only once' warning from Carp::Heavy/;
  72
  73
  74 # tests for global variables
  75 sub x { carp @_ }
  76 sub w { cluck @_ }
  77
  78 # $Carp::Verbose;
  79 {   my $aref = [
  80         qr/t at \S*(?i:carp.t) line \d+/,
  81         qr/t at \S*(?i:carp.t) line \d+\n\s*main::x\('t'\) called at \S*(?i:carp.t) line \d+/
  82     ];
  83     my $i = 0;
  84
  85     for my $re (@$aref) {
  86         local $Carp::Verbose = $i++;
  87         local $SIG{__WARN__} = sub {
  88             like $_[0], $re, 'Verbose';
  89         };
  90         package Z;
  91         main::x('t');
  92     }
  93 }
  94
  95 # $Carp::MaxEvalLen
  96 {   my $test_num = 1;
  97     for(0,4) {
  98         my $txt = "Carp::cluck($test_num)";
  99         local $Carp::MaxEvalLen = $_;
 100         local $SIG{__WARN__} = sub {
 101             "@_"=~/'(.+?)(?:\n|')/s;
 102             is length($1), length($_?substr($txt,0,$_):substr($txt,0)), 'MaxEvalLen';
 103         };
 104         eval "$txt"; $test_num++;
 105     }
 106 }
 107
 108 # $Carp::MaxArgLen
 109 {
 110     for(0,4) {
 111         my $arg = 'testtest';
 112         local $Carp::MaxArgLen = $_;
 113         local $SIG{__WARN__} = sub {
 114             "@_"=~/'(.+?)'/;
 115             is length($1), length($_?substr($arg,0,$_):substr($arg,0)), 'MaxArgLen';
 116         };
 117
 118         package Z;
 119         main::w($arg);
 120     }
 121 }
 122
 123 # $Carp::MaxArgNums
 124 {   my $i = 0;
 125     my $aref = [
 126         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+/,
 127         qr/1234 at \S*(?i:carp.t) line \d+\n\s*main::w\(1, 2, \.\.\.\) called at \S*(?i:carp.t) line \d+/,
 128     ];
 129
 130     for(@$aref) {
 131         local $Carp::MaxArgNums = $i++;
 132         local $SIG{__WARN__} = sub {
 133             like "@_", $_, 'MaxArgNums';
 134         };
 135
 136         package Z;
 137         main::w(1..4);
 138     }
 139 }
 140
 141 # $Carp::CarpLevel
 142 {   my $i = 0;
 143     my $aref = [
 144         qr/1 at \S*(?i:carp.t) line \d+\n\s*main::w\(1\) called at \S*(?i:carp.t) line \d+/,
 145         qr/1 at \S*(?i:carp.t) line \d+$/,
 146     ];
 147
 148     for (@$aref) {
 149         local $Carp::CarpLevel = $i++;
 150         local $SIG{__WARN__} = sub {
 151             like "@_", $_, 'CarpLevel';
 152         };
 153
 154         package Z;
 155         main::w(1);
 156     }
 157 }