Acme-Albed
view release on metacpan or search on metacpan
Changes
inc/Module/Install.pm
inc/Module/Install/AuthorTests.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Include.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/TestBase.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
inc/Spiffy.pm
inc/Test/Base.pm
inc/Test/Base/Filter.pm
inc/Test/Builder.pm
inc/Test/Builder/Module.pm
inc/Test/More.pm
lib/Acme/Albed.pm
Makefile.PL
MANIFEST This list of files
META.yml
README
t/00_compile.t
t/01_dict.t
xt/01_podspell.t
xt/02_perlcritic.t
xt/03_pod.t
---
abstract: 'Convert from/to Albedian.'
author:
- 'haoyayoi <st.hao.yayoi@gmail.com>'
build_requires:
ExtUtils::MakeMaker: 6.42
Test::More: 0
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
generated_by: 'Module::Install version 0.91'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: Acme-Albed
no_index:
Makefile.PL view on Meta::CPAN
use inc::Module::Install;
name 'Acme-Albed';
all_from 'lib/Acme/Albed.pm';
requires 'Any::Moose';
tests 't/*.t';
author_tests 'xt';
build_requires 'Test::More';
use_test_base;
auto_include;
WriteAll;
inc/Module/Install/AuthorTests.pm view on Meta::CPAN
#line 1
package Module::Install::AuthorTests;
use 5.005;
use strict;
use Module::Install::Base;
use Carp ();
#line 16
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
inc/Module/Install/TestBase.pm view on Meta::CPAN
#line 1
package Module::Install::TestBase;
use strict;
use warnings;
use Module::Install::Base;
use vars qw($VERSION @ISA);
BEGIN {
$VERSION = '0.11';
@ISA = 'Module::Install::Base';
}
sub use_test_base {
my $self = shift;
$self->include('Test::Base');
$self->include('Test::Base::Filter');
$self->include('Spiffy');
$self->include('Test::More');
$self->include('Test::Builder');
$self->include('Test::Builder::Module');
$self->requires('Filter::Util::Call');
}
1;
=encoding utf8
#line 70
inc/Test/Base.pm view on Meta::CPAN
#line 1
# TODO:
#
package Test::Base;
use 5.006001;
use Spiffy 0.30 -Base;
use Spiffy ':XXX';
our $VERSION = '0.59';
my @test_more_exports;
BEGIN {
@test_more_exports = qw(
ok isnt like unlike is_deeply cmp_ok
skip todo_skip pass fail
eq_array eq_hash eq_set
plan can_ok isa_ok diag
use_ok
$TODO
);
}
use Test::More import => \@test_more_exports;
use Carp;
our @EXPORT = (@test_more_exports, qw(
is no_diff
blocks next_block first_block
delimiters spec_file spec_string
filters filters_delay filter_arguments
run run_compare run_is run_is_deeply run_like run_unlike
skip_all_unless_require is_deep run_is_deep
inc/Test/Base.pm view on Meta::CPAN
unless (grep /^-base$/i, @_) {
my @args;
for (my $ii = 1; $ii <= $#_; ++$ii) {
if ($_[$ii] eq '-package') {
++$ii;
} else {
push @args, $_[$ii];
}
}
Test::More->import(import => \@test_more_exports, @args)
if @args;
}
_strict_warnings();
goto &Spiffy::import;
}
# Wrap Test::Builder::plan
my $plan_code = \&Test::Builder::plan;
my $Have_Plan = 0;
{
no warnings 'redefine';
*Test::Builder::plan = sub {
$Have_Plan = 1;
goto &$plan_code;
};
}
my $DIED = 0;
$SIG{__DIE__} = sub { $DIED = 1; die @_ };
sub block_class { $self->find_class('Block') }
sub filter_class { $self->find_class('Filter') }
inc/Test/Base.pm view on Meta::CPAN
$self->_filters_map(shift);
}
else {
my $filters = $self->_filters;
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
}
sub have_text_diff {
eval { require Text::Diff; 1 } &&
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
not defined $expected or
$actual eq $expected or
not($self->have_text_diff) or
$expected !~ /\n./s
) {
Test::More::is($actual, $expected, $name);
}
else {
$name = '' unless defined $name;
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
inc/Test/Base.pm view on Meta::CPAN
}
sub END {
run_compare() unless $Have_Plan or $DIED or not $import_called;
}
sub run_compare() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
$block->run_filters unless $block->is_filtered;
if (ref $block->$x) {
is_deeply($block->$x, $block->$y,
$block->name ? $block->name : ());
}
elsif (ref $block->$y eq 'Regexp') {
my $regexp = ref $y ? $y : $block->$y;
like($block->$x, $regexp, $block->name ? $block->name : ());
inc/Test/Base.pm view on Meta::CPAN
else {
is($block->$x, $block->$y, $block->name ? $block->name : ());
}
}
}
sub run_is() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
$block->run_filters unless $block->is_filtered;
is($block->$x, $block->$y,
$block->name ? $block->name : ()
);
}
}
sub run_is_deeply() {
inc/Test/Base.pm view on Meta::CPAN
unlike($block->$x, $regexp,
$block->name ? $block->name : ()
);
}
}
sub skip_all_unless_require() {
(my ($self), @_) = find_my_self(@_);
my $module = shift;
eval "require $module; 1"
or Test::More::plan(
skip_all => "$module failed to load"
);
}
sub is_deep() {
(my ($self), @_) = find_my_self(@_);
require Test::Deep;
Test::Deep::cmp_deeply(@_);
}
sub run_is_deep() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
$block->run_filters unless $block->is_filtered;
is_deep($block->$x, $block->$y,
inc/Test/Base.pm view on Meta::CPAN
}
$_ = "use strict;use warnings;$data$end";
$done = 1;
}
);
}
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
tie $handle, 'Test::Base::Handle', $_[0];
}
sub no_diff {
$ENV{TEST_SHOW_NO_DIFFS} = 1;
}
package Test::Base::Handle;
sub TIEHANDLE() {
my $class = shift;
bless \ $_[0], $class;
}
sub PRINT {
$$self .= $_ for @_;
}
#===============================================================================
# Test::Base::Block
#
# This is the default class for accessing a Test::Base block object.
#===============================================================================
package Test::Base::Block;
our @ISA = qw(Spiffy);
our @EXPORT = qw(block_accessor);
sub AUTOLOAD {
return;
}
sub block_accessor() {
my $accessor = shift;
inc/Test/Base.pm view on Meta::CPAN
sub run_filters {
my $map = $self->_section_map;
my $order = $self->_section_order;
Carp::croak "Attempt to filter a block twice"
if $self->is_filtered;
for my $type (@$order) {
my $filters = $map->{$type}{filters};
my @value = $self->$type;
$self->original_values->{$type} = $value[0];
for my $filter ($self->_get_filters($type, $filters)) {
$Test::Base::Filter::arguments =
$filter =~ s/=(.*)$// ? $1 : undef;
my $function = "main::$filter";
no strict 'refs';
if (defined &$function) {
local $_ =
(@value == 1 and not defined($value[0])) ? undef :
join '', @value;
my $old = $_;
@value = &$function(@value);
if (not(@value) or
@value == 1 and defined($value[0]) and $value[0] =~ /\A(\d+|)\z/
) {
if ($value[0] && $_ eq $old) {
Test::Base::diag("Filters returning numbers are supposed to do munging \$_: your filter '$function' apparently doesn't.");
}
@value = ($_);
}
}
else {
my $filter_object = $self->blocks_object->filter_class->new;
die "Can't find a function or method for '$filter' filter\n"
unless $filter_object->can($filter);
$filter_object->current_block($self);
@value = $filter_object->$filter(@value);
inc/Test/Base.pm view on Meta::CPAN
else {
push @filters, $filter;
}
}
return @filters, @append;
}
{
%$reserved_section_names = map {
($_, 1);
} keys(%Test::Base::Block::), qw( new DESTROY );
}
__DATA__
=encoding utf8
#line 1376
inc/Test/Base/Filter.pm view on Meta::CPAN
#line 1
#. TODO:
#.
#===============================================================================
# This is the default class for handling Test::Base data filtering.
#===============================================================================
package Test::Base::Filter;
use Spiffy -Base;
use Spiffy ':XXX';
field 'current_block';
our $arguments;
sub current_arguments {
return undef unless defined $arguments;
my $args = $arguments;
$args =~ s/(\\s)/ /g;
inc/Test/Base/Filter.pm view on Meta::CPAN
$self->assert_scalar(@_);
my @return = CORE::eval(shift);
return $@ if $@;
return @return;
}
sub eval_all {
$self->assert_scalar(@_);
my $out = '';
my $err = '';
Test::Base::tie_output(*STDOUT, $out);
Test::Base::tie_output(*STDERR, $err);
my $return = CORE::eval(shift);
no warnings;
untie *STDOUT;
untie *STDERR;
return $return, $@, $out, $err;
}
sub eval_stderr {
$self->assert_scalar(@_);
my $output = '';
Test::Base::tie_output(*STDERR, $output);
CORE::eval(shift);
no warnings;
untie *STDERR;
return $output;
}
sub eval_stdout {
$self->assert_scalar(@_);
my $output = '';
Test::Base::tie_output(*STDOUT, $output);
CORE::eval(shift);
no warnings;
untie *STDOUT;
return $output;
}
sub exec_perl_stdout {
my $tmpfile = "/tmp/test-blocks-$$";
$self->_write_to($tmpfile, @_);
open my $execution, "$^X $tmpfile 2>&1 |"
inc/Test/Builder.pm view on Meta::CPAN
#line 1
package Test::Builder;
use 5.006;
use strict;
use warnings;
our $VERSION = '0.94';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
BEGIN {
if( $] < 5.008 ) {
require Test::Builder::IO::Scalar;
}
}
# Make Test::Builder thread-safe for ithreads.
BEGIN {
use Config;
# Load threads::shared when threads are turned on.
# 5.8.0's threads are so busted we no longer support them.
if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'} ) {
require threads::shared;
# Hack around YET ANOTHER threads::shared bug. It would
# occassionally forget the contents of the variable when sharing it.
# So we first copy the data, then share, then put our copy back.
inc/Test/Builder.pm view on Meta::CPAN
# 5.8.0's threads::shared is busted when threads are off
# and earlier Perls just don't have that module at all.
else {
*share = sub { return $_[0] };
*lock = sub { 0 };
}
}
#line 117
our $Test = Test::Builder->new;
sub new {
my($class) = shift;
$Test ||= $class->create;
return $Test;
}
#line 139
sub create {
my $class = shift;
my $self = bless {}, $class;
$self->reset;
inc/Test/Builder.pm view on Meta::CPAN
sub subtest {
my $self = shift;
my($name, $subtests) = @_;
if ('CODE' ne ref $subtests) {
$self->croak("subtest()'s second argument must be a code ref");
}
# Turn the child into the parent so anyone who has stored a copy of
# the Test::Builder singleton will get the child.
my $child = $self->child($name);
my %parent = %$self;
%$self = %$child;
my $error;
if( !eval { $subtests->(); 1 } ) {
$error = $@;
}
# Restore the parent and the copied child.
%$child = %$self;
%$self = %parent;
# Die *after* we restore the parent.
die $error if $error and !eval { $error->isa('Test::Builder::Exception') };
return $child->finalize;
}
#line 250
sub finalize {
my $self = shift;
inc/Test/Builder.pm view on Meta::CPAN
$self->_ending;
# XXX This will only be necessary for TAP envelopes (we think)
#$self->_print( $self->is_passing ? "PASS\n" : "FAIL\n" );
my $ok = 1;
$self->parent->{Child_Name} = undef;
if ( $self->{Skip_All} ) {
$self->parent->skip($self->{Skip_All});
}
elsif ( not @{ $self->{Test_Results} } ) {
$self->parent->ok( 0, sprintf q[No tests run for subtest "%s"], $self->name );
}
else {
$self->parent->ok( $self->is_passing, $self->name );
}
$? = $self->{Child_Error};
delete $self->{Parent};
return $self->is_passing;
}
inc/Test/Builder.pm view on Meta::CPAN
$self->is_passing(1);
$self->{Ending} = 0;
$self->{Have_Plan} = 0;
$self->{No_Plan} = 0;
$self->{Have_Output_Plan} = 0;
$self->{Original_Pid} = $$;
$self->{Child_Name} = undef;
$self->{Indent} ||= '';
share( $self->{Curr_Test} );
$self->{Curr_Test} = 0;
$self->{Test_Results} = &share( [] );
$self->{Exported_To} = undef;
$self->{Expected_Tests} = 0;
$self->{Skip_All} = 0;
$self->{Use_Nums} = 1;
$self->{No_Header} = 0;
$self->{No_Ending} = 0;
$self->{Todo} = undef;
$self->{Todo_Stack} = [];
$self->{Start_Todo} = 0;
$self->{Opened_Testhandles} = 0;
$self->_dup_stdhandles;
return;
}
#line 414
my %plan_cmds = (
no_plan => \&no_plan,
inc/Test/Builder.pm view on Meta::CPAN
#line 470
sub expected_tests {
my $self = shift;
my($max) = @_;
if(@_) {
$self->croak("Number of tests must be a positive integer. You gave it '$max'")
unless $max =~ /^\+?\d+$/;
$self->{Expected_Tests} = $max;
$self->{Have_Plan} = 1;
$self->_output_plan($max) unless $self->no_header;
}
return $self->{Expected_Tests};
}
#line 494
sub no_plan {
my($self, $arg) = @_;
$self->carp("no_plan takes no arguments") if $arg;
$self->{No_Plan} = 1;
inc/Test/Builder.pm view on Meta::CPAN
my($self, $num_tests) = @_;
# If done_testing() specified the number of tests, shut off no_plan.
if( defined $num_tests ) {
$self->{No_Plan} = 0;
}
else {
$num_tests = $self->current_test;
}
if( $self->{Done_Testing} ) {
my($file, $line) = @{$self->{Done_Testing}}[1,2];
$self->ok(0, "done_testing() was already called at $file line $line");
return;
}
$self->{Done_Testing} = [caller];
if( $self->expected_tests && $num_tests != $self->expected_tests ) {
$self->ok(0, "planned to run @{[ $self->expected_tests ]} ".
"but done_testing() expects $num_tests");
}
else {
$self->{Expected_Tests} = $num_tests;
}
$self->_output_plan($num_tests) unless $self->{Have_Output_Plan};
$self->{Have_Plan} = 1;
# The wrong number of tests were run
$self->is_passing(0) if $self->{Expected_Tests} != $self->{Curr_Test};
# No tests were run
$self->is_passing(0) if $self->{Curr_Test} == 0;
return 1;
}
#line 630
sub has_plan {
my $self = shift;
return( $self->{Expected_Tests} ) if $self->{Expected_Tests};
return('no_plan') if $self->{No_Plan};
return(undef);
}
#line 647
sub skip_all {
my( $self, $reason ) = @_;
$self->{Skip_All} = $self->parent ? $reason : 1;
$self->_output_plan(0, "SKIP", $reason) unless $self->no_header;
if ( $self->parent ) {
die bless {} => 'Test::Builder::Exception';
}
exit(0);
}
#line 672
sub exported_to {
my( $self, $pack ) = @_;
if( defined $pack ) {
inc/Test/Builder.pm view on Meta::CPAN
if ( $self->{Child_Name} and not $self->{In_Destroy} ) {
$name = 'unnamed test' unless defined $name;
$self->is_passing(0);
$self->croak("Cannot run test ($name) with active children");
}
# $test might contain an object which we don't want to accidentally
# store, so we turn it into a boolean.
$test = $test ? 1 : 0;
lock $self->{Curr_Test};
$self->{Curr_Test}++;
# In case $name is a string overloaded object, force it to stringify.
$self->_unoverload_str( \$name );
$self->diag(<<"ERR") if defined $name and $name =~ /^[\d\s]+$/;
You named your test '$name'. You shouldn't use numbers for your test names.
Very confusing.
ERR
# Capture the value of $TODO for the rest of this ok() call
inc/Test/Builder.pm view on Meta::CPAN
unless($test) {
$out .= "not ";
@$result{ 'ok', 'actual_ok' } = ( ( $self->in_todo ? 1 : 0 ), 0 );
}
else {
@$result{ 'ok', 'actual_ok' } = ( 1, $test );
}
$out .= "ok";
$out .= " $self->{Curr_Test}" if $self->use_numbers;
if( defined $name ) {
$name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
$out .= " - $name";
$result->{name} = $name;
}
else {
$result->{name} = '';
}
if( $self->in_todo ) {
$out .= " # TODO $todo";
$result->{reason} = $todo;
$result->{type} = 'todo';
}
else {
$result->{reason} = '';
$result->{type} = '';
}
$self->{Test_Results}[ $self->{Curr_Test} - 1 ] = $result;
$out .= "\n";
$self->_print($out);
unless($test) {
my $msg = $self->in_todo ? "Failed (TODO)" : "Failed";
$self->_print_to_fh( $self->_diag_fh, "\n" ) if $ENV{HARNESS_ACTIVE};
my( undef, $file, $line ) = $self->caller;
if( defined $name ) {
inc/Test/Builder.pm view on Meta::CPAN
# Check that we haven't yet violated the plan and set
# is_passing() accordingly
sub _check_is_passing_plan {
my $self = shift;
my $plan = $self->has_plan;
return unless defined $plan; # no plan yet defined
return unless $plan !~ /\D/; # no numeric plan
$self->is_passing(0) if $plan < $self->{Curr_Test};
}
sub _unoverload {
my $self = shift;
my $type = shift;
$self->_try(sub { require overload; }, die_on_fail => 1);
foreach my $thing (@_) {
inc/Test/Builder.pm view on Meta::CPAN
*BAILOUT = \&BAIL_OUT;
}
#line 1172
sub skip {
my( $self, $why ) = @_;
$why ||= '';
$self->_unoverload_str( \$why );
lock( $self->{Curr_Test} );
$self->{Curr_Test}++;
$self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share(
{
'ok' => 1,
actual_ok => 1,
name => '',
type => 'skip',
reason => $why,
}
);
my $out = "ok";
$out .= " $self->{Curr_Test}" if $self->use_numbers;
$out .= " # skip";
$out .= " $why" if length $why;
$out .= "\n";
$self->_print($out);
return 1;
}
#line 1213
sub todo_skip {
my( $self, $why ) = @_;
$why ||= '';
lock( $self->{Curr_Test} );
$self->{Curr_Test}++;
$self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share(
{
'ok' => 1,
actual_ok => 0,
name => '',
type => 'todo_skip',
reason => $why,
}
);
my $out = "not ok";
$out .= " $self->{Curr_Test}" if $self->use_numbers;
$out .= " # TODO & SKIP $why\n";
$self->_print($out);
return 1;
}
#line 1293
sub maybe_regex {
inc/Test/Builder.pm view on Meta::CPAN
# Prevent printing headers when only compiling. Mostly for when
# tests are deparsed with B::Deparse
return if $^C;
my $msg = join '', @msgs;
local( $\, $", $, ) = ( undef, ' ', '' );
# Escape each line after the first with a # so we don't
# confuse Test::Harness.
$msg =~ s{\n(?!\z)}{\n# }sg;
# Stick a newline on the end if it needs it.
$msg .= "\n" unless $msg =~ /\n\z/;
return print $fh $self->_indent, $msg;
}
#line 1732
inc/Test/Builder.pm view on Meta::CPAN
$fh = $file_or_fh;
}
elsif( ref $file_or_fh eq 'SCALAR' ) {
# Scalar refs as filehandles was added in 5.8.
if( $] >= 5.008 ) {
open $fh, ">>", $file_or_fh
or $self->croak("Can't open scalar ref $file_or_fh: $!");
}
# Emulate scalar ref filehandles with a tie.
else {
$fh = Test::Builder::IO::Scalar->new($file_or_fh)
or $self->croak("Can't tie scalar ref $file_or_fh");
}
}
else {
open $fh, ">", $file_or_fh
or $self->croak("Can't open test output log $file_or_fh: $!");
_autoflush($fh);
}
return $fh;
inc/Test/Builder.pm view on Meta::CPAN
sub _autoflush {
my($fh) = shift;
my $old_fh = select $fh;
$| = 1;
select $old_fh;
return;
}
my( $Testout, $Testerr );
sub _dup_stdhandles {
my $self = shift;
$self->_open_testhandles;
# Set everything to unbuffered else plain prints to STDOUT will
# come out in the wrong order from our own prints.
_autoflush($Testout);
_autoflush( \*STDOUT );
_autoflush($Testerr);
_autoflush( \*STDERR );
$self->reset_outputs;
return;
}
sub _open_testhandles {
my $self = shift;
return if $self->{Opened_Testhandles};
# We dup STDOUT and STDERR so people can change them in their
# test suites while still getting normal test output.
open( $Testout, ">&STDOUT" ) or die "Can't dup STDOUT: $!";
open( $Testerr, ">&STDERR" ) or die "Can't dup STDERR: $!";
# $self->_copy_io_layers( \*STDOUT, $Testout );
# $self->_copy_io_layers( \*STDERR, $Testerr );
$self->{Opened_Testhandles} = 1;
return;
}
sub _copy_io_layers {
my( $self, $src, $dst ) = @_;
$self->_try(
sub {
require PerlIO;
inc/Test/Builder.pm view on Meta::CPAN
);
return;
}
#line 1857
sub reset_outputs {
my $self = shift;
$self->output ($Testout);
$self->failure_output($Testerr);
$self->todo_output ($Testout);
return;
}
#line 1883
sub _message_at_caller {
my $self = shift;
local $Level = $Level + 1;
inc/Test/Builder.pm view on Meta::CPAN
my $self = shift;
return die $self->_message_at_caller(@_);
}
#line 1923
sub current_test {
my( $self, $num ) = @_;
lock( $self->{Curr_Test} );
if( defined $num ) {
$self->{Curr_Test} = $num;
# If the test counter is being pushed forward fill in the details.
my $test_results = $self->{Test_Results};
if( $num > @$test_results ) {
my $start = @$test_results ? @$test_results : 0;
for( $start .. $num - 1 ) {
$test_results->[$_] = &share(
{
'ok' => 1,
actual_ok => undef,
reason => 'incrementing test number',
type => 'unknown',
name => undef
}
);
}
}
# If backward, wipe history. Its their funeral.
elsif( $num < @$test_results ) {
$#{$test_results} = $num - 1;
}
}
return $self->{Curr_Test};
}
#line 1971
sub is_passing {
my $self = shift;
if( @_ ) {
$self->{Is_Passing} = shift;
}
return $self->{Is_Passing};
}
#line 1993
sub summary {
my($self) = shift;
return map { $_->{'ok'} } @{ $self->{Test_Results} };
}
#line 2048
sub details {
my $self = shift;
return @{ $self->{Test_Results} };
}
#line 2077
sub todo {
my( $self, $pack ) = @_;
return $self->{Todo} if defined $self->{Todo};
local $Level = $Level + 1;
inc/Test/Builder.pm view on Meta::CPAN
}
#line 2239
#line 2253
#'#
sub _sanity_check {
my $self = shift;
$self->_whoa( $self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!' );
$self->_whoa( $self->{Curr_Test} != @{ $self->{Test_Results} },
'Somehow you got a different number of results than tests ran!' );
return;
}
#line 2274
sub _whoa {
my( $self, $check, $desc ) = @_;
if($check) {
inc/Test/Builder.pm view on Meta::CPAN
my $real_exit_code = $?;
# Don't bother with an ending if this is a forked copy. Only the parent
# should do the ending.
if( $self->{Original_Pid} != $$ ) {
return;
}
# Ran tests but never declared a plan or hit done_testing
if( !$self->{Have_Plan} and $self->{Curr_Test} ) {
$self->is_passing(0);
$self->diag("Tests were run but no plan was declared and done_testing() was not seen.");
}
# Exit if plan() was never called. This is so "require Test::Simple"
# doesn't puke.
if( !$self->{Have_Plan} ) {
return;
}
# Don't do an ending if we bailed out.
if( $self->{Bailed_Out} ) {
$self->is_passing(0);
return;
}
# Figure out if we passed or failed and print helpful messages.
my $test_results = $self->{Test_Results};
if(@$test_results) {
# The plan? We have no plan.
if( $self->{No_Plan} ) {
$self->_output_plan($self->{Curr_Test}) unless $self->no_header;
$self->{Expected_Tests} = $self->{Curr_Test};
}
# Auto-extended arrays and elements which aren't explicitly
# filled in with a shared reference will puke under 5.8.0
# ithreads. So we have to fill them in by hand. :(
my $empty_result = &share( {} );
for my $idx ( 0 .. $self->{Expected_Tests} - 1 ) {
$test_results->[$idx] = $empty_result
unless defined $test_results->[$idx];
}
my $num_failed = grep !$_->{'ok'}, @{$test_results}[ 0 .. $self->{Curr_Test} - 1 ];
my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests};
if( $num_extra != 0 ) {
my $s = $self->{Expected_Tests} == 1 ? '' : 's';
$self->diag(<<"FAIL");
Looks like you planned $self->{Expected_Tests} test$s but ran $self->{Curr_Test}.
FAIL
$self->is_passing(0);
}
if($num_failed) {
my $num_tests = $self->{Curr_Test};
my $s = $num_failed == 1 ? '' : 's';
my $qualifier = $num_extra == 0 ? '' : ' run';
$self->diag(<<"FAIL");
Looks like you failed $num_failed test$s of $num_tests$qualifier.
FAIL
$self->is_passing(0);
}
if($real_exit_code) {
$self->diag(<<"FAIL");
Looks like your test exited with $real_exit_code just after $self->{Curr_Test}.
FAIL
$self->is_passing(0);
_my_exit($real_exit_code) && return;
}
my $exit_code;
if($num_failed) {
$exit_code = $num_failed <= 254 ? $num_failed : 254;
}
elsif( $num_extra != 0 ) {
inc/Test/Builder.pm view on Meta::CPAN
$self->diag("No tests run!\n");
$self->is_passing(0);
_my_exit(255) && return;
}
$self->is_passing(0);
$self->_whoa( 1, "We fell off the end of _ending()" );
}
END {
$Test->_ending if defined $Test;
}
#line 2498
1;
inc/Test/Builder/Module.pm view on Meta::CPAN
#line 1
package Test::Builder::Module;
use strict;
use Test::Builder;
require Exporter;
our @ISA = qw(Exporter);
our $VERSION = '0.94';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
#line 74
sub import {
my($class) = shift;
# Don't run all this when loading ourself.
return 1 if $class eq 'Test::Builder::Module';
my $test = $class->builder;
my $caller = caller;
$test->exported_to($caller);
$class->import_extra( \@_ );
my(@imports) = $class->_strip_imports( \@_ );
inc/Test/Builder/Module.pm view on Meta::CPAN
return @imports;
}
#line 137
sub import_extra { }
#line 167
sub builder {
return Test::Builder->new;
}
1;
inc/Test/More.pm view on Meta::CPAN
#line 1
package Test::More;
use 5.006;
use strict;
use warnings;
#---- perlcritic exemptions. ----#
# We use a lot of subroutine prototypes
## no critic (Subroutines::ProhibitSubroutinePrototypes)
inc/Test/More.pm view on Meta::CPAN
# even though the module being used forgot to use Carp. Yes, this
# actually happened.
sub _carp {
my( $file, $line ) = ( caller(1) )[ 1, 2 ];
return warn @_, " at $file line $line\n";
}
our $VERSION = '0.94';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
use Test::Builder::Module;
our @ISA = qw(Test::Builder::Module);
our @EXPORT = qw(ok use_ok require_ok
is isnt like unlike is_deeply
cmp_ok
skip todo todo_skip
pass fail
eq_array eq_hash eq_set
$TODO
plan
done_testing
can_ok isa_ok new_ok
diag note explain
subtest
BAIL_OUT
);
#line 164
sub plan {
my $tb = Test::More->builder;
return $tb->plan(@_);
}
# This implements "use Test::More 'no_diag'" but the behavior is
# deprecated.
sub import_extra {
my $class = shift;
my $list = shift;
my @other = ();
my $idx = 0;
while( $idx <= $#{$list} ) {
my $item = $list->[$idx];
inc/Test/More.pm view on Meta::CPAN
}
@$list = @other;
return;
}
#line 217
sub done_testing {
my $tb = Test::More->builder;
$tb->done_testing(@_);
}
#line 289
sub ok ($;$) {
my( $test, $name ) = @_;
my $tb = Test::More->builder;
return $tb->ok( $test, $name );
}
#line 367
sub is ($$;$) {
my $tb = Test::More->builder;
return $tb->is_eq(@_);
}
sub isnt ($$;$) {
my $tb = Test::More->builder;
return $tb->isnt_eq(@_);
}
*isn't = \&isnt;
#line 411
sub like ($$;$) {
my $tb = Test::More->builder;
return $tb->like(@_);
}
#line 426
sub unlike ($$;$) {
my $tb = Test::More->builder;
return $tb->unlike(@_);
}
#line 471
sub cmp_ok($$$;$) {
my $tb = Test::More->builder;
return $tb->cmp_ok(@_);
}
#line 506
sub can_ok ($@) {
my( $proto, @methods ) = @_;
my $class = ref $proto || $proto;
my $tb = Test::More->builder;
unless($class) {
my $ok = $tb->ok( 0, "->can(...)" );
$tb->diag(' can_ok() called with empty class or reference');
return $ok;
}
unless(@methods) {
my $ok = $tb->ok( 0, "$class->can(...)" );
$tb->diag(' can_ok() called with no methods');
inc/Test/More.pm view on Meta::CPAN
$tb->diag( map " $class->can('$_') failed\n", @nok );
return $ok;
}
#line 572
sub isa_ok ($$;$) {
my( $object, $class, $obj_name ) = @_;
my $tb = Test::More->builder;
my $diag;
if( !defined $object ) {
$obj_name = 'The thing' unless defined $obj_name;
$diag = "$obj_name isn't defined";
}
else {
my $whatami = ref $object ? 'object' : 'class';
# We can't use UNIVERSAL::isa because we want to honor isa() overrides
inc/Test/More.pm view on Meta::CPAN
else {
$ok = $tb->ok( 1, $name );
}
return $ok;
}
#line 651
sub new_ok {
my $tb = Test::More->builder;
$tb->croak("new_ok() must be given at least a class") unless @_;
my( $class, $args, $object_name ) = @_;
$args ||= [];
$object_name = "The object" unless defined $object_name;
my $obj;
my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } );
if($success) {
local $Test::Builder::Level = $Test::Builder::Level + 1;
isa_ok $obj, $class, $object_name;
}
else {
$tb->ok( 0, "new() died" );
$tb->diag(" Error was: $error");
}
return $obj;
}
#line 719
sub subtest($&) {
my ($name, $subtests) = @_;
my $tb = Test::More->builder;
return $tb->subtest(@_);
}
#line 743
sub pass (;$) {
my $tb = Test::More->builder;
return $tb->ok( 1, @_ );
}
sub fail (;$) {
my $tb = Test::More->builder;
return $tb->ok( 0, @_ );
}
#line 806
sub use_ok ($;@) {
my( $module, @imports ) = @_;
@imports = () unless @imports;
my $tb = Test::More->builder;
my( $pack, $filename, $line ) = caller;
my $code;
if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
# probably a version check. Perl needs to see the bare number
# for it to work with non-Exporter based modules.
$code = <<USE;
package $pack;
use $module $imports[0];
inc/Test/More.pm view on Meta::CPAN
# make sure that $code got a chance to set $SIG{__DIE__}
$SIG{__DIE__} = $sigdie if defined $sigdie;
return( $eval_result, $eval_error );
}
#line 875
sub require_ok ($) {
my($module) = shift;
my $tb = Test::More->builder;
my $pack = caller;
# Try to deterine if we've been given a module name or file.
# Module names must be barewords, files not.
$module = qq['$module'] unless _is_module_name($module);
my $code = <<REQUIRE;
package $pack;
require $module;
inc/Test/More.pm view on Meta::CPAN
our( @Data_Stack, %Refs_Seen );
my $DNE = bless [], 'Does::Not::Exist';
sub _dne {
return ref $_[0] eq ref $DNE;
}
## no critic (Subroutines::RequireArgUnpacking)
sub is_deeply {
my $tb = Test::More->builder;
unless( @_ == 2 or @_ == 3 ) {
my $msg = <<'WARNING';
is_deeply() takes two or three args, you gave %d.
This usually means you passed an array or hash instead
of a reference to it
WARNING
chop $msg; # clip off newline so carp() will put in line/file
_carp sprintf $msg, scalar @_;
inc/Test/More.pm view on Meta::CPAN
for my $type (qw(ARRAY HASH REF SCALAR GLOB CODE Regexp)) {
return $type if UNIVERSAL::isa( $thing, $type );
}
return '';
}
#line 1112
sub diag {
return Test::More->builder->diag(@_);
}
sub note {
return Test::More->builder->note(@_);
}
#line 1138
sub explain {
return Test::More->builder->explain(@_);
}
#line 1204
## no critic (Subroutines::RequireFinalReturn)
sub skip {
my( $why, $how_many ) = @_;
my $tb = Test::More->builder;
unless( defined $how_many ) {
# $how_many can only be avoided when no_plan is in use.
_carp "skip() needs to know \$how_many tests are in the block"
unless $tb->has_plan eq 'no_plan';
$how_many = 1;
}
if( defined $how_many and $how_many =~ /\D/ ) {
_carp
inc/Test/More.pm view on Meta::CPAN
}
no warnings 'exiting';
last SKIP;
}
#line 1288
sub todo_skip {
my( $why, $how_many ) = @_;
my $tb = Test::More->builder;
unless( defined $how_many ) {
# $how_many can only be avoided when no_plan is in use.
_carp "todo_skip() needs to know \$how_many tests are in the block"
unless $tb->has_plan eq 'no_plan';
$how_many = 1;
}
for( 1 .. $how_many ) {
$tb->todo_skip($why);
}
no warnings 'exiting';
last TODO;
}
#line 1343
sub BAIL_OUT {
my $reason = shift;
my $tb = Test::More->builder;
$tb->BAIL_OUT($reason);
}
#line 1382
#'#
sub eq_array {
local @Data_Stack = ();
_deep_check(@_);
inc/Test/More.pm view on Meta::CPAN
pop @Data_Stack if $ok;
last unless $ok;
}
return $ok;
}
sub _deep_check {
my( $e1, $e2 ) = @_;
my $tb = Test::More->builder;
my $ok = 0;
# Effectively turn %Refs_Seen into a stack. This avoids picking up
# the same referenced used twice (such as [\$a, \$a]) to be considered
# circular.
local %Refs_Seen = %Refs_Seen;
{
# Quiet uninitialized value warnings when comparing undefs.
t/00_compile.t view on Meta::CPAN
use strict;
use Test::More tests => 1;
BEGIN { use_ok 'Acme::Albed' }
t/01_dict.t view on Meta::CPAN
use strict;
use Test::More;
use Acme::Albed;
my $albed = Acme::Albed->new;
my $dic = $albed->dict;
# from/to albedian
# die Dumper $dic;
for my $key ( keys %$dic ) {
my @char_ja = split //, $dic->{$key}->{before};
my @char_al = split //, $dic->{$key}->{after};
xt/01_podspell.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
eval q{ use Test::Spelling };
plan skip_all => "Test::Spelling is not installed." if $@;
my $spell_cmd;
foreach my $path (split(/:/, $ENV{PATH}))
{
-x "$path/spell" and $spell_cmd="spell", last;
-x "$path/ispell" and $spell_cmd="ispell -l", last;
-x "$path/aspell" and $spell_cmd="aspell list", last;
}
$ENV{SPELL_CMD} and $spell_cmd = $ENV{SPELL_CMD};
$spell_cmd or plan skip_all => "no spell/ispell/aspell";
xt/02_perlcritic.t view on Meta::CPAN
use strict;
use Test::More;
eval {
require Test::Perl::Critic;
Test::Perl::Critic->import( -profile => 'xt/perlcriticrc');
};
plan skip_all => "Test::Perl::Critic is not installed." if $@;
all_critic_ok('lib');
xt/03_pod.t view on Meta::CPAN
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
all_pod_files_ok();
xt/perlcriticrc view on Meta::CPAN
[TestingAndDebugging::ProhibitNoStrict]
allow=refs
[TestingAndDebugging::RequireUseStrict]
equivalent_modules = Any::Moose
[TestingAndDebugging::RequireUseWarnings]
equivalent_modules = Any::Moose
( run in 0.376 second using v1.01-cache-2.11-cpan-4d50c553e7e )