01_______carp.t

SinFP是一种新的识别对方计算机操作系统类型的工具

if ($@ =~ /\bD::d\(\): CrOaKiNg at /)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { &A::a(2, "CoNfEsSiNg"); };

if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };

if ($@ =~ /\bD::d\(\): CaRpInG at /)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };

if ($@ =~ /\bClUcKiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

package F;
eval { local $^W = 0; Carp::Clan->import('^[CDEF]\b'); };
package main;

eval { &A::a(1, "CrOaKiNg"); };

if ($@ =~ /\bC::c\(\): CrOaKiNg at /)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { &A::a(2, "CoNfEsSiNg"); };

if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };

if ($@ =~ /\bC::c\(\): CaRpInG at /)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };

if ($@ =~ /\bClUcKiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

package F;
eval { local $^W = 0; Carp::Clan->import('^[BCDEF]\b'); };
package main;

eval { &A::a(1, "CrOaKiNg"); };

if ($@ =~ /\bB::b\(\): CrOaKiNg at /)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { &A::a(2, "CoNfEsSiNg"); };

if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };

if ($@ =~ /\bB::b\(\): CaRpInG at /)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };

if ($@ =~ /\bClUcKiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

package F;
eval { local $^W = 0; Carp::Clan->import('^[ABCDEF]\b'); };
package main;

eval { &A::a(1, "CrOaKiNg"); };

if ($@ =~ /\bA::a\(\): CrOaKiNg at /)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { &A::a(2, "CoNfEsSiNg"); };

if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };

if ($@ =~ /\bA::a\(\): CaRpInG at /)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };

if ($@ =~ /\bClUcKiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

package F;
eval { local $^W = 0; Carp::Clan->import('^(?:[ABCDEF]|main)\b'); };
package main;

eval { &A::a(1, "CrOaKiNg"); };

if ($@ =~ /\bCrOaKiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
         .*\bE::e\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
         .*\bD::d\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
         .*\bC::c\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
         .*\bB::b\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
         .*\bA::a\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { &A::a(2, "CoNfEsSiNg"); };

if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };

if ($@ =~ /\bCaRpInG\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*3,\ 'CaRpInG'\)\ called\ at\ .+\n
         .*\bE::e\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
         .*\bD::d\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
         .*\bC::c\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
         .*\bB::b\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
         .*\bA::a\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };

if ($@ =~ /\bClUcKiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

package F;
eval { local $^W = 0; Carp::Clan->import('.'); };
package main;

eval { &A::a(1, "CrOaKiNg"); };

if ($@ =~ /\bCrOaKiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
         .*\bE::e\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
         .*\bD::d\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
         .*\bC::c\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
         .*\bB::b\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
         .*\bA::a\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { &A::a(2, "CoNfEsSiNg"); };

if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); };

if ($@ =~ /\bCaRpInG\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*3,\ 'CaRpInG'\)\ called\ at\ .+\n
         .*\bE::e\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
         .*\bD::d\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
         .*\bC::c\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
         .*\bB::b\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
         .*\bA::a\(3,\ 'CaRpInG'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); };

if ($@ =~ /\bClUcKiNg\ at\ .+\n
         .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n
         .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

__END__