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
t/lib/Test/Win32/Unicode/Util.pm view on Meta::CPAN
sub tempdir {
File::Temp::tempdir(CLEANUP => 1, @_);
}
sub safe_dir(&) {
my $code = shift;
my $cwd = Cwd::getcwd;
my $tmpdir = tempdir();
view release on metacpan or search on metacpan
t/Tests_Helper.pm view on Meta::CPAN
undef *{$name};
*{$name} = sub { &$code; goto &$old };
}
}
sub test_override(&$) {
my( $code, $method ) = @_;
my $called = 0;
local $Test::Builder::Level = $Test::Builder::Level + 1;
hijack( $method => sub { $called = 1 } );
view release on metacpan or search on metacpan
t/MyTest.pm view on Meta::CPAN
$lc->SetItem( $r - 1, $c - 1, "(R$r, C$c)" );
}
}
}
sub test(&) {
MyApp->new;
&{$_[0]}( $frame );
$frame->Destroy;
}
view release on metacpan or search on metacpan
t/03_threads.t view on Meta::CPAN
Wx::InitAllImageHandlers;
my @tocheck;
sub check_init(&) {
my( $code ) = @_;
push @tocheck, [ $code->(), $code->() ];
}
sub check_undef {
view release on metacpan or search on metacpan
t/Tests_Helper.pm view on Meta::CPAN
undef *{$name};
*{$name} = sub { &$code; goto &$old };
}
}
sub test_override(&$) {
my( $code, $method ) = @_;
my $called = 0;
local $Test::Builder::Level = $Test::Builder::Level + 1;
hijack( $method => sub { $called = 1 } );
view release on metacpan or search on metacpan
t/70-compositor.t view on Meta::CPAN
my $ext= glXQueryExtensionsString($client);
plan skip_all => 'GLX_EXT_texture_from_pixmap not supported by server'
unless $ext =~ /GLX_EXT_texture_from_pixmap/;
sub err(&) { my $code= shift; my $ret; { local $@= ''; eval { $code->() }; $client->flush_sync; $ret= $@; } $ret }
my ($root, $overlay, $region);
note "local Xc ver = ".X11::Xlib::XCompositeVersion." server Xc ver = ".join('.', $client->XCompositeQueryVersion);
is( err{ $root= $client->root_window }, '', 'get root window' );
note "root = ".$root->summarize;
view release on metacpan or search on metacpan
t/20-xevent.t view on Meta::CPAN
use strict;
use warnings;
use Test::More tests => 4;
use_ok('X11::Xlib::XEvent') or die;
sub err(&) { my $code= shift; my $ret; { local $@= ''; eval { $code->() }; $ret= $@; } $ret }
subtest blank_event => sub {
# Create a new XEvent (defaults to XErrorEvent)
my $blank_event= new_ok( 'X11::Xlib::XEvent', [], 'blank event' );
ok( defined $blank_event->buffer, 'buffer is defined' );
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/optimize.t view on Meta::CPAN
use lib 't/lib'; use MyTest;
use Test::More;
my $RUNS = 3;
sub test_call(&) {
my $code = shift;
my $m1 = MyTest::marker();
$code->();
my $m2 = MyTest::marker();
my $d = $m2 - ($m1 + 2);
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/XML/Easy/ProceduralWriter.pm view on Meta::CPAN
}
}, "UTF-16BE");
=cut
sub xml_element(&) {
# create a temporary place to store whatever we're putting
local @XML::Easy::ProceduralWriter::stuff = ();
shift->();
lib/XML/Easy/ProceduralWriter.pm view on Meta::CPAN
encoded representation of the character representation of the string (i.e. this is
what you want to use to create something you can pass to C<print>)
=cut
sub xml_bytes(&) {
my $data = shift;
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
return xml10_write_document(&xml_element($data), "UTF-8"); ## no critic Subroutines::ProhibitAmpersandSigils
}
push @EXPORT, "xml_bytes";
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/05-wrongs.t view on Meta::CPAN
or *dd = \&explain;
}
use XML::Fast 'xml2hash';
sub dies_ok(&;@) {
my $code = shift;
my $name = pop || 'line '.(caller)[2];
my $qr = shift;
local $@;
if( eval { $code->(); 1} ) {
view release on metacpan or search on metacpan
use lib 'lib';
use Test::More;
use XML::LibXML::jQuery;
sub test(&@);
my $html = '<div class="container"><h2>Greetings</h2><div class="inner">Hello</div><div class="inner">Goodbye</div></div>';
# before(html)
test { $_->find('h2, .inner')->before('<p/>') } 'before(html)';
view release on metacpan or search on metacpan
#-------------------------------------------------------------------------#
# callback functions #
#-------------------------------------------------------------------------#
sub externalEntityLoader(&)
{
return _externalEntityLoader($_[0]);
}
sub input_callbacks {
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
}
}
# used to solve the [n] predicates while avoiding getting the entire list
# needs a prototype to accept passing bare blocks
sub _first_n(&$@) ## no critic (Subroutines::ProhibitSubroutinePrototypes);
{ my $coderef= shift;
my $n= shift;
my $i=0;
if( $n > 0)
{ foreach (@_) { if( &$coderef) { $i++; return $_ if( $i == $n); } } }
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;
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
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/ZMQ/Declare/DSL.pm view on Meta::CPAN
Carp::croak("Wrongly nested or out-of-place '$function' detected: You cannot nest ZDCF '${function}'s")
if ($global_state_var_ref && $$global_state_var_ref)
or $CurScope ne $expected_scope;
}
sub declare_zdcf(&) {
local $ZDCF = {version => "1.0"};
local $CurScope = 'zdcf';
# Clear the various components in this dynamic scope
local $App;
local $Context;
lib/ZMQ/Declare/DSL.pm view on Meta::CPAN
local $Socket;
$_[0]->();
return ZMQ::Declare::ZDCF->new(tree => $ZDCF);
}
sub app(&) {
_check_scope('zdcf', \$App);
local $CurScope = 'app';
local $App = {};
$_[0]->();
lib/ZMQ/Declare/DSL.pm view on Meta::CPAN
my $name = delete $App->{name};
Carp::croak("Missing app name!") if not defined $name;
$ZDCF->{apps}{$name} = $App;
}
sub context(&) {
_check_scope('app' => \$Context);
local $Context = {};
local $CurScope = 'context';
$_[0]->();
lib/ZMQ/Declare/DSL.pm view on Meta::CPAN
sub iothreads($) {
_check_scope('context');
$Context->{iothreads} = $_[0];
}
sub device(&) {
_check_scope('app' => \$Device);
local $Device = {};
local $CurScope = 'device';
$_[0]->();
lib/ZMQ/Declare/DSL.pm view on Meta::CPAN
elsif ($CurScope eq 'device') { $Device->{type} = shift }
elsif ($CurScope eq 'socket') { $Socket->{type} = shift }
else { Carp::croak("Error 'type()' outside device, and socket") }
}
sub sock(&) {
_check_scope('device' => \$Socket);
local $Socket = {};
local $CurScope = 'socket';
$_[0]->();
view release on metacpan or search on metacpan
lib/Zero/Emulator.pm view on Meta::CPAN
sub AssertTrue($%) #i Assert true.
{my ($a, %options) = @_; # Source operand
Assert1("True", $a);
}
sub Bad(&) #i A bad ending.
{my ($bad) = @_; # What to do on a bad ending
@_ == 1 or confess "One parameter";
(bad=> $bad)
}
sub Block(&%) #i Block of code that can either be restarted or come to a good or a bad ending.
{my ($block, %options) = @_; # Block, options
my ($Start, $Good, $Bad, $End) = (label, label, label, label);
my $g = $options{good};
my $b = $options{bad};
lib/Zero/Emulator.pm view on Meta::CPAN
sub Dump() #i Dump all the arrays currently in memory.
{$assembly->instruction(action=>"dump");
}
sub Else(&) #i Else block.
{my ($e) = @_; # Else block subroutine
@_ == 1 or confess "One parameter";
(else=> $e)
}
sub Execute(%) #i Execute the current assembly.
{my (%options) = @_; # Options
$assembly->execute(%options); # Execute the code in the current assembly
}
sub For(&$%) #i For loop 0..range-1 or in reverse.
{my ($block, $range, %options) = @_; # Block, limit, options
if (!exists $options{reverse}) # Ascending order
{my $s = 0; my $e = $range; # Start, end
($s, $e) = @$range if ref($e) =~ m(ARRAY); # Start, end as a reference
lib/Zero/Emulator.pm view on Meta::CPAN
Jmp $Check;
setLabel($End); # End
}
}
sub ForArray(&$$%) #i For loop to process each element of the named area.
{my ($block, $area, $name, %options) = @_; # Block of code, area, area name, options
my $e = ArraySize $area, $name; # End
my $s = 0; # Start
my ($Start, $Check, $Next, $End) = (label, label, label, label);
lib/Zero/Emulator.pm view on Meta::CPAN
{my ($target, $source) = @_; # Target area yielding the id of the area to be freed, source area yielding the name of the area to be freed
my $n = $assembly->ArrayNameToNumber($source);
$assembly->instruction(action=>"free", xTarget($target), xSource($n));
}
sub Good(&) #i A good ending.
{my ($good) = @_; # What to do on a good ending
@_ == 1 or confess "One parameter";
(good=> $good)
}
lib/Zero/Emulator.pm view on Meta::CPAN
sub Tally($) #i Counts instructions when enabled.
{my ($source) = @_; # Tally instructions when true
$assembly->instruction(action=>"tally", xSource($source));
}
sub Then(&) #i Then block.
{my ($t) = @_; # Then block subroutine
@_ == 1 or confess "One parameter";
(then=> $t)
}
view release on metacpan or search on metacpan
local/lib/perl5/List/MoreUtils/PP.pm view on Meta::CPAN
$f->() and $found++ and return 0;
}
return $found;
}
sub reduce_u(&@)
{
my $code = shift;
# Localise $a, $b
my ($caller_a, $caller_b) = do
local/lib/perl5/List/MoreUtils/PP.pm view on Meta::CPAN
}
return ${*$caller_a};
}
sub reduce_0(&@)
{
my $code = shift;
# Localise $a, $b
my ($caller_a, $caller_b) = do
local/lib/perl5/List/MoreUtils/PP.pm view on Meta::CPAN
}
return ${*$caller_a};
}
sub reduce_1(&@)
{
my $code = shift;
# Localise $a, $b
my ($caller_a, $caller_b) = do
local/lib/perl5/List/MoreUtils/PP.pm view on Meta::CPAN
my @parts;
push @{$parts[$code->($_)]}, $_ foreach @list;
return @parts;
}
sub bsearch(&@)
{
my $code = shift;
my $rc;
my $i = 0;
local/lib/perl5/List/MoreUtils/PP.pm view on Meta::CPAN
} until $i > $j;
return;
}
sub bsearchidx(&@)
{
my $code = shift;
my $rc;
my $i = 0;
local/lib/perl5/List/MoreUtils/PP.pm view on Meta::CPAN
} until $i > $j;
return -1;
}
sub lower_bound(&@)
{
my $code = shift;
my $count = @_;
my $first = 0;
while ($count > 0)
local/lib/perl5/List/MoreUtils/PP.pm view on Meta::CPAN
}
return $first;
}
sub upper_bound(&@)
{
my $code = shift;
my $count = @_;
my $first = 0;
while ($count > 0)
local/lib/perl5/List/MoreUtils/PP.pm view on Meta::CPAN
}
return $first;
}
sub equal_range(&@)
{
my $lb = &lower_bound(@_);
my $ub = &upper_bound(@_);
return ($lb, $ub);
}
local/lib/perl5/List/MoreUtils/PP.pm view on Meta::CPAN
{
my $lb = &lower_bound($_[0], @{$_[1]});
return splice @{$_[1]}, $lb, 1;
}
sub qsort(&\@)
{
require Carp;
Carp::croak("It's insane to use a pure-perl qsort");
}
sub slide(&@)
{
my $op = shift;
my @l = @_;
## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
local/lib/perl5/List/MoreUtils/PP.pm view on Meta::CPAN
return $n >= 0
? sub { my @r = splice @list, 0, $m; $#list < $n and $n = $#list; @r and push @r, (@list ? @list[0 .. $n] : ()); return @r; }
: sub { return splice @list, 0, $m; };
}
sub sort_by(&@)
{
my ($code, @list) = @_;
return map { $_->[0] }
sort { $a->[1] cmp $b->[1] }
map { [$_, scalar($code->())] } @list;
}
sub nsort_by(&@)
{
my ($code, @list) = @_;
return map { $_->[0] }
sort { $a->[1] <=> $b->[1] }
map { [$_, scalar($code->())] } @list;
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);