view release on metacpan or search on metacpan
t/lib/TestHelper.pm view on Meta::CPAN
sub init {
main::__tests__();
}
sub guard(&) {
my $code = shift;
bless $code, 'Devel::Chitin::TestHelper::Guard';
}
sub Devel::Chitin::TestHelper::Guard::DESTROY {
my $code = shift;
t/lib/TestHelper.pm view on Meta::CPAN
};
};
push @TEST_QUEUE, $test;
}
sub do_test(&) {
push @TEST_QUEUE, shift();
}
sub is_var_at_level {
my($var_expr, $level, $expected, $msg) = @_;
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
}
use Devel::Declare;
BEGIN {
sub fun(&) {}
Devel::Declare->setup_for(
__PACKAGE__,
{ fun => { const => \&handle_fun } }
);
view release on metacpan or search on metacpan
lib/Devel/Decouple.pm view on Meta::CPAN
my %map = map { $_ => $code } @{$functions};
return %map, %args;
}
sub as(&) {
return shift;
}
sub default_sub() {
return '_DEFAULT_';
view release on metacpan or search on metacpan
use Test::Requires 'DBI', 'Test::mysqld';
use Devel::KYTProf;
local $ENV{ANSI_COLORS_DISABLED} = 1;
sub prof(&) {
my $code = shift;
my $buffer = '';
open my $fh, '>', \$buffer or die "Could not open in-memory buffer";
local *STDERR = $fh;
$code->();
view release on metacpan or search on metacpan
lib/Devel/LeakGuard/Object.pm view on Meta::CPAN
=cut
use Devel::Peek;
sub leakguard(&@) {
my $block = shift;
my $leakstate = Devel::LeakGuard::Object::State->new( @_ );
$block->();
$leakstate->done();
return;
view release on metacpan or search on metacpan
t/10commands.t view on Meta::CPAN
my ( $fmt, @args ) = @_;
$output .= sprintf $fmt, @args;
}
}
sub output_matches_ok(&$$)
{
my ( $code, $want, $name ) = @_;
$output = "";
$code->();
view release on metacpan or search on metacpan
t/10commands.t view on Meta::CPAN
my ( $fmt, @args ) = @_;
$output .= sprintf $fmt, @args;
}
}
sub output_matches_ok(&$$)
{
my ( $code, $want, $name ) = @_;
$output = "";
$code->();
view release on metacpan or search on metacpan
t/50cmd-print-table.t view on Meta::CPAN
use Test2::V0;
use Devel::MAT;
sub lines_from(&)
{
my ( $code ) = @_;
my @lines;
view release on metacpan or search on metacpan
t/Memalyzer.t view on Meta::CPAN
unlink( 't/test_out' ); #Do not care about errors.
unlink( 't/test_out.raw' ); #Do not care about errors.
unlink( 't/test_out.head' ); #Do not care about errors.
}
sub fork_do(&) {
my $pid = fork();
unless ( $pid ) {
shift->();
exit;
}
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/Devel/Valgrind/Client.pm view on Meta::CPAN
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(is_in_memcheck count_leaks do_leak_check do_quick_leak_check leak_check);
sub leak_check(&) {
my $code = shift;
do_quick_leak_check();
my $start = count_leaks();
view release on metacpan or search on metacpan
t/15-debugger.t view on Meta::CPAN
use Config;
use POSIX qw/:sys_wait_h raise SIGSEGV/;
plan(skip_all => 'no fork') if not $Config{d_fork};
sub check_segv(&@);
my $raised = $^O eq 'darwin' ? qr/Signal with unknown cause or source/ : qr/Signal sent by kill\(\)(?: \[.*?\])?/;
my $address_not_mapped = qr/Address not mapped to object \[.*?\]/s;
check_segv { raise(SIGSEGV) } $raised, 'Got stacktrace on raise';
t/15-debugger.t view on Meta::CPAN
check_segv { eval 'package Regexp; use overload q{""} => sub { qr/$_[0]/ }; "".qr//' } $address_not_mapped, "Got stacktrace on overload recursion" if $] < 5.017;
#check_segv { local @INC = sub { require $_[0] }; require ExtUtils::Embed } $address_not_mapped, 'Require stack overflows';
done_testing;
sub check_segv(&@) {
my ($sub, $extra, $message) = @_;
pipe my $in, my $out or die "Can't pipe: $!";
my $pid = fork;
die "Can't fork: $!" if not defined $pid;
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/Dir/Iterate.pm view on Meta::CPAN
given path(s). The full path to the object is in $_. The return value or
values of the block are collected together and returned in a list.
=cut
sub mapdir(&@) {
my($closure, @paths) = @_;
my @results;
File::Find::find(
lib/Dir/Iterate.pm view on Meta::CPAN
given path(s). The full path to the object is in $_. If the return value of
the block is true, the full path will be in the list returned by the method.
=cut
sub grepdir(&@) {
my $predicate = shift;
unshift @_, sub { $predicate->() ? $_ : () };
goto &mapdir;
}
view release on metacpan or search on metacpan
lib/Dist/Banshee/Core.pm view on Meta::CPAN
$arch->write($file, &Archive::Tar::COMPRESS_GZIP, $name);
return $file;
}
sub in_tempdir(&) {
my ($code) = @_;
local $CWD = tempdir(CLEANUP => 1);
$code->();
}
view release on metacpan or search on metacpan
lib/Dist/Zilla/Plugin/Author/KENTNL/RecommendFixes.pm view on Meta::CPAN
my ( $orig, $self, @args ) = @_;
return $self->$orig( map { ref $_ ? $_ : colored( [$LOG_COLOR], $_ ) } @args );
};
## no critic (Subroutines::ProhibitSubroutinePrototypes,Subroutines::RequireArgUnpacking,Variables::ProhibitLocalVars)
sub _is_bad(&) { local $LOG_COLOR = 'red'; return $_[0]->() }
sub _badly(&) {
my $code = shift;
return sub { local $LOG_COLOR = 'red'; return $code->(@_); };
}
## use critic
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/perl-5-14-package.t view on Meta::CPAN
use Path::Tiny qw( path );
use Test::DZil qw( simple_ini Builder );
use Module::Metadata 1.000022;
sub nofail(&) {
my $code = shift;
return is( exception { $code->() }, undef, "Contained Code should not fail" );
}
my $test_config = [
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
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
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/diagnostics/main-module.t view on Meta::CPAN
my $t = Builder->from_config( { dist_root => $root }, { add_files => { 'source/dist.ini' => simple_ini(@_) } } );
$t->build;
return $t;
}
sub testeval(&&) {
my ( $evaler, $testcode ) = @_;
local $@;
eval { $evaler->(); };
my $lasterror = $@;
$lasterror = undef if $lasterror eq "";
view release on metacpan or search on metacpan
App-Domain-1.230280/_Deparsed_XSubs.pm view on Meta::CPAN
sub SvREFCNT(\[$%@];$) ;
sub V;
sub hv_clear_placeholders(\%) ;
}
package List::Util {
sub all(&@) ;
sub any(&@) ;
sub first(&@) ;
sub head($@) ;
sub max(@) ;
sub maxstr(@) ;
sub mesh;
sub mesh_longest;
sub mesh_shortest;
sub min(@) ;
sub minstr(@) ;
sub none(&@) ;
sub notall(&@) ;
sub pairfirst(&@) ;
sub pairgrep(&@) ;
sub pairkeys(@) ;
sub pairmap(&@) ;
sub pairs(@) ;
sub pairvalues(@) ;
sub product(@) ;
sub reduce(&@) ;
sub reductions(&@) ;
sub sample($@) ;
sub shuffle(@) ;
sub sum(@) ;
sub sum0(@) ;
sub tail($@) ;
App-Domain-1.230280/_Deparsed_XSubs.pm view on Meta::CPAN
package Specio::Constraint::Role::CanType {
sub blessed($) ;
sub dclone($) ;
}
package Specio::Constraint::Role::Interface {
sub all(&@) ;
sub any(&@) ;
sub first(&@) ;
}
package Specio::Constraint::Role::IsaType {
sub blessed($) ;
sub dclone($) ;
}
package Specio::Constraint::Union {
sub all(&@) ;
sub any(&@) ;
sub dclone($) ;
}
package Specio::Exception {
sub blessed($) ;
}
package Specio::Helpers {
sub blessed($) ;
sub perlstring;
}
package Specio::OO {
sub all(&@) ;
sub dclone($) ;
sub perlstring;
sub weaken($) ;
}
package Specio::PartialDump {
view release on metacpan or search on metacpan
lib/ETL/Yertl/Util.pm view on Meta::CPAN
#pod none match
#pod
#pod =cut
# This duplicates List::Util firstidx, but this is not included in Perl 5.10
sub firstidx(&@) {
my $code = shift;
for my $i ( 0 .. @_ ) {
local $_ = $_[ $i ];
return $i if $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
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
$_[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 {