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/Net/FSP/Handle.pm view on Meta::CPAN
my %class_for = (
'<' => 'Net::FSP::Handle::Read',
'>' => 'Net::FSP::Handle::Write',
);
sub do_or_fail(&) { ##no critic prototype
my $action = shift;
local $@;
my $ret;
eval { $ret = $action->(); };
if ($@) {
view release on metacpan or search on metacpan
t/Net/Fluidinfo/TestUtils.pm view on Meta::CPAN
sub ok_sets_cmp {
my ($a, $b) = @_;
is_deeply [sort @$a], [sort @$b];
}
sub ok_dies(&) {
eval { shift->() };
ok $@;
}
sub skip_suite_unless_run_all {
t/Net/Fluidinfo/TestUtils.pm view on Meta::CPAN
# waiting one second between calls. If a threshold of one minute is
# reached, we print a skip message and move on.
#
# Useful for testing searching after tagging for example, since new
# tags are not visible immediately for searching.
sub tolerate_delay(&) {
my $code = shift;
SKIP: {
for (my $n = 0; $n < 60; ++$n) {
return if $code->();
view release on metacpan or search on metacpan
}
}
}
our $command;
sub dispatch(&) {
my ($code) = @_;
return sub {
local @ARGV = @ARGV;
local $command = next_command;
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
maint-travis-ci/lib/tools.pm view on Meta::CPAN
package tools;
use Cwd qw(cwd);
use Config;
sub capture_stdout(&) {
require Capture::Tiny;
goto &Capture::Tiny::capture_stdout;
}
sub diag {
view release on metacpan or search on metacpan
t/split-ipv6.t view on Meta::CPAN
use Test2::V0;
use Net::Netmask;
#feel free to add a build requires of Test::Exception if that is okay with you.
sub throws_ok(&$$) {
my ( $code, $regex, $desc ) = @_;
eval { $code->(); };
my $err = $@;
view release on metacpan or search on metacpan
lib/Net/POP3/SSLWrapper.pm view on Meta::CPAN
our $VERSION = '0.06';
our @EXPORT = 'pop3s';
my @instances;
sub pop3s(&) { ## no critic.
my $code = shift;
local @Net::POP3::ISA = __PACKAGE__;
$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
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/Net/Radio/oFono/Helpers/Container.pm view on Meta::CPAN
recommended to use this method - it's here for compatibility reasons only.
A better way to do sth. for each item is to use the iterator operators.
=cut
sub for_each(&)
{
my ( $self, $sub ) = @_;
affirm { _CODELIKE($sub) } "Parameter at index 0 isn't coderef";
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
t/t_TestCommon.pm view on Meta::CPAN
open($orig_stdERR, ">&", \*STDERR) or die "dup STDERR: $!";
close STDERR;
open(STDERR, ">", \$inmem_stdERR) or die "redir STDERR: $!";
binmode(STDERR); binmode(STDERR, ":utf8");
}
sub silent(&) {
my $wantarray = wantarray;
my $code = shift;
_start_silent();
my @result = do{
if (defined $wantarray) {
t/t_TestCommon.pm view on Meta::CPAN
my ($fn, $lno) = (caller(0))[1,2];
#use Data::Dumper::Interp; say dvis '###insert_loc_in_evalstr $fn $lno';
"# line $lno \"$fn\"\n".$orig
}
sub timed_run(&$@) {
my ($code, $maxcpusecs, @codeargs) = @_;
my $getcpu = eval {do{
require Time::HiRes;
() = (&Time::HiRes::clock());
t/t_TestCommon.pm view on Meta::CPAN
# to the cwd!
$str =~ s/The media is write protected\S*\R//gs;
$str
}
sub my_capture(&) {
my ($out, $err, @results) = &capture($_[0]);
return( clean_capture_output($out), clean_capture_output($err), @results );
}
sub my_capture_merged(&) {
my ($merged, @results) = &capture_merged($_[0]);
return( clean_capture_output($merged), @results );
}
sub my_tee_merged(&) {
my ($merged, @results) = &tee_merged($_[0]);
return( clean_capture_output($merged), @results );
}
1;
view release on metacpan or search on metacpan
t/t_TestCommon.pm view on Meta::CPAN
open($orig_stdERR, ">&", \*STDERR) or die "dup STDERR: $!";
close STDERR;
open(STDERR, ">", \$inmem_stdERR) or die "redir STDERR: $!";
binmode(STDERR); binmode(STDERR, ":utf8");
}
sub silent(&) {
my $wantarray = wantarray;
my $code = shift;
_start_silent();
my @result = do{
if (defined $wantarray) {
t/t_TestCommon.pm view on Meta::CPAN
my ($fn, $lno) = (caller(0))[1,2];
#use Data::Dumper::Interp; say dvis '###insert_loc_in_evalstr $fn $lno';
"# line $lno \"$fn\"\n".$orig
}
sub timed_run(&$@) {
my ($code, $maxcpusecs, @codeargs) = @_;
my $getcpu = eval {do{
require Time::HiRes;
() = (&Time::HiRes::clock());
t/t_TestCommon.pm view on Meta::CPAN
# to the cwd!
$str =~ s/The media is write protected\S*\R//gs;
$str
}
sub my_capture(&) {
my ($out, $err, @results) = &capture($_[0]);
return( clean_capture_output($out), clean_capture_output($err), @results );
}
sub my_capture_merged(&) {
my ($merged, @results) = &capture_merged($_[0]);
return( clean_capture_output($merged), @results );
}
sub my_tee_merged(&) {
my ($merged, @results) = &tee_merged($_[0]);
return( clean_capture_output($merged), @results );
}
1;
view release on metacpan or search on metacpan
lib/Object/HashBase/Test.pm view on Meta::CPAN
return 1 if $NO_RUN;
our $VERSION = '0.015';
# <-- START -->
sub warnings(&) {
my $code = shift;
my @warnings;
local $SIG{__WARN__} = sub { push @warnings => @_ };
$code->();
return \@warnings;
}
sub exception(&) {
my $code = shift;
local ($@, $!, $SIG{__DIE__});
my $ok = eval { $code->(); 1 };
my $error = $@ || 'SQUASHED ERROR';
return $ok ? undef : $error;
view release on metacpan or search on metacpan
lib/Oktest.pm view on Meta::CPAN
my $to = $Oktest::TopicObject::__current
or die "$name() should be called in topic block.";
$to->$name($block);
}
sub before(&) {
_set_fixture('before', @_);
}
sub after(&) {
_set_fixture('after', @_);
}
sub before_all(&) {
_set_fixture('before_all', @_);
}
sub after_all(&) {
_set_fixture('after_all', @_);
}
sub at_end(&) {
my ($block) = @_;
## todo: check whether at_end() is called in spec block.
push(@Oktest::__at_end_blocks, $block);
}
lib/Oktest.pm view on Meta::CPAN
sub main {
Oktest::MainApp->new(@_)->execute();
}
sub with(&) {
my ($block) = @_;
return $block;
}
sub __clear {
lib/Oktest.pm view on Meta::CPAN
}
}
return $str;
}
sub _assert(&@) {
my ($closure, $op, $validate, $this, $expected) = @_;
$this->_done();
if ($validate) {
my $msg = $this->_validate_expected($expected, $op);
die $msg if $msg;
lib/Oktest.pm view on Meta::CPAN
sub length {
my (@arr) = @_;
return $#arr + 1;
}
sub index(&@) {
my ($block, @arr) = @_;
my $i = 0;
for (@arr) {
return $i if $block->($_);
$i++;
}
return -1;
}
sub index_denied(&@) {
my ($block, @arr) = @_;
my $i = 0;
for (@arr) {
return $i unless $block->($_);
$i++;
lib/Oktest.pm view on Meta::CPAN
close $OUT;
close $ERR;
return join("", @output), join("", @error);
}
sub capture(&) {
my ($block) = @_;
my $sout = tie(local *STDOUT, 'Oktest::Util::__PrintHandler');
local *STDERR = *STDOUT;
$block->();
return $sout->output;
}
sub capture_stdouterr(&) {
my ($block) = @_;
my $sout = tie(local *STDOUT, 'Oktest::Util::__PrintHandler');
my $serr = tie(local *STDERR, 'Oktest::Util::__PrintHandler');
$block->();
return ($sout->output, $serr->output);
}
sub capture_stdout(&) {
my ($block) = @_;
my $sout = tie(local *STDOUT, 'Oktest::Util::__PrintHandler');
$block->();
return $sout->output;
}
sub capture_stderr(&) {
my ($block) = @_;
my $serr = tie(local *STDERR, 'Oktest::Util::__PrintHandler');
$block->();
return $serr->output;
}
lib/Oktest.pm view on Meta::CPAN
#sub eq_set {
# my ($this, $that) = @_;
# Oktest::OK ($this)->equals($that);
#}
sub throws_ok(&$;$) {
my ($coderef, $pattern, $description) = @_;
Oktest::OK ($coderef)->dies($pattern);
return 1==1;
}
sub dies_ok(&;$) {
my ($coderef, $description) = @_;
Oktest::OK ($coderef)->dies();
return 1==1;
}
sub lives_ok(&;$) {
my ($coderef, $description) = @_;
Oktest::OK ($coderef)->not_die();
return 1==1;
}
sub lives_and(&;$) {
my ($test, $description) = @_;
Oktest::OK ($test)->not_die();
return 1==1;
}
sub warning_like(&$;$) {
my ($coderef, $pattern, $test_name) = @_;
Oktest::OK ($coderef)->warns($pattern);
return 1==1;
}
view release on metacpan or search on metacpan
lib/OpenGL/List.pm view on Meta::CPAN
Returns a new display list name that can be passed to glCallList() later.
=cut
sub glpList(&) {
my $code = shift;
my $id = OpenGL::glGenLists(1);
OpenGL::glNewList( $id, OpenGL::GL_COMPILE() );
$code->();
OpenGL::glEndList();
view release on metacpan or search on metacpan
t/90-visual-inspection.t view on Meta::CPAN
$res->resource_root_dir(catdir($FindBin::Bin, 'data'));
$res->font_config({
default => { filename => 'SquadaOne-Regular', face_size => 32 }
});
sub show(&) {
my ($code, $tname)= @_;
glClear(GL_COLOR_BUFFER_BIT|GL_DEPTH_BUFFER_BIT);
load_identity;
$code->();
$c->swap_buffers;
sleep .5;
my @e= get_gl_errors;
ok( !@e, $tname )
or diag "GL Errors: ".join(', ', @e);
}
sub spin(&) {
my ($code, $tname)= @_;
load_identity;
for (my $i= 0; $i < 200; $i++) {
glClear(GL_COLOR_BUFFER_BIT|GL_DEPTH_BUFFER_BIT);
local_matrix {
view release on metacpan or search on metacpan
lib/OpenGL/Sandbox/V1.pm view on Meta::CPAN
if $x or $y or $z;
glMatrixMode(GL_MODELVIEW);
}
sub local_matrix(&) { goto &_local_matrix }
BEGIN { *load_identity= *glLoadIdentity; }
sub local_gl(&) { goto &_local_gl }
sub lines(&) { goto &_lines }
sub line_strip(&) { goto &_line_strip }
sub quads(&) { goto &_quads }
sub quad_strip(&) { goto &_quad_strip }
sub triangles(&) { goto &_triangles }
sub triangle_strip(&) { goto &_triangle_strip }
sub triangle_fan(&) { goto &_triangle_fan }
our $default_quadric;
sub default_quadric { $default_quadric //= OpenGL::Sandbox::V1::Quadric->new }
sub cylinder { default_quadric->cylinder(@_) }
lib/OpenGL/Sandbox/V1.pm view on Meta::CPAN
sub disk { default_quadric->disk(@_) }
sub partial_disk { default_quadric->partial_disk(@_) }
END { undef $default_quadric; } # cleanup before global destruction
sub compile_list(&) { OpenGL::Sandbox::V1::DisplayList->new->compile(shift); }
BEGIN { *call_list= *_displaylist_call; }
sub setup_sunlight {
view release on metacpan or search on metacpan
lib/OpenTracing/DSL.pm view on Meta::CPAN
If the block of code throws an exception, that'll cause the span to be
marked as an error.
=cut
sub trace(&;@) {
my ($code, %args) = @_;
$args{operation_name} //= 'unknown';
my $span = $tracer->span(%args);
try {
return $code->($span);
view release on metacpan or search on metacpan
t/dat/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/Orochi/Declare.pm view on Meta::CPAN
}
}
}
our $__CONTAINER;
sub container(&) {
my $c = Orochi->new();
{
local $__CONTAINER = $c;
$_[0]->();
}
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
#############################################################################
our $hold_updates;
our @held_updates;
sub hold_updates(&;@) {
local $hold_updates = $hold_updates + 1;
eval { &{+shift} };
# ALWAYS broadcast updates, even if we are deeply nested
if (@held_updates) {
sql_exec "unlock tables";
die if $@;
}
sub gc_find_instances_by_id(&@) {
my ($cb, @seed) = @_;
while (@seed) {
$cb->(@seed);
%PApp::temporary = ();
PApp::Event::check;
}
sub agni_exec(&) {
my $cb = shift;
local $PApp::SQL::Database = $PApp::Config::Database;
local $PApp::SQL::DBH;
local %PApp::state;
view release on metacpan or search on metacpan
my ( $got, $exp, $label ) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
is( unpack( "H*", $got ), unpack( "H*", $exp ), $label );
}
sub exception(&) {
my $code = shift;
eval { $code->() };
return $@;
}
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
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
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
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/POE/Declarative.pm view on Meta::CPAN
on _start => sub { ... };
=cut
sub run(&) { $_[0] }
=head1 HELPERS
In addition to providing the declarative syntax the system also provides some helpers to shorten up the guts of your POE applications as well.