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..19\n";
   9
  10 print "ok 1\n";
  11
  12 $SIG{__WARN__} = sub {
  13     print "ok $1\n"
  14         if $_[0] =~ m!ok (\d+)\n at.+\b(?i:carp\.t) line \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";
  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*Carp.t line \d+/,
  81         qr/t at \S*Carp.t line \d+\n\s*main::x\('t'\) called at \S*Carp.t line \d+/
  82     ];
  83     my $test_num = 10; my $i = 0;
  84
  85     for my $re (@$aref) {
  86         local $Carp::Verbose = $i++;
  87         local $SIG{__WARN__} = sub {
  88             print "not " unless $_[0] =~ $re;
  89             print "ok ".$test_num++." - Verbose\n";
  90         };
  91         package Z;
  92         main::x('t');
  93     }
  94 }
  95
  96 # $Carp::MaxEvalLen
  97 {   my $test_num = 12;
  98     for(0,4) {
  99         my $txt = "Carp::cluck($test_num)";
 100         local $Carp::MaxEvalLen = $_;
 101         local $SIG{__WARN__} = sub {
 102             "@_"=~/'(.+?)(?:\n|')/s;
 103             print "not " unless length $1 eq length $_?substr($txt,0,$_):substr($txt,0);
 104             print "ok $test_num - MaxEvalLen\n";
 105         };
 106         eval "$txt"; $test_num++;
 107     }
 108 }
 109
 110 # $Carp::MaxArgLen
 111 {   my $test_num = 14;
 112     for(0,4) {
 113         my $arg = 'testtest';
 114         local $Carp::MaxArgLen = $_;
 115         local $SIG{__WARN__} = sub {
 116             "@_"=~/'(.+?)'/;
 117             print "not " unless length $1 eq length $_?substr($arg,0,$_):substr($arg,0);
 118             print "ok ".$test_num++." - MaxArgLen\n";
 119         };
 120
 121         package Z;
 122         main::w($arg);
 123     }
 124 }
 125
 126 # $Carp::MaxArgNums
 127 {   my $test_num = 16; my $i = 0;
 128     my $aref = [
 129         qr/1234 at \S*Carp.t line \d+\n\s*main::w\(1, 2, 3, 4\) called at \S*Carp.t line \d+/,
 130         qr/1234 at \S*Carp.t line \d+\n\s*main::w\(1, 2, \.\.\.\) called at \S*Carp.t line \d+/,
 131     ];
 132
 133     for(@$aref) {
 134         local $Carp::MaxArgNums = $i++;
 135         local $SIG{__WARN__} = sub {
 136             print "not " unless "@_"=~$_;
 137             print "ok ".$test_num++." - MaxArgNums\n";
 138         };
 139
 140         package Z;
 141         main::w(1..4);
 142     }
 143 }
 144
 145 # $Carp::CarpLevel
 146 {   my $test_num = 18; my $i = 0;
 147     my $aref = [
 148         qr/1 at \S*Carp.t line \d+\n\s*main::w\(1\) called at \S*Carp.t line \d+/,
 149         qr/1 at \S*Carp.t line \d+$/,
 150     ];
 151
 152     for (@$aref) {
 153         local $Carp::CarpLevel = $i++;
 154         local $SIG{__WARN__} = sub {
 155             print "not " unless "@_"=~$_;
 156             print "ok ".$test_num++." - CarpLevel\n";
 157         };
 158
 159         package Z;
 160         main::w(1);
 161     }
 162 }