"Fossies" - the Fresh Open Source Software Archive

Member "Date-Calc-6.4/t/f035.t" (7 Mar 2015, 18619 Bytes) of package /linux/privat/Date-Calc-6.4.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "f035.t": 6.3_vs_6.4.

    1 #!perl -w
    2 
    3 BEGIN { eval { require bytes; }; }
    4 use strict;
    5 
    6 BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; }
    7 
    8 # ======================================================================
    9 #   use Carp::Clan qw(package::pattern);
   10 #   croak();
   11 #   confess();
   12 #   carp();
   13 #   cluck();
   14 # ======================================================================
   15 
   16 # NOTE: Certain ugly contortions needed only for crappy Perl 5.6.0!
   17 
   18 print "1..58\n";
   19 
   20 my $n = 1;
   21 
   22 unless (exists $main::{'croak'})
   23 {print "ok $n\n";} else {print "not ok $n\n";}
   24 $n++;
   25 unless (exists $main::{'confess'})
   26 {print "ok $n\n";} else {print "not ok $n\n";}
   27 $n++;
   28 unless (exists $main::{'carp'})
   29 {print "ok $n\n";} else {print "not ok $n\n";}
   30 $n++;
   31 unless (exists $main::{'cluck'})
   32 {print "ok $n\n";} else {print "not ok $n\n";}
   33 $n++;
   34 
   35 eval { require Carp::Clan; };
   36 
   37 unless ($@)
   38 {print "ok $n\n";} else {print "not ok $n\n";}
   39 $n++;
   40 
   41 unless (exists $main::{'croak'})
   42 {print "ok $n\n";} else {print "not ok $n\n";}
   43 $n++;
   44 unless (exists $main::{'confess'})
   45 {print "ok $n\n";} else {print "not ok $n\n";}
   46 $n++;
   47 unless (exists $main::{'carp'})
   48 {print "ok $n\n";} else {print "not ok $n\n";}
   49 $n++;
   50 unless (exists $main::{'cluck'})
   51 {print "ok $n\n";} else {print "not ok $n\n";}
   52 $n++;
   53 
   54 eval { Carp::Clan->import(); };
   55 
   56 unless ($@)
   57 {print "ok $n\n";} else {print "not ok $n\n";}
   58 $n++;
   59 
   60 if (exists $main::{'croak'})
   61 {print "ok $n\n";} else {print "not ok $n\n";}
   62 $n++;
   63 if (exists $main::{'confess'})
   64 {print "ok $n\n";} else {print "not ok $n\n";}
   65 $n++;
   66 if (exists $main::{'carp'})
   67 {print "ok $n\n";} else {print "not ok $n\n";}
   68 $n++;
   69 if (exists $main::{'cluck'})
   70 {print "ok $n\n";} else {print "not ok $n\n";}
   71 $n++;
   72 
   73 package A;
   74 sub a { &B::b(@_); }
   75 
   76 package B;
   77 sub b { &C::c(@_); }
   78 
   79 package C;
   80 sub c { &D::d(@_); }
   81 
   82 package D;
   83 sub d { &E::e(@_); }
   84 
   85 package E;
   86 sub e { &F::f(@_); }
   87 
   88 package F;
   89 
   90 eval { Carp::Clan->import(); };
   91 
   92 sub f
   93 {
   94     my $select = shift;  # Use symbolic refs without "no strict 'refs';":
   95     if    ($select == 1) { &{*{${*{$main::{'F::'}}}{'croak'}}}(@_);   }
   96     elsif ($select == 2) { &{*{${*{$main::{'F::'}}}{'confess'}}}(@_); }
   97     elsif ($select == 3) { &{*{${*{$main::{'F::'}}}{'carp'}}}(@_);    }
   98     elsif ($select == 4) { &{*{${*{$main::{'F::'}}}{'cluck'}}}(@_);   }
   99 }
  100 
  101 package main;
  102 
  103 eval { &{*{$main::{'croak'}}}("CROAKing"); };
  104 
  105 if ($@ =~ /^.+\bCROAKing at .+$/) # no "\n" except at EOL
  106 {print "ok $n\n";} else {print "not ok $n\n";}
  107 $n++;
  108 
  109 eval { &{*{$main::{'confess'}}}("CONFESSing"); };
  110 
  111 if ($@ =~ /\bCONFESSing at .+\n.*\b(?:eval \{\.\.\.\}|require 0) called at\b/)
  112 {print "ok $n\n";} else {print "not ok $n\n";}
  113 $n++;
  114 
  115 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &{*{$main::{'carp'}}}("CARPing"); };
  116 
  117 if ($@ =~ /^.+\bCARPing at .+$/) # no "\n" except at EOL
  118 {print "ok $n\n";} else {print "not ok $n\n";}
  119 $n++;
  120 
  121 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &{*{$main::{'cluck'}}}("CLUCKing"); };
  122 
  123 if ($@ =~ /\bCLUCKing at .+\n.*\b(?:eval \{\.\.\.\}|require 0) called at\b/)
  124 {print "ok $n\n";} else {print "not ok $n\n";}
  125 $n++;
  126 
  127 eval { Carp::Clan::croak("croakING"); };
  128 
  129 if ($@ =~ /^.+\bcroakING at .+$/) # no "\n" except at EOL
  130 {print "ok $n\n";} else {print "not ok $n\n";}
  131 $n++;
  132 
  133 eval { Carp::Clan::confess("confessING"); };
  134 
  135 if ($@ =~ /\bconfessING at .+\n.*\b(?:eval \{\.\.\.\}|require 0) called at\b/)
  136 {print "ok $n\n";} else {print "not ok $n\n";}
  137 $n++;
  138 
  139 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; Carp::Clan::carp("carpING"); };
  140 
  141 if ($@ =~ /^.+\bcarpING at .+$/) # no "\n" except at EOL
  142 {print "ok $n\n";} else {print "not ok $n\n";}
  143 $n++;
  144 
  145 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; Carp::Clan::cluck("cluckING"); };
  146 
  147 if ($@ =~ /\bcluckING at .+\n.*\b(?:eval \{\.\.\.\}|require 0) called at\b/)
  148 {print "ok $n\n";} else {print "not ok $n\n";}
  149 $n++;
  150 
  151 ###############################
  152 # Now testing the real thing: #
  153 ###############################
  154 
  155 eval { &A::a(1, "CrOaKiNg"); };
  156 
  157 if ($@ =~ /\bF::f\(\): CrOaKiNg at /)
  158 {print "ok $n\n";} else {print "not ok $n\n";}
  159 $n++;
  160 
  161 eval { &A::a(2, "CoNfEsSiNg"); };
  162 
  163 if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
  164          .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  165          .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  166          .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  167          .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  168          .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  169          .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  170          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  171 {print "ok $n\n";} else {print "not ok $n\n";}
  172 $n++;
  173 
  174 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };
  175 
  176 if ($@ =~ /\bF::f\(\): CaRpInG at /)
  177 {print "ok $n\n";} else {print "not ok $n\n";}
  178 $n++;
  179 
  180 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };
  181 
  182 if ($@ =~ /\bClUcKiNg\ at\ .+\n
  183          .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  184          .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  185          .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  186          .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  187          .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  188          .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  189          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  190 {print "ok $n\n";} else {print "not ok $n\n";}
  191 $n++;
  192 
  193 package F;
  194 eval { local $^W = 0; Carp::Clan->import('^F\b'); };
  195 package main;
  196 
  197 eval { &A::a(1, "CrOaKiNg"); };
  198 
  199 if ($@ =~ /\bF::f\(\): CrOaKiNg at /)
  200 {print "ok $n\n";} else {print "not ok $n\n";}
  201 $n++;
  202 
  203 eval { &A::a(2, "CoNfEsSiNg"); };
  204 
  205 if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
  206          .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  207          .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  208          .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  209          .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  210          .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  211          .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  212          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  213 {print "ok $n\n";} else {print "not ok $n\n";}
  214 $n++;
  215 
  216 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };
  217 
  218 if ($@ =~ /\bF::f\(\): CaRpInG at /)
  219 {print "ok $n\n";} else {print "not ok $n\n";}
  220 $n++;
  221 
  222 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };
  223 
  224 if ($@ =~ /\bClUcKiNg\ at\ .+\n
  225          .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  226          .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  227          .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  228          .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  229          .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  230          .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  231          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  232 {print "ok $n\n";} else {print "not ok $n\n";}
  233 $n++;
  234 
  235 package F;
  236 eval { local $^W = 0; Carp::Clan->import('^[EF]\b'); };
  237 package main;
  238 
  239 eval { &A::a(1, "CrOaKiNg"); };
  240 
  241 if ($@ =~ /\bE::e\(\): CrOaKiNg at /)
  242 {print "ok $n\n";} else {print "not ok $n\n";}
  243 $n++;
  244 
  245 eval { &A::a(2, "CoNfEsSiNg"); };
  246 
  247 if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
  248          .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  249          .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  250          .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  251          .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  252          .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  253          .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  254          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  255 {print "ok $n\n";} else {print "not ok $n\n";}
  256 $n++;
  257 
  258 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };
  259 
  260 if ($@ =~ /\bE::e\(\): CaRpInG at /)
  261 {print "ok $n\n";} else {print "not ok $n\n";}
  262 $n++;
  263 
  264 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };
  265 
  266 if ($@ =~ /\bClUcKiNg\ at\ .+\n
  267          .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  268          .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  269          .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  270          .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  271          .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  272          .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  273          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  274 {print "ok $n\n";} else {print "not ok $n\n";}
  275 $n++;
  276 
  277 package F;
  278 eval { local $^W = 0; Carp::Clan->import('^[DEF]\b'); };
  279 package main;
  280 
  281 eval { &A::a(1, "CrOaKiNg"); };
  282 
  283 if ($@ =~ /\bD::d\(\): CrOaKiNg at /)
  284 {print "ok $n\n";} else {print "not ok $n\n";}
  285 $n++;
  286 
  287 eval { &A::a(2, "CoNfEsSiNg"); };
  288 
  289 if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
  290          .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  291          .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  292          .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  293          .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  294          .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  295          .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  296          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  297 {print "ok $n\n";} else {print "not ok $n\n";}
  298 $n++;
  299 
  300 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };
  301 
  302 if ($@ =~ /\bD::d\(\): CaRpInG at /)
  303 {print "ok $n\n";} else {print "not ok $n\n";}
  304 $n++;
  305 
  306 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };
  307 
  308 if ($@ =~ /\bClUcKiNg\ at\ .+\n
  309          .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  310          .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  311          .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  312          .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  313          .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  314          .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  315          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  316 {print "ok $n\n";} else {print "not ok $n\n";}
  317 $n++;
  318 
  319 package F;
  320 eval { local $^W = 0; Carp::Clan->import('^[CDEF]\b'); };
  321 package main;
  322 
  323 eval { &A::a(1, "CrOaKiNg"); };
  324 
  325 if ($@ =~ /\bC::c\(\): CrOaKiNg at /)
  326 {print "ok $n\n";} else {print "not ok $n\n";}
  327 $n++;
  328 
  329 eval { &A::a(2, "CoNfEsSiNg"); };
  330 
  331 if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
  332          .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  333          .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  334          .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  335          .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  336          .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  337          .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  338          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  339 {print "ok $n\n";} else {print "not ok $n\n";}
  340 $n++;
  341 
  342 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };
  343 
  344 if ($@ =~ /\bC::c\(\): CaRpInG at /)
  345 {print "ok $n\n";} else {print "not ok $n\n";}
  346 $n++;
  347 
  348 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };
  349 
  350 if ($@ =~ /\bClUcKiNg\ at\ .+\n
  351          .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  352          .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  353          .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  354          .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  355          .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  356          .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  357          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  358 {print "ok $n\n";} else {print "not ok $n\n";}
  359 $n++;
  360 
  361 package F;
  362 eval { local $^W = 0; Carp::Clan->import('^[BCDEF]\b'); };
  363 package main;
  364 
  365 eval { &A::a(1, "CrOaKiNg"); };
  366 
  367 if ($@ =~ /\bB::b\(\): CrOaKiNg at /)
  368 {print "ok $n\n";} else {print "not ok $n\n";}
  369 $n++;
  370 
  371 eval { &A::a(2, "CoNfEsSiNg"); };
  372 
  373 if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
  374          .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  375          .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  376          .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  377          .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  378          .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  379          .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  380          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  381 {print "ok $n\n";} else {print "not ok $n\n";}
  382 $n++;
  383 
  384 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };
  385 
  386 if ($@ =~ /\bB::b\(\): CaRpInG at /)
  387 {print "ok $n\n";} else {print "not ok $n\n";}
  388 $n++;
  389 
  390 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };
  391 
  392 if ($@ =~ /\bClUcKiNg\ at\ .+\n
  393          .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  394          .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  395          .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  396          .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  397          .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  398          .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  399          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  400 {print "ok $n\n";} else {print "not ok $n\n";}
  401 $n++;
  402 
  403 package F;
  404 eval { local $^W = 0; Carp::Clan->import('^[ABCDEF]\b'); };
  405 package main;
  406 
  407 eval { &A::a(1, "CrOaKiNg"); };
  408 
  409 if ($@ =~ /\bA::a\(\): CrOaKiNg at /)
  410 {print "ok $n\n";} else {print "not ok $n\n";}
  411 $n++;
  412 
  413 eval { &A::a(2, "CoNfEsSiNg"); };
  414 
  415 if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
  416          .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  417          .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  418          .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  419          .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  420          .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  421          .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  422          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  423 {print "ok $n\n";} else {print "not ok $n\n";}
  424 $n++;
  425 
  426 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };
  427 
  428 if ($@ =~ /\bA::a\(\): CaRpInG at /)
  429 {print "ok $n\n";} else {print "not ok $n\n";}
  430 $n++;
  431 
  432 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };
  433 
  434 if ($@ =~ /\bClUcKiNg\ at\ .+\n
  435          .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  436          .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  437          .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  438          .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  439          .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  440          .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  441          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  442 {print "ok $n\n";} else {print "not ok $n\n";}
  443 $n++;
  444 
  445 package F;
  446 eval { local $^W = 0; Carp::Clan->import('^(?:[ABCDEF]|main)\b'); };
  447 package main;
  448 
  449 eval { &A::a(1, "CrOaKiNg"); };
  450 
  451 if ($@ =~ /\bCrOaKiNg\ at\ .+\n
  452          .*\bF::f\((?:\d+,\s*)*1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
  453          .*\bE::e\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
  454          .*\bD::d\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
  455          .*\bC::c\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
  456          .*\bB::b\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
  457          .*\bA::a\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
  458          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  459 {print "ok $n\n";} else {print "not ok $n\n";}
  460 $n++;
  461 
  462 eval { &A::a(2, "CoNfEsSiNg"); };
  463 
  464 if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
  465          .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  466          .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  467          .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  468          .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  469          .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  470          .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  471          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  472 {print "ok $n\n";} else {print "not ok $n\n";}
  473 $n++;
  474 
  475 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };
  476 
  477 if ($@ =~ /\bCaRpInG\ at\ .+\n
  478          .*\bF::f\((?:\d+,\s*)*3,\ 'CaRpInG'\)\ called\ at\ .+\n
  479          .*\bE::e\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
  480          .*\bD::d\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
  481          .*\bC::c\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
  482          .*\bB::b\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
  483          .*\bA::a\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
  484          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  485 {print "ok $n\n";} else {print "not ok $n\n";}
  486 $n++;
  487 
  488 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };
  489 
  490 if ($@ =~ /\bClUcKiNg\ at\ .+\n
  491          .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  492          .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  493          .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  494          .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  495          .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  496          .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  497          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  498 {print "ok $n\n";} else {print "not ok $n\n";}
  499 $n++;
  500 
  501 package F;
  502 eval { local $^W = 0; Carp::Clan->import('.'); };
  503 package main;
  504 
  505 eval { &A::a(1, "CrOaKiNg"); };
  506 
  507 if ($@ =~ /\bCrOaKiNg\ at\ .+\n
  508          .*\bF::f\((?:\d+,\s*)*1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
  509          .*\bE::e\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
  510          .*\bD::d\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
  511          .*\bC::c\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
  512          .*\bB::b\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
  513          .*\bA::a\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
  514          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  515 {print "ok $n\n";} else {print "not ok $n\n";}
  516 $n++;
  517 
  518 eval { &A::a(2, "CoNfEsSiNg"); };
  519 
  520 if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
  521          .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  522          .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  523          .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  524          .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  525          .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  526          .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
  527          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  528 {print "ok $n\n";} else {print "not ok $n\n";}
  529 $n++;
  530 
  531 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };
  532 
  533 if ($@ =~ /\bCaRpInG\ at\ .+\n
  534          .*\bF::f\((?:\d+,\s*)*3,\ 'CaRpInG'\)\ called\ at\ .+\n
  535          .*\bE::e\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
  536          .*\bD::d\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
  537          .*\bC::c\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
  538          .*\bB::b\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
  539          .*\bA::a\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
  540          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  541 {print "ok $n\n";} else {print "not ok $n\n";}
  542 $n++;
  543 
  544 eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };
  545 
  546 if ($@ =~ /\bClUcKiNg\ at\ .+\n
  547          .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  548          .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  549          .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  550          .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  551          .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  552          .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
  553          .*\b(?:eval\ \{\.\.\.\}|require\ 0)\ called\ at\ /x)
  554 {print "ok $n\n";} else {print "not ok $n\n";}
  555 $n++;
  556 
  557 __END__
  558