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/util.pl  view on Meta::CPAN

# convenience functions for our tests

use Errno qw(ENOSYS);

sub is_implemented(&) {
	my $block = shift;
	local $! = 0;
	&$block;
	return $! != &ENOSYS;
}

 view release on metacpan or  search on metacpan

lib/POSIX/bsearch.pm  view on Meta::CPAN

@EXPORT = qw( bsearch );

$VERSION = '0.02';


sub bsearch(&$\@){
 # warn "in bsearch with args [@_]";
 my $comparator = shift;
 my ($ca,$cb);
 {
   no strict 'refs';

 view release on metacpan or  search on metacpan

lib/PPIx/DocumentName.pm  view on Meta::CPAN

our $VERSION = '1.01'; # VERSION

use PPI::Util qw( _Document );


sub log_info(&@);
sub log_debug(&@);
sub log_trace(&@);

my %callers;

BEGIN {
  if ( $INC{'Log/Contextual.pm'} ) {

 view release on metacpan or  search on metacpan

t/qr_combine.t  view on Meta::CPAN

use PPR::X;
use re 'eval';
use warnings FATAL => 'regexp';

sub lives_ok(&;$) {
    if ($] >= 5.018 && $] <= 5.030) {
        pass "SKIP: $_[1]  (known regex bug in Perl $])";
        return;
    }

 view release on metacpan or  search on metacpan

t/M08-const_scalar.t  view on Meta::CPAN

        DerivedConst->pkg_const_inheritable('$d' => 'DDD'); # was non const, becomes const
    }

package main;

sub throws_ok(&$$);
sub lives_ok(&$);

is($TestConst::b,    'bbb', "Checking non const value");
is($TestConst::a,    'aaa', "Checking const value");
is($DerivedConst::b, 'bbb', "Checking derived non const value");
is($DerivedConst::a, 'aaa', "Checking derived const value");

t/M08-const_scalar.t  view on Meta::CPAN

######################################################################
# TEST UTILITIES

# throws_ok { $foo->method3 } qr/division by zero/, 'zero caught okay';
sub throws_ok(&$$) {
    my ($code, $rexp, $message) = @_;

    eval {
        $code->();
    };

t/M08-const_scalar.t  view on Meta::CPAN

    }

}

# lives_ok { $foo->method3 } qr/division by zero/, 'zero caught okay';
sub lives_ok(&$) {
    my ($code, $message) = @_;

    eval {
        $code->();
    };

 view release on metacpan or  search on metacpan

t/01-01-nostrictures.t  view on Meta::CPAN

use Test::Fatal;
use B::Deparse;
use FindBin;
use lib "$FindBin::Bin/01-poc-lib";

sub lives_and_is(&$$) {
  my ( $code, $expect, $desc ) = @_;
  my $result = exception {
    is( $code->(), $expect, $desc );
  };
  if ($result) {

 view release on metacpan or  search on metacpan

maint-travis-ci/lib/tools.pm  view on Meta::CPAN

  $_[0] ||= 'META.json';
  require CPAN::Meta;
  return CPAN::Meta->load_file( $_[0] );
}

sub capture_stdout(&) {
  require Capture::Tiny;
  goto &Capture::Tiny::capture_stdout;
}

sub import {

 view release on metacpan or  search on metacpan

t/binmode.t  view on Meta::CPAN

use Test::More;
use Pandoc;

use utf8; # essential!

sub capture_stderr(&;@);

plan skip_all => 'pandoc executable required' unless pandoc;
plan skip_all => 'Capture::Tiny required'
    unless eval 'use Capture::Tiny qw(capture_stderr); 1;';

 view release on metacpan or  search on metacpan

lib/Parallel/WorkUnit/Procedural.pm  view on Meta::CPAN

    $wu = Parallel::WorkUnit->new() if !defined($wu);
    return $wu;
}


sub async(&;&) { return WorkUnit->async(@_) }


sub asyncs { return WorkUnit->asyncs(@_) }

lib/Parallel/WorkUnit/Procedural.pm  view on Meta::CPAN

sub queueall { return WorkUnit->queueall(@_) }


sub start(&) { return WorkUnit->start(@_) }

1;

__END__

 view release on metacpan or  search on metacpan

lib/Parallel/parallel_map.pm  view on Meta::CPAN

our @EXPORT = qw(parallel_map);

our $INIT_DATA_PROCESSOR; # has to be code ref

sub parallel_map(&@) {
    my ($code,@input) = @_;
    my (@result,@output);
    if (wantarray) {
        @output = (output=>sub {my ($r,$i) = @_;$result[$i] = $r;});
    }

 view release on metacpan or  search on metacpan

lib/Params/PatternMatch.pm  view on Meta::CPAN

our $VERSION = '0.01';

our @args;

sub as(&) { @_ }

sub case {
  my $action = pop;
  Carp::croak('Not a CodeRef.') if ref $action ne 'CODE';

lib/Params/PatternMatch.pm  view on Meta::CPAN

  } catch ($error) {
    die $error;
  };
}

sub otherwise(&) {
  Carp::croak('Not a CodeRef.') if ref $_[0] ne 'CODE';
  die Params::PatternMatch::Values->new($_[0]->(@args));
}

sub rest(\@) { Params::PatternMatch::SlurpArg->new($_[0]) }

sub then(&) { @_ }

package Params::PatternMatch::SlurpArg;

sub new { bless $_[1] => $_[0] }

 view release on metacpan or  search on metacpan

lib/Parse/Eyapp/Base.pm  view on Meta::CPAN

}
use base qw(Exporter);

our $FILENAME=__FILE__;

sub firstval(&@) {
  my $handler = shift;
  
  return (grep { $handler->($_) } @_)[0]
}

sub lastval(&@) {
  my $handler = shift;
  
  return (grep { $handler->($_) } @_)[-1]
}

# Receives a handler $h and a list @_
# Elements of @_ with the same value of $h go to the same sublist
# Returns a list of lists
sub part(&@) {
  my $h = shift;

  my @p;
  push @{$p[$h->($_)]}, $_ for (@_);
  return @p;

 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/Parse/Token/Lite/Builder.pm  view on Meta::CPAN

*_start = sub{ croak 'start'; };
*_end = sub{ croak 'end'; };

sub on($&){ goto &_on };
sub name($){ goto &_name };
sub with(&){ goto &_with };
sub match($&){ goto &_match };
sub start($){ goto &_start };
sub end($){ goto &_end };

sub ruleset(&){
	my $rules = {};
	my $code = shift;

	local *_match = sub($&){
		my ($pat, $code) = @_;

 view release on metacpan or  search on metacpan

t/12-many.t  view on Meta::CPAN

            is $_[1], "C", "TestVar: arg1";
        }
    }
];

sub run_tests(&)
{
    my $code = shift;
    # Run the test 2 times to check there is no state kept
    for my $i (1..2) {
	local $count = 0;

 view release on metacpan or  search on metacpan

t/lib/winfail.pm  view on Meta::CPAN

my $expect_undef;

sub will_win($)  { $will_reason = $_[0]; $expect_undef = 1 }
sub will_fail($) { $will_reason = $_[0]; $expect_undef = undef }

sub t(&) {
  my $result = &exception( $_[0] );
  if ( $ENV{TRACE_EXCEPTIONS} ) {
    note $result if defined $result;
  }
  if ($expect_undef) {

 view release on metacpan or  search on metacpan

t/lib/TestUtils.pm  view on Meta::CPAN

        open my $fh, ">", "foo";
        return eval { symlink "foo", "bar" };
    }
}

sub exception(&) {
    my $code    = shift;
    my $success = eval { $code->(); 1 };
    my $err     = $@;
    return '' if $success;
    croak "Execution died, but the error was lost" unless $@;

 view release on metacpan or  search on metacpan

t/01_perl_build_built.t  view on Meta::CPAN

use warnings;

use Test::More;
use Perl::Build::Built;

sub exception(&) {
    my $code       = shift;
    my $prev_error = $@;
    my ( @ret, $error, $failed );
    {
        local $@;

 view release on metacpan or  search on metacpan

lib/Perl/Tokenizer.pm  view on Meta::CPAN

    /x;
#>>>

my $perl_filetests = qr/\-[ABCMORSTWXbcdefgkloprstuwxz]/;

sub perl_tokens(&$) {
    my ($callback, $code) = @_;

    ref($callback) eq 'CODE'
      or die "usage: perl_tokens {...} \$code;";

 view release on metacpan or  search on metacpan

lib/Perl6/Gather.pm  view on Meta::CPAN

our $VERSION = '0.42';

my %gatherers;

sub gather(&) is export(:DEFAULT) {
	croak "Useless use of 'gather' in void context" unless defined wantarray;
	my ($code) = @_;
	my $caller = caller;
	local @_;
	push @{$gatherers{$caller}}, bless \@_, 'Perl6::Gather::MagicArrayRef';

 view release on metacpan or  search on metacpan

lib/Perl6/GatherTake.pm  view on Meta::CPAN

use Scalar::Util qw(refaddr);
our @EXPORT = qw(gather take);

our %_coro_to_queue;

sub gather(&@) {
    my $code = shift;
    # cheat prototype by prepending '&' to method call:
    my $coro = &async($code, @_);
    my @result = ();
    my $queue = Coro::Channel->new(1);

 view release on metacpan or  search on metacpan

misc/pX/Common/lrep-compiler/Runtime/RuleCompiler.pm  view on Meta::CPAN

    my $code = shift;
    my ($grammar) = caller;
    bless { code => $code, grammar => $grammar }, $class;
}

sub rule(&) {
    my $rule = shift;
    return Runtime::RuleCompiler->compiled(sub {
       	my $grammar = shift;
	my $tree;
	print Dumper($rule->($grammar)->( $_[0], undef, $tree, $tree )) if $ENV{DEBUG_lrep};

 view release on metacpan or  search on metacpan

bin/bc  view on Meta::CPAN

my $yystate;
my $yyval;
my $yyvsp;

my $debug = 0;
sub debug(&) {
  my $fn = shift;
  print STDERR "\t".&$fn()
    if $debug;
}

 view release on metacpan or  search on metacpan

lib/PerlX/ifor.pm  view on Meta::CPAN

use warnings;

use Exporter qw(import);
our @EXPORT = qw(ifor);

sub ifor(&$) {
    my ($code, $iterator) = @_;

    if (ref $iterator eq 'CODE') {
        local $_;
        while (defined($_ = $iterator->())) {

 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/Perlito5X/Test2/API.pm  view on Meta::CPAN

sub _context_release_callbacks_ref { $INST->context_release_callbacks }

# 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/Perlito5X/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/Perlito5X/Test2/API.pm  view on Meta::CPAN

sub release($;$) {
    $_[0]->release;
    return $_[1];
}

sub intercept(&) {
    my $code = shift;

    my $ctx = context();

    my $ipc;

 view release on metacpan or  search on metacpan

lib/Pinwheel/Database.pm  view on Meta::CPAN

{
    croak "No database configured" unless ($backend);
    return $backend->do(@_);
}

sub without_foreign_keys(&)
{
    croak "No database configured" unless ($backend);
    return $backend->without_foreign_keys(@_);
}

 view release on metacpan or  search on metacpan

lib/Plack/Builder.pm  view on Meta::CPAN

our $_add = our $_add_if = our $_mount = sub {
    Carp::croak("enable/mount should be called inside builder {} block");
};

sub enable         { $_add->(@_) }
sub enable_if(&$@) { $_add_if->(@_) }

sub mount {
    my $self = shift;
    if (Scalar::Util::blessed($self)) {
        $self->_mount(@_);
    }else{
        $_mount->($self, @_);
    }
}

sub builder(&) {
    my $block = shift;

    my $self = __PACKAGE__->new;

    my $mount_is_called;