Result:
found 565 distributions and 896 files matching your query !
( run in 1.878 )
Test-CVE
view release on metacpan or search on metacpan
lib/Test/CVE.pm view on Meta::CPAN
my %attr = @_;
my $tb = __PACKAGE__->builder;
# By default skip this test is not in a development env
if (!exists $attr{author} and
((caller)[1] =~ m{(?:^|/)xt/[^/]+\.t$} or
$ENV{AUTHOR_TESTING} or
-d ".git" && $^X =~ m{/perl$})) {
$attr{author}++;
}
unless ($attr{author}) {
Test-Class
view release on metacpan or search on metacpan
t/runtests_die.t view on Meta::CPAN
package main;
use Test::Builder::Tester tests => 1;
$ENV{TEST_VERBOSE}=0;
my $filename = sub { return (caller)[1] }->();
my $identifier = ($Test::More::VERSION < 0.88) ? 'object' : 'thing';
test_out( qr/not ok 1 - (?:The $identifier|undef) isa '?Object'?\n/);
test_err( "# Failed test ($filename at line 15)");
test_err( "# (in Foo->test_object)" );
Test-Dynamic
view release on metacpan or search on metacpan
t/bucardo.testfile view on Meta::CPAN
} ## end of shutdown_bucardo
sub wait_until_true {
my $xline = (caller)[2];
my $dbh = shift or die "Need a database handle (from line $xline)\n";
my $sql = shift or die "Need a SQL statement (from line $xline)\n";
my $timeout = shift || $TIMEOUT_SYNCWAIT;
my $sleep = shift || $TIMEOUT_SLEEP;
my $type = shift || 'true';
t/bucardo.testfile view on Meta::CPAN
} ## end of wait_until_true
sub wait_until_false {
my $xline = (caller)[2];
my $dbh = shift or die "Need a database handle (from line $xline)\n";
my $sql = shift or die "Need a SQL statement (from line $xline)\n";
my $timeout = shift || $TIMEOUT_SYNCWAIT;
my $sleep = shift || $TIMEOUT_SLEEP;
return wait_until_true($dbh,$sql,$timeout,$sleep,'false',$xline);
t/bucardo.testfile view on Meta::CPAN
redo;
}
};
$count = alarm 0;
return $count unless $@;
my $line = (caller)[2];
BAIL_OUT (qq{Gave up waiting for notice "$text": timed out at $timeout from line $line ($@)});
return;
} ## end of wait_for_notice
## no critic
{
no warnings; ## Yes, we know they are being redefined!
sub is_deeply {
t($_[2],$_[3] || (caller)[2]);
return if Test::More::is_deeply($_[0],$_[1],$testmsg);
if ($bail_on_error > $total_errors++) {
my $line = (caller)[2];
my $time = time;
diag("GOT: ".Dumper $_[0]);
diag("EXPECTED: ". Dumper $_[1]);
BAIL_OUT "Stopping on a failed 'is_deeply' test from line $line. Time: $time";
}
} ## end of is_deeply
sub like {
t($_[2],(caller)[2]);
return if Test::More::like($_[0],$_[1],$testmsg);
if ($bail_on_error > $total_errors++) {
my $line = (caller)[2];
my $time = time;
BAIL_OUT "Stopping on a failed 'like' test from line $line. Time: $time";
}
} ## end of like
sub pass {
t($_[0],$_[1]||(caller)[2]);
Test::More::pass($testmsg);
} ## end of pass
sub is {
t($_[2],(caller)[2]);
return if Test::More::is($_[0],$_[1],$testmsg);
if ($bail_on_error > $total_errors++) {
my $line = (caller)[2];
my $time = time;
BAIL_OUT "Stopping on a failed 'is' test from line $line. Time: $time";
}
} ## end of is
sub isa_ok {
t("Object isa $_[1]",(caller)[2]);
my ($name, $type, $msg) = ($_[0],$_[1]);
if (ref $name and ref $name eq $type) {
Test::More::pass($testmsg);
return;
}
t/bucardo.testfile view on Meta::CPAN
} ## end of isa_ok
sub ok {
t($_[1]||$testmsg);
return if Test::More::ok($_[0],$testmsg);
if ($bail_on_error > $total_errors++) {
my $line = (caller)[2];
my $time = time;
BAIL_OUT "Stopping on a failed 'ok' test from line $line. Time: $time";
}
} ## end of ok
}
t/bucardo.testfile view on Meta::CPAN
sub bc_deeply {
my ($exp,$dbh,$sql,$msg) = @_;
my $line = (caller)[2];
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Indent = 0;
die "Very invalid statement from line $line: $sql\n" if $sql !~ /^\s*select/i;
t/bucardo.testfile view on Meta::CPAN
};
if ($@) {
die "bc_deeply failed from line $line. SQL=$sql\n";
}
return is_deeply($got,$exp,$msg,(caller)[2]);
} ## end of bc_deeply
sub compare_tables {
my ($table,$sdbh,$rdbh) = @_;
my ($line) = (caller)[2];
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Indent = 0;
my $msg = "Table $table is the same on both databases";
t/bucardo.testfile view on Meta::CPAN
return;
} ## end of tt
sub t {
$testmsg = shift;
$testline = shift || (caller)[2];
$testmsg =~ s/^\s+//;
if ($location) {
$testmsg = "($location) $testmsg";
}
if ($showline) {
Test-Effects
view release on metacpan or search on metacpan
lib/Test/Effects.pm view on Meta::CPAN
$expected->{$option} = $NULL_VALUE_FOR{$option};
}
}
# Ensure there's a description...
$desc //= sprintf "Testing effects_ok() at %s line %d", (caller)[1,2];
# Are we echoing this test???
my $is_terse
= exists $expected->{'VERBOSE'} ? !$expected->{'VERBOSE'}
: !$lexical_hint{'Test::Effects::VERBOSE'};
Test-Exception
view release on metacpan or search on metacpan
t/lives_and.t view on Meta::CPAN
sub works {return shift};
sub dies { die 'oops' };
my $die_line = __LINE__ - 1;
my $filename = sub { return (caller)[1] }->();
lives_and {is works(42), 42} 'lives_and, no_exception & success';
test_out('not ok 1 - lives_and, no_exception & failure');
test_fail(+3);
Test-Group
view release on metacpan or search on metacpan
lib/Test/Group/Tester.pm view on Meta::CPAN
=cut
sub want_test {
my ($type, $name, @diag) = @_;
my $call_line = (caller)[2];
$type =~ /^(pass|fail|skip)\z/i or croak
"want_test type=[$type], need pass|fail|skip";
$type = lc $1;
lib/Test/Group/Tester.pm view on Meta::CPAN
sub fail_diag {
wantarray or croak "fail_diag needs a list context";
my ($test_name, $from_test_builder, $line, $file) = @_;
$file ||= (caller)[1];
my @diag;
if ($from_test_builder and $ENV{HARNESS_ACTIVE}) {
# Test::Builder adds a blank diag line for a failed test
Test-Harness
view release on metacpan or search on metacpan
sub my_open (*@) {
if ($useOrigOpen) {
if ( defined( $_[0] ) ) {
use Symbol qw();
my $handle = Symbol::qualify( $_[0], (caller)[0] );
no strict 'refs';
if ( @_ == 1 ) {
return CORE::open($handle);
}
elsif ( @_ == 2 ) {
Test-Kwalitee
view release on metacpan or search on metacpan
lib/Test/Kwalitee.pm view on Meta::CPAN
# this setting is internal and for this distribution only - there is
# no reason for you to need to circumvent this check in any other context.
# Please DO NOT enable this test to run for users, as it can fail
# unexpectedly as parts of the toolchain changes!
unless $ENV{_KWALITEE_NO_WARN} or $ENV{AUTHOR_TESTING} or $ENV{RELEASE_TESTING}
or (caller)[1] =~ m{^(?:\.[/\\])?xt\b}
or ((caller)[0]->isa(__PACKAGE__) and (caller(1))[1] =~ m{^(?:\.[/\\])?xt\b});
my @run_tests = grep { /^[^-]/ } @tests;
my @skip_tests = map { s/^-//; $_ } grep { /^-/ } @tests;
# These don't really work unless you have a tarball, so skip them
Test-Lib
view release on metacpan or search on metacpan
lib/Test/Lib.pm view on Meta::CPAN
sub import {
my $class = shift;
my $dir = shift;
if (! defined $dir) {
my $file = File::Spec->rel2abs((caller)[1]);
$dir = File::Spec->catpath((File::Spec->splitpath($file))[0,1], '');
}
for my $i (0..5) {
my $tdir = File::Spec->catdir($dir, (File::Spec->updir) x $i);
my $abs_path = Cwd::abs_path($tdir);
Test-Log-Log4perl
view release on metacpan or search on metacpan
lib/Test/Log/Log4perl.pm view on Meta::CPAN
};
return;
}
sub _cur_filename { (caller)[1] }
1;
package Log::Log4perl::Logger::IgnoreAll;
use base qw(Log::Log4perl::Logger);
Test-Log4perl
view release on metacpan or search on metacpan
lib/Test/Log4perl.pm view on Meta::CPAN
};
return;
}
sub _cur_filename { (caller)[1] }
1;
package Log::Log4perl::Logger::IgnoreAll;
use base qw(Log::Log4perl::Logger);
Test-Modern
view release on metacpan or search on metacpan
lib/Test/Modern.pm view on Meta::CPAN
} @_;
push @_, @EXPORT if $symbols == 0;
my $globals = ref($_[0]) eq 'HASH' ? shift() : {};
$globals->{into_file} = (caller)[1] unless ref($globals->{into});
unshift @_, $me, $globals;
goto \&Exporter::Tiny::import;
}
Test-More-Bash
view release on metacpan or search on metacpan
lib/Test/More/Bash.pm view on Meta::CPAN
has test => ();
has bash => ();
sub import {
my $test_file = (caller)[1];
# Allow this generated test to pass:
return if $test_file =~ m{000-compile-modules.t$};
__PACKAGE__->new(
Test-Ratchet
view release on metacpan or search on metacpan
lib/Test/Ratchet.pm view on Meta::CPAN
}
sub clank($) {
my $subref = shift;
my $caller = sprintf "%s, line %s", (caller)[1,2];
my $clank = rec { my $rec = shift; delete $Test::Ratchet::Clank::CLANK{ refaddr $rec }; &$subref };
$Test::Ratchet::Clank::CLANK{refaddr $clank} = $caller;
bless $clank, "Test::Ratchet::Clank";
}
Test-Simple
view release on metacpan or search on metacpan
t/Legacy/overload.t view on Meta::CPAN
package main;
local $SIG{__DIE__} = sub {
my($call_file, $call_line) = (caller)[1,2];
fail("SIGDIE accidentally called");
diag("From $call_file at $call_line");
};
my $obj = Overloaded->new('foo', 42);
Test-Tech
view release on metacpan or search on metacpan
t/Test/Tech/V001024/Test.pm view on Meta::CPAN
local($\, $,); # guard against -l and other things that screw with
# print
_reset_globals();
_read_program( (caller)[1] );
my $max=0;
for (my $x=0; $x < @_; $x+=2) {
my ($k,$v) = @_[$x,$x+1];
if ($k =~ /^test(s)?$/) { $max = $v; }
Test
view release on metacpan or search on metacpan
lib/Test.pm view on Meta::CPAN
local($\, $,); # guard against -l and other things that screw with
# print
_reset_globals();
_read_program( (caller)[1] );
my $max=0;
while (@_) {
my ($k,$v) = splice(@_, 0, 2);
if ($k =~ /^test(s)?$/) { $max = $v; }
Text-FixedLengthMultiline
view release on metacpan or search on metacpan
t/02parse.t view on Meta::CPAN
{
# Set the global variables
undef $fmt;
undef %data;
$fmt = Text::FixedLengthMultiline->new(@_);
isa_ok($fmt, 'Text::FixedLengthMultiline', 'Line '.(caller)[2]);
return $fmt;
}
# Parse a line and test the result
# 2 tests
sub test_parse()
{
my ($line, $expected_data, $expected_result) = @_;
my $test_name = 'Line ' . ((caller)[2]) . ' parsing result for: '.(defined $line ? "<$line>" : 'undef');
is($fmt->parse_line($line, \%data), $expected_result, $test_name);
is_deeply(\%data, $expected_data, $test_name);
}
&new_fmt(format => [ 'col1' => 6 ]);
Text-MacroScript
view release on metacpan or search on metacpan
t/mytests.pl view on Meta::CPAN
#------------------------------------------------------------------------------
# run a command, capture exit value, stdout and stderr and check
sub t_capture {
my($line_nr, $sub, $exp_out, $exp_err, $exp_ret) = @_;
my $where = "[line ".(caller)[2]."]";
my($out,$err,$ret) = capture { $sub->() };
$exp_err = _normalize_expected($exp_err, $line_nr);
for ($err, $exp_err) {
Text-Md2Inao
view release on metacpan or search on metacpan
lib/Text/Md2Inao/Builder/DSL.pm view on Meta::CPAN
use parent qw/Exporter/;
our @EXPORT = qw/case/;
sub case ($&) {
my ($select, $code) = @_;
my $class = (caller)[0];
my $self = $class->new;
for (split ",", $select) {
s/\s+//g;
$self->dispatch_table->{$_} = $code;
}
Text-Reform
view release on metacpan or search on metacpan
lib/Text/Reform.pm view on Meta::CPAN
}
elsif (defined wantarray) # CONTEXT BEING CAPTURED
{
$_[0]->{_prev} = { %std_config };
$_[0]->{_used} = 0;
$_[0]->{_line} = join " line ", (caller)[1..2];;
%{$_[0]} = %std_config = (%std_config, %{$_[0]});
fix_config(%std_config);
return bless $_[0], 'FormOpt';
}
else # PERMANENT RESET
{
$_[0]->{_used} = 1;
$_[0]->{_line} = join " line ", (caller)[1..2];;
%std_config = (%std_config, %{$_[0]});
fix_config(%std_config);
return;
}
}
Text-Table-Boxed
view release on metacpan or search on metacpan
t/t_TestCommon.pm view on Meta::CPAN
# This is only visible with using "perl -Ilib t/xxx.t"
# not with 'prove -l' and so mostly pointless!
sub t_ok($;$) {
my ($isok, $test_label) = @_;
my $lno = (caller)[2];
$test_label = ($test_label//"") . " (line $lno)";
@_ = ( $isok, $test_label );
goto &Test2::V0::ok; # show caller's line number
}
sub ok_with_lineno($;$) { goto &t_ok };
sub t_is($$;$) {
my ($got, $exp, $test_label) = @_;
my $lno = (caller)[2];
$test_label = ($test_label//$exp//"undef") . " (line $lno)";
@_ = ( $got, $exp, $test_label );
goto &Test2::V0::is; # show caller's line number
}
sub is_with_lineno($$;$) { goto &t_is }
sub t_like($$;$) {
my ($got, $exp, $test_label) = @_;
my $lno = (caller)[2];
$test_label = ($test_label//$exp) . " (line $lno)";
@_ = ( $got, $exp, $test_label );
goto &Test2::V0::like; # show caller's line number
}
sub like_with_lineno($$;$) { goto &t_like }
sub _mycheck_end($$$) {
my ($errmsg, $test_label, $ok_only_if_failed) = @_;
return
if $ok_only_if_failed && !$errmsg;
my $lno = (caller)[2];
&Test2::V0::diag("**********\n${errmsg}***********\n") if $errmsg;
@_ = ( !$errmsg, $test_label );
goto &ok_with_lineno;
}
Thread-Queue-Any-Monitored
view release on metacpan or search on metacpan
Thank you for your attention.
SORRY
my $line= (caller)[2];
eval <<"BYEBYE" or print STDERR $@;
#line $line $0
require $REQUIRED;
BYEBYE
exit 1;
Thread-Queue-Any
view release on metacpan or search on metacpan
Thank you for your attention.
SORRY
my $line= (caller)[2];
eval <<"BYEBYE" or print STDERR $@;
#line $line $0
require $REQUIRED;
BYEBYE
exit 1;
Thread-Queue-MaxSize
view release on metacpan or search on metacpan
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
return ($ok);
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $got\n");
print("# expected: $expected\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $got\n");
print("# doesn't match: $like\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $g_err\n");
print("# expected: $e_err\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
Thread-Queue-Monitored
view release on metacpan or search on metacpan
Thank you for your attention.
SORRY
my $line= (caller)[2];
eval <<"BYEBYE" or print STDERR $@;
#line $line $0
require $REQUIRED;
BYEBYE
exit 1;
Thread-Queue-Priority
view release on metacpan or search on metacpan
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
return ($ok);
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $got\n");
print("# expected: $expected\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $got\n");
print("# doesn't match: $like\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $g_err\n");
print("# expected: $e_err\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
Thread-Queue
view release on metacpan or search on metacpan
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
return ($ok);
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $got\n");
print("# expected: $expected\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $got\n");
print("# doesn't match: $like\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $g_err\n");
print("# expected: $e_err\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
Thread-Semaphore
view release on metacpan or search on metacpan
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
return ($ok);
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $got\n");
print("# expected: $expected\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $got\n");
print("# expected: $expected\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print("# got: $g_err\n");
print("# expected: $e_err\n");
print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
}
Thread-Serialize
view release on metacpan or search on metacpan
Thank you for your attention.
SORRY
my $line= (caller)[2];
eval <<"BYEBYE" or print STDERR $@;
#line $line $0
require $REQUIRED;
BYEBYE
exit 1;
( run in 1.878 second using v1.01-cache-2.11-cpan-1e74a51a04c )