Acme-Acotie
view release on metacpan or search on metacpan
acotie
Changes
inc/Module/Install.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/Acotie.pm
Makefile.PL
MANIFEST This list of files
META.yml
README
t/00_compile.t
---
abstract: 'Crash of Namespace'
author:
- 'Kazuhiro Osawa <ko@yappo.ne.jp>'
build_requires:
Test::More: 0
distribution_type: module
generated_by: 'Module::Install version 0.760'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: Acme-Acotie
no_index:
directory:
- inc
Makefile.PL view on Meta::CPAN
use inc::Module::Install;
name 'Acme-Acotie';
all_from 'lib/Acme/Acotie.pm';
requires 'Class::Inspector';
requires 'List::Util';
build_requires 'Test::More';
use_test_base;
auto_include;
WriteAll;
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');
}
1;
#line 67
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.52';
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
WWW XXX YYY ZZZ
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
}
$_ = "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) {
$_ = join '', @value;
@value = &$function(@value);
if (not(@value) or
@value == 1 and $value[0] =~ /\A(\d+|)\z/
) {
@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__
#line 1298
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;
our $VERSION = '0.80';
$VERSION = eval { $VERSION }; # make the alpha version come out as a number
# 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
# and earlier Perls just don't have that module at all.
else {
*share = sub { return $_[0] };
*lock = sub { 0 };
}
}
#line 110
my $Test = Test::Builder->new;
sub new {
my($class) = shift;
$Test ||= $class->create;
return $Test;
}
#line 132
sub create {
my $class = shift;
my $self = bless {}, $class;
$self->reset;
inc/Test/Builder.pm view on Meta::CPAN
my ($self) = @_;
# We leave this a global because it has to be localized and localizing
# hash keys is just asking for pain. Also, it was documented.
$Level = 1;
$self->{Have_Plan} = 0;
$self->{No_Plan} = 0;
$self->{Original_Pid} = $$;
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;
inc/Test/Builder.pm view on Meta::CPAN
#line 254
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+$/ and $max > 0;
$self->{Expected_Tests} = $max;
$self->{Have_Plan} = 1;
$self->_print("1..$max\n") unless $self->no_header;
}
return $self->{Expected_Tests};
}
#line 279
sub no_plan {
my $self = shift;
$self->{No_Plan} = 1;
$self->{Have_Plan} = 1;
}
#line 294
sub has_plan {
my $self = shift;
return($self->{Expected_Tests}) if $self->{Expected_Tests};
return('no_plan') if $self->{No_Plan};
return(undef);
};
#line 312
sub skip_all {
my($self, $reason) = @_;
inc/Test/Builder.pm view on Meta::CPAN
sub ok {
my($self, $test, $name) = @_;
# $test might contain an object which we don't want to accidentally
# store, so we turn it into a boolean.
$test = $test ? 1 : 0;
$self->_plan_check;
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
my $todo = $self->todo();
inc/Test/Builder.pm view on Meta::CPAN
unless( $test ) {
$out .= "not ";
@$result{ 'ok', 'actual_ok' } = ( ( $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( $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 = $todo ? "Failed (TODO)" : "Failed";
$self->_print_diag("\n") if $ENV{HARNESS_ACTIVE};
my(undef, $file, $line) = $self->caller;
if( defined $name ) {
inc/Test/Builder.pm view on Meta::CPAN
#line 791
sub skip {
my($self, $why) = @_;
$why ||= '';
$self->_unoverload_str(\$why);
$self->_plan_check;
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 833
sub todo_skip {
my($self, $why) = @_;
$why ||= '';
$self->_plan_check;
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 911
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, ' ', '');
my $fh = $self->output;
# Escape each line after the first with a # so we don't
# confuse Test::Harness.
$msg =~ s/\n(.)/\n# $1/sg;
# Stick a newline on the end if it needs it.
$msg .= "\n" unless $msg =~ /\n\Z/;
print $fh $msg;
}
#line 1268
inc/Test/Builder.pm view on Meta::CPAN
sub _autoflush {
my($fh) = shift;
my $old_fh = select $fh;
$| = 1;
select $old_fh;
}
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->output ($Testout);
$self->failure_output($Testerr);
$self->todo_output ($Testout);
}
my $Opened_Testhandles = 0;
sub _open_testhandles {
my $self = shift;
return if $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 );
$Opened_Testhandles = 1;
}
sub _copy_io_layers {
my($self, $src, $dst) = @_;
$self->_try(sub {
require PerlIO;
my @src_layers = PerlIO::get_layers($src);
inc/Test/Builder.pm view on Meta::CPAN
local $Level = $Level + 2;
$self->croak("You tried to run a test without a plan");
}
}
#line 1471
sub current_test {
my($self, $num) = @_;
lock($self->{Curr_Test});
if( defined $num ) {
unless( $self->{Have_Plan} ) {
$self->croak("Can't change the current test number without a plan!");
}
$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 1516
sub summary {
my($self) = shift;
return map { $_->{'ok'} } @{ $self->{Test_Results} };
}
#line 1571
sub details {
my $self = shift;
return @{ $self->{Test_Results} };
}
#line 1597
sub todo {
my($self, $pack) = @_;
return $self->{TODO} if defined $self->{TODO};
$pack = $pack || $self->caller(1) || $self->exported_to;
inc/Test/Builder.pm view on Meta::CPAN
}
#line 1634
#line 1648
#'#
sub _sanity_check {
my $self = shift;
$self->_whoa($self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!');
$self->_whoa(!$self->{Have_Plan} and $self->{Curr_Test},
'Somehow your tests ran without a plan!');
$self->_whoa($self->{Curr_Test} != @{ $self->{Test_Results} },
'Somehow you got a different number of results than tests ran!');
}
#line 1669
sub _whoa {
my($self, $check, $desc) = @_;
if( $check ) {
local $Level = $Level + 1;
$self->croak(<<"WHOA");
inc/Test/Builder.pm view on Meta::CPAN
my $real_exit_code = $?;
$self->_sanity_check();
# Don't bother with an ending if this is a forked copy. Only the parent
# should do the ending.
if( $self->{Original_Pid} != $$ ) {
return;
}
# 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} ) {
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->_print("1..$self->{Curr_Test}\n") 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 only ran $self->{Curr_Test}.
FAIL
}
elsif( $num_extra > 0 ) {
my $s = $self->{Expected_Tests} == 1 ? '' : 's';
$self->diag(<<"FAIL");
Looks like you planned $self->{Expected_Tests} test$s but ran $num_extra extra.
FAIL
}
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
}
if( $real_exit_code ) {
$self->diag(<<"FAIL");
Looks like your test died just after $self->{Curr_Test}.
FAIL
_my_exit( 255 ) && 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
FAIL
_my_exit( 255 ) && return;
}
else {
$self->diag("No tests run!\n");
_my_exit( 255 ) && return;
}
}
END {
$Test->_ending if defined $Test and !$Test->no_ending;
}
#line 1871
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.80';
# 5.004's Exporter doesn't have export_to_level.
my $_export_to_level = sub {
my $pkg = shift;
my $level = shift;
inc/Test/Builder/Module.pm view on Meta::CPAN
$pkg->export($callpkg, @_);
};
#line 82
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
#line 147
sub import_extra {}
#line 178
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;
# Can't use Carp because it might cause use_ok() to accidentally succeed
# even though the module being used forgot to use Carp. Yes, this
# actually happened.
sub _carp {
my($file, $line) = (caller(1))[1,2];
warn @_, " at $file line $line\n";
}
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
$VERSION = '0.80';
$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder::Module;
@ISA = qw(Test::Builder::Module);
@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
can_ok isa_ok
diag
BAIL_OUT
);
#line 156
sub plan {
my $tb = Test::More->builder;
$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;
}
#line 256
sub ok ($;$) {
my($test, $name) = @_;
my $tb = Test::More->builder;
$tb->ok($test, $name);
}
#line 323
sub is ($$;$) {
my $tb = Test::More->builder;
$tb->is_eq(@_);
}
sub isnt ($$;$) {
my $tb = Test::More->builder;
$tb->isnt_eq(@_);
}
*isn't = \&isnt;
#line 368
sub like ($$;$) {
my $tb = Test::More->builder;
$tb->like(@_);
}
#line 384
sub unlike ($$;$) {
my $tb = Test::More->builder;
$tb->unlike(@_);
}
#line 424
sub cmp_ok($$$;$) {
my $tb = Test::More->builder;
$tb->cmp_ok(@_);
}
#line 460
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 522
sub isa_ok ($$;$) {
my($object, $class, $obj_name) = @_;
my $tb = Test::More->builder;
my $diag;
$obj_name = 'The object' unless defined $obj_name;
my $name = "$obj_name isa $class";
if( !defined $object ) {
$diag = "$obj_name isn't defined";
}
elsif( !ref $object ) {
$diag = "$obj_name isn't a reference";
}
inc/Test/More.pm view on Meta::CPAN
$ok = $tb->ok( 1, $name );
}
return $ok;
}
#line 591
sub pass (;$) {
my $tb = Test::More->builder;
$tb->ok(1, @_);
}
sub fail (;$) {
my $tb = Test::More->builder;
$tb->ok(0, @_);
}
#line 652
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
my $eval_result = eval $code;
my $eval_error = $@;
return($eval_result, $eval_error);
}
#line 718
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
use vars qw(@Data_Stack %Refs_Seen);
my $DNE = bless [], 'Does::Not::Exist';
sub _dne {
ref $_[0] eq ref $DNE;
}
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 941
sub diag {
my $tb = Test::More->builder;
$tb->diag(@_);
}
#line 1010
#'#
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 "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?";
inc/Test/More.pm view on Meta::CPAN
local $^W = 0;
last SKIP;
}
#line 1097
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);
}
local $^W = 0;
last TODO;
}
#line 1150
sub BAIL_OUT {
my $reason = shift;
my $tb = Test::More->builder;
$tb->BAIL_OUT($reason);
}
#line 1189
#'#
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::Acotie' }
( run in 0.559 second using v1.01-cache-2.11-cpan-4d50c553e7e )