view release on metacpan or search on metacpan
lib/Test/Exception/LessClever.pm view on Meta::CPAN
Test passes if the sub does not die, false if it does.
=cut
sub lives_ok(&;$) {
my ( $code, $name ) = @_;
my $ok = live_or_die( $code );
$TB->ok( $ok, $name );
return $ok;
}
lib/Test/Exception/LessClever.pm view on Meta::CPAN
Test passes if the sub dies, false if it does not.
=cut
sub dies_ok(&;$) {
my ( $code, $name ) = @_;
my $ok = live_or_die( $code );
$TB->ok( !$ok, $name );
return !$ok;
}
lib/Test/Exception/LessClever.pm view on Meta::CPAN
Test fails is the sub does not die, or if the message does not match the regex.
=cut
sub throws_ok(&$;$) {
my ( $code, $reg, $name ) = @_;
my ( $ok, $msg ) = live_or_die( $code );
my ( $pkg, $file, $number ) = caller;
# If we lived
lib/Test/Exception/LessClever.pm view on Meta::CPAN
running a test that could die. If it dies there is a failure, if it lives it is
responsible for itself.
=cut
sub lives_and(&;$) {
my ( $code, $name ) = @_;
my ( $ok, $msg )= live_or_die( $code );
my ( $pkg, $file, $number ) = caller;
chomp( $msg );
$msg =~ s/\n/ /g;
view release on metacpan or search on metacpan
lib/Test/Exec.pm view on Meta::CPAN
}
my $last;
sub exec_arrayref(&)
{
my($code) = @_;
undef $last;
view release on metacpan or search on metacpan
lib/Test/Exit.pm view on Meta::CPAN
BEGIN {
*CORE::GLOBAL::exit = sub (;$) { $exit_handler->(@_ ? 0 + $_[0] : 0) };
}
sub exit_code(&) {
my ($code) = @_;
return with_return {
local $exit_handler = $_[0];
$code->();
view release on metacpan or search on metacpan
examples/exception_like.t view on Meta::CPAN
use Test::More;
use Test::Fatal;
use Carp 'confess';
sub exception_like(&$;$)
{
my ($code, $pattern, $name) = @_;
like( &exception($code), $pattern, $name );
}
view release on metacpan or search on metacpan
lib/Test/Functional.pm view on Meta::CPAN
Whether the test passes or fails, I<test> returns the value generated by
I<BLOCK>.
=cut
sub test(&$;$) {
return _test(0, @_);
}
=item B<pretest { BLOCK } [CONDITION,] NAME>
lib/Test/Functional.pm view on Meta::CPAN
If the C<use Foo::Bar> fails, the information that all the other tests are
failing is less useful. I<pretest> can also be combined with I<group>
(described later) to short-circuit a small set of related tests.
=cut
sub pretest(&$;$) {
return _test(1, @_);
}
=item B<notest { BLOCK } [CONDITION,] NAME>
lib/Test/Functional.pm view on Meta::CPAN
For test-driven development, it is useful to create failing tests using
I<notest> blocks; this prevents test regression. Once the implementation starts
working I<notest> can be switched to I<test>.
=cut
sub notest(&$;$) {
if($UNSTABLE) {
return _test(0, @_);
} else {
my $t = __PACKAGE__->builder();
$t->skip("$_[-1]");
lib/Test/Functional.pm view on Meta::CPAN
results, so they will be skipped. See the L<ETHOS> section for a more in-depth
discussion of the package in general, and the implications of test
short-circuiting in particular.
=cut
sub group(&$) {
my ($func, $name) = @_;
push(@STACK, $name);
eval { &$func() };
pop(@STACK);
view release on metacpan or search on metacpan
lib/Test/Future/IO/Impl.pm view on Meta::CPAN
my $errstr_ECONNREFUSED = do {
local $! = Errno::ECONNREFUSED; "$!";
};
sub time_about(&@)
{
my ( $code, $want_time, $name ) = @_;
my $ctx = Test2::API::context;
my $t0 = time();
view release on metacpan or search on metacpan
lib/Test/HTTP.pm view on Meta::CPAN
our $BasicUsername;
our $UaClass = 'LWP::UserAgent';
our $TODO = undef;
our @EXPORT = qw($TODO);
sub _partition(&@);
sub import {
my $class = shift;
$Builder->exported_to(scalar caller);
lib/Test/HTTP.pm view on Meta::CPAN
}
# Given a predicate and a list, return two listrefs. The elements in the
# first listref satisfy the predicate, and those in the second do not. The
# predicate acts on a localized value of $_ rather than any arguments to it.
sub _partition(&@) {
my ( $pred, @l ) = @_;
my ( $tl, $fl ) = ( [], [] );
push @{ &$pred ? $tl : $fl }, $_ for @l;
view release on metacpan or search on metacpan
lib/Test/Helper.pm view on Meta::CPAN
@ISA=qw(Exporter);
@EXPORT=qw(ok comm test runs heinous syntax_check);
# $Format: "$VERSION='$TestHelperRelease$';"$
$VERSION='0.002';
sub test(&) {
local($count)=0;
local($output)='';
eval {&{+shift}};
$count++ if $@; # Simulate something wrong.
print "1..$count\n$output";
lib/Test/Helper.pm view on Meta::CPAN
sub comm(@) {
my $comm=join '', @_;
$output .= "# $comm...\n";
}
sub runs(&) {
my $subr=shift;
eval {&$subr()};
not $@;
}
sub heinous(&) {
carp "`heinous {...}' is deprecated--use `ok not runs {...} instead'";
my $subr=shift;
ok not &runs($subr);
}
view release on metacpan or search on metacpan
lib/Test/Ika.pm view on Meta::CPAN
describe(@_);
}
*xcontext = \&xdescribe;
sub before_suite(&) {
my $code = shift;
$ROOT->add_trigger(before_all => $code);
}
sub after_suite(&) {
my $code = shift;
$ROOT->add_trigger(after_all => $code);
}
sub before_all(&) {
my $code = shift;
$CURRENT->add_trigger(before_all => $code);
}
sub after_all(&) {
my $code = shift;
$CURRENT->add_trigger(after_all => $code);
}
sub before_each(&) {
my $code = shift;
$CURRENT->add_trigger(before_each => $code);
}
sub after_each(&) {
my $code = shift;
$CURRENT->add_trigger(after_each => $code);
}
sub runtests {
view release on metacpan or search on metacpan
lib/Test/Kantan.pm view on Meta::CPAN
$reason //= '';
print "1..0 # SKIP ${reason}\n";
exit 0;
}
sub setup(&) {
my ($code) = @_;
$CURRENT->add_trigger('setup' => $code);
}
sub before_each { goto \&setup }
sub teardown(&) {
my ($code) = @_;
$CURRENT->add_trigger('teardown' => $code);
}
sub after_each { goto \&teardown }
lib/Test/Kantan.pm view on Meta::CPAN
stuff => $stuff,
builder => Test::Kantan->builder
);
}
sub ok(&) {
my $code = shift;
if ($HAS_DEVEL_CODEOBSERVER) {
state $observer = Devel::CodeObserver->new();
my ($retval, $result) = $observer->call($code);
view release on metacpan or search on metacpan
lib/Test/LeakTrace.pm view on Meta::CPAN
}
return _finish($mode);
}
sub leaked_refs(&){
my($block) = @_;
return _do_leaktrace($block, 'leaked_refs', 0);
}
sub leaked_info(&){
my($block) = @_;
return _do_leaktrace($block, 'leaked_refs', 1);
}
sub leaked_count(&){
my($block) = @_;
return scalar _do_leaktrace($block, 'leaked_count', 0);
}
sub leaktrace(&;$){
my($block, $mode) = @_;
_do_leaktrace($block, 'leaktrace', 1, defined($mode) ? $mode : -simple);
return;
}
sub leaks_cmp_ok(&$$;$){
my($block, $cmp_op, $expected, $description) = @_;
my $Test = __PACKAGE__->builder;
if(!_runops_installed()){
lib/Test/LeakTrace.pm view on Meta::CPAN
}
return $result;
}
sub no_leaks_ok(&;$){
# ($block, $description)
splice @_, 1, 0, ('<=', 0); # ($block, '<=', 0, $description);
goto &leaks_cmp_ok;
}
view release on metacpan or search on metacpan
lib/Test/LectroTest/Generator.pm view on Meta::CPAN
#==============================================================================
# plain old functions
sub Gen(&) {
my ($genfn) = @_;
return Test::LectroTest::Generator->new(generator=>$genfn);
}
=pod
lib/Test/LectroTest/Generator.pm view on Meta::CPAN
B<Note:> This combinator does not accept modifiers.
=cut
sub Apply(&@) {
my $f = shift;
my $g = Each( @_ );
return Gen {
scalar $f->( @{$g->generate(@_)} )
};
lib/Test/LectroTest/Generator.pm view on Meta::CPAN
return Gen {
[ map { scalar $f->($_) } @{ $g->generate(@_) } ]
};
}
sub Map(&@) {
_Map(@_);
}
=pod
lib/Test/LectroTest/Generator.pm view on Meta::CPAN
B<Note:> This combinator does not accept modifiers.
=cut
sub ConcatMap(&@) {
my $g = _Map( @_ );
return Gen {
_concat @{ $g->generate( @_ ) };
};
}
lib/Test/LectroTest/Generator.pm view on Meta::CPAN
B<Note:> This combinator does not accept modifiers.
=cut
sub FlattenMap(&@) {
my $g = _Map( @_ );
return Gen {
_flatten @{ $g->generate( @_ ) };
};
}
lib/Test/LectroTest/Generator.pm view on Meta::CPAN
B<Note:> This combinator does not accept modifiers.
=cut
sub Sized(&$) {
my ($sizer, $gen) = @_;
return Gen {
return $gen->generate($sizer->(@_));
};
}
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
view release on metacpan or search on metacpan
ManyParams.pm view on Meta::CPAN
"Failed using these parameters: " . _dump_params($failed_param));
return ($ok, @diag);
}
sub all_ok(&$;$) {
my ($sub, $params, $test_name) = @_;
my ($ok, @diag) = does_all(@_);
$Tester->ok( $ok, $test_name ) or do { $Tester->diag($_) for @diag };
return $ok;
}
sub most_ok(&$$;$) {
my ($sub, $params, $nr, $test_name) = @_;
my ($ok, @diag) = does_most(@_);
$Tester->ok( $ok, $test_name ) or do { $Tester->diag($_) for @diag };
return $ok;
}
sub any_ok(&$;$) {
my ($sub, $params, $test_name) = @_;
# Please recognise the logic
# To find out if any of the tests is O.K.,
# I ask whether all tests fail
ManyParams.pm view on Meta::CPAN
my $ok = !$all_arent_ok;
$Tester->ok( $ok, $test_name );
return $ok;
}
sub any_is(&$$;$) {
my ($sub, $expected_value, $params, $test_name) = @_;
my ($all_arent_ok, @diag) =
does_all(sub {!($sub->(@_) eq $expected_value)}, $params, $test_name);
my $ok = !$all_arent_ok;
$Tester->ok( $ok, $test_name)
ManyParams.pm view on Meta::CPAN
$Tester->diag("Expected: " . _dump_params($expected_value));
$Tester->diag("but didn't found it with at least one parameter");
};
}
sub any_isnt(&$$;$) {
my ($sub, $expected_value, $params, $test_name) = @_;
my ($all_arent_ok, @diag) =
does_all(sub {!($sub->(@_) ne $expected_value)}, $params, $test_name);
my $ok = !$all_arent_ok;
$Tester->ok( $ok, $test_name)
ManyParams.pm view on Meta::CPAN
$Tester->diag("Expected to find any parameter where result is different to " . _dump_params($expected_value));
$Tester->diag("but didn't found such parameters");
};
}
sub all_are(&$$;$) {
my ($sub, $expected, $params, $test_name) = @_;
my $found = undef;
my ($ok, @diag) =
does_all( sub { $found = $sub->(@_); $found eq $expected }, $params);
$Tester->ok($ok, $test_name)
ManyParams.pm view on Meta::CPAN
$Tester->diag("Expected: " . _dump_params($expected));
$Tester->diag("but found: " . _dump_params($found));
};
}
sub all_arent(&$$;$) {
my ($sub, $unexpected, $params, $test_name) = @_;
my $found = undef;
my ($ok, @diag) =
does_all( sub { $found = $sub->(@_); $found ne $unexpected }, $params);
$Tester->ok($ok, $test_name)
view release on metacpan or search on metacpan
lib/Test/MemoryGrowth.pm view on Meta::CPAN
=back
=cut
sub no_growth(&@)
{
my $code = shift;
my $name; $name = pop if @_ % 2;
my %args = @_;
view release on metacpan or search on metacpan
lib/Test/Metrics/Any.pm view on Meta::CPAN
The metrics in the test adapter are cleared, then the code is invoked, then
any metrics are checked in the same manner as L</is_metrics>.
=cut
sub is_metrics_from(&@)
{
my ( $code, $expect, $testname ) = @_;
Metrics::Any::Adapter::Test->clear;
view release on metacpan or search on metacpan
t/09_prototypes.t view on Meta::CPAN
use Test::More;
use Test::Mock::Guard qw(mock_guard);
package Some::Class;
sub apply(&@) {
my $code = shift;
$code->() foreach @_;
}
package main;
view release on metacpan or search on metacpan
lib/Test/MockPackages/Returns.pm view on Meta::CPAN
use English qw(-no_match_vars);
use Exporter qw(import);
our @EXPORT_OK = qw(returns_code);
sub returns_code(&) { ## no critic (Subroutines::ProhibitSubroutinePrototypes)
my ( $coderef ) = @ARG;
return bless $coderef, __PACKAGE__;
}
view release on metacpan or search on metacpan
lib/Test/Most.pm view on Meta::CPAN
sub explain {
_explain(\&Test::More::note, @_);
}
sub timeit(&;$) {
my ( $code, $message ) = @_;
unless($HAVE_TIME_HIRES) {
Test::Most::diag("timeit: Time::HiRes not installed");
$code->();
}
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
view release on metacpan or search on metacpan
lib/Test/Net/LDAP/Util.pm view on Meta::CPAN
See L<Test::Net::LDAP::Mock> for more details.
=cut
sub ldap_mockify(&) {
my ($callback) = @_;
require Test::Net::LDAP::Mock;
Test::Net::LDAP::Mock->mockify($callback);
}
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected, $name;
diag Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
view release on metacpan or search on metacpan
lib/Test/NoTty.pm view on Meta::CPAN
use POSIX qw(setsid _exit WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
our @EXPORT = 'without_tty';
our $VERSION = '0.03';
sub without_tty(&@) {
my ($code, @args) = @_;
pipe my $reader, my $writer
or die "Can't pipe: $!";
# So, "how to detach from your controlling terminal" is a subset of the "how
view release on metacpan or search on metacpan
t/060-step-definition.t view on Meta::CPAN
done_testing();
sub test_symbol(&$);
###
### Test wrapper
###
sub test_symbol (&$) {
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
view release on metacpan or search on metacpan
lib/Test/Power.pm view on Meta::CPAN
RESULT_OPINDEX => 1,
};
our $DUMP_CUTOFF = 80;
sub expect(&;$) {
my ($code, $description) = @_;
my ($package, $filename, $line_no, $line) = Test::Power::FromLine::inspect_line(0);
$description ||= "L$line_no" . (length($line) ? " : $line" : '');
view release on metacpan or search on metacpan
lib/Test/RandomResult.pm view on Meta::CPAN
use Exporter 'import';
our @EXPORT = qw(
results_look_random
);
sub results_look_random(&@) {
my $code = shift;
my $opts = {};
while (@_ > 1) {
my ($k, $v) = splice @_, 0, 2;
$opts->{$k} = $v;
view release on metacpan or search on metacpan
lib/Test/Resub.pm view on Meta::CPAN
use Carp qw(croak);
use Storable qw(dclone);
use Scalar::Util qw(weaken);
sub default_replacement_sub { sub {} }
sub set_prototype(&$) {
if (_implements('Scalar::Util','set_prototype')) {
goto \&Scalar::Util::set_prototype;
} else {
my $code = shift;
my $proto = shift;
view release on metacpan or search on metacpan
lib/Test2/API.pm view on Meta::CPAN
sub _add_uuid_via_ref { \($INST->{Test2::API::Instance::ADD_UUID_VIA()}) }
# Private, for use in Test2::IPC
sub _set_ipc { $INST->set_ipc(@_) }
sub context_do(&;@) {
my $code = shift;
my @args = @_;
my $ctx = context(level => 1);
lib/Test2/API.pm view on Meta::CPAN
return @out if $want;
return $out[0] if defined $want;
return;
}
sub no_context(&;$) {
my ($code, $hid) = @_;
$hid ||= $STACK->top->hid;
my $ctx = $CONTEXTS->{$hid};
delete $CONTEXTS->{$hid};
lib/Test2/API.pm view on Meta::CPAN
sub release($;$) {
$_[0]->release;
return $_[1];
}
sub intercept(&) {
my $code = shift;
my $ctx = context();
my $events = _intercept($code, deep => 0);
$ctx->release;
return $events;
}
sub intercept_deep(&) {
my $code = shift;
my $ctx = context();
my $events = _intercept($code, deep => 1);
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);