Acme-Acotie
view release on metacpan or search on metacpan
inc/Module/Install/Makefile.pm view on Meta::CPAN
sub prompt {
shift;
# Infinite loop protection
my @c = caller();
if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
}
# In automated testing, always use defaults
if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
goto &ExtUtils::MakeMaker::prompt;
}
}
sub makemaker_args {
my $self = shift;
inc/Module/Install/Makefile.pm view on Meta::CPAN
my $self = shift;
my $libs = ref $_[0] ? shift : [ shift ];
$self->makemaker_args( LIBS => $libs );
}
sub inc {
my $self = shift;
$self->makemaker_args( INC => shift );
}
my %test_dir = ();
sub _wanted_t {
/\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
}
sub tests_recursive {
my $self = shift;
if ( $self->tests ) {
die "tests_recursive will not work if tests are already defined";
}
my $dir = shift || 't';
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
%test_dir = ();
require File::Find;
File::Find::find( \&_wanted_t, $dir );
$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}
sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
# Make sure we have a new enough
require ExtUtils::MakeMaker;
# MakeMaker can complain about module versions that include
inc/Module/Install/Makefile.pm view on Meta::CPAN
# for details.
$self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
# Generate the
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
$args->{VERSION} = $self->version;
$args->{NAME} =~ s/-/::/g;
if ( $self->tests ) {
$args->{test} = { TESTS => $self->tests };
}
if ($] >= 5.005) {
$args->{ABSTRACT} = $self->abstract;
$args->{AUTHOR} = $self->author;
}
if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
$args->{NO_META} = 1;
}
if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
$args->{SIGN} = 1;
inc/Module/Install/Makefile.pm view on Meta::CPAN
. $self->preamble
: '';
my $postamble = "# Postamble by $top_class $top_version\n"
. ($self->postamble || '');
local *MAKEFILE;
open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
my $makefile = do { local $/; <MAKEFILE> };
close MAKEFILE or die $!;
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
$makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
$makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
$makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
# Module::Install will never be used to build the Core Perl
# Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
# PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
$makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
inc/Module/Install/Metadata.pm view on Meta::CPAN
@ISA = qw{Module::Install::Base};
}
my @scalar_keys = qw{
name
module_name
abstract
author
version
distribution_type
tests
installdirs
};
my @tuple_keys = qw{
configure_requires
build_requires
requires
recommends
bundles
resources
inc/Module/Install/Metadata.pm view on Meta::CPAN
die("Unsupported reserved lowercase resource '$name'");
}
$self->{values}{resources} ||= [];
push @{ $self->{values}{resources} }, [ $name, $value ];
}
$self->{values}{resources};
}
# Aliases for build_requires that will have alternative
# meanings in some future version of META.yml.
sub test_requires { shift->build_requires(@_) }
sub install_requires { shift->build_requires(@_) }
# Aliases for installdirs options
sub install_as_core { $_[0]->installdirs('perl') }
sub install_as_cpan { $_[0]->installdirs('site') }
sub install_as_site { $_[0]->installdirs('site') }
sub install_as_vendor { $_[0]->installdirs('vendor') }
sub sign {
my $self = shift;
inc/Module/Install/TestBase.pm view on Meta::CPAN
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;
inc/Spiffy.pm view on Meta::CPAN
my $stack_frame = 0;
my $dump = 'yaml';
my $bases_map = {};
sub WWW; sub XXX; sub YYY; sub ZZZ;
# This line is here to convince "autouse" into believing we are autousable.
sub can {
($_[1] eq 'import' and caller()->isa('autouse'))
? \&Exporter::import # pacify autouse's equality test
: $_[0]->SUPER::can($_[1]) # normal case
}
# TODO
#
# Exported functions like field and super should be hidden so as not to
# be confused with methods that can be inherited.
#
sub new {
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
tie_output
find_my_self default_object
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;
inc/Test/Base/Filter.pm view on Meta::CPAN
$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 |"
or die "Couldn't open subprocess: $!\n";
local $/;
my $output = <$execution>;
close $execution;
unlink($tmpfile)
or die "Couldn't unlink $tmpfile: $!\n";
return $output;
}
inc/Test/Builder.pm view on Meta::CPAN
if( $self->{Have_Plan} ) {
$self->croak("You tried to plan twice");
}
if( $cmd eq 'no_plan' ) {
$self->no_plan;
}
elsif( $cmd eq 'skip_all' ) {
return $self->skip_all($arg);
}
elsif( $cmd eq 'tests' ) {
if( $arg ) {
local $Level = $Level + 1;
return $self->expected_tests($arg);
}
elsif( !defined $arg ) {
$self->croak("Got an undefined number of tests");
}
elsif( !$arg ) {
$self->croak("You said to run 0 tests");
}
}
else {
my @args = grep { defined } ($cmd, $arg);
$self->croak("plan() doesn't understand @args");
}
return 1;
}
#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};
}
inc/Test/Builder.pm view on Meta::CPAN
if( defined $pack ) {
$self->{Exported_To} = $pack;
}
return $self->{Exported_To};
}
#line 369
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();
# Capture the value of $TODO for the rest of this ok() call
# so it can more easily be found by other routines.
local $self->{TODO} = $todo;
$self->_unoverload_str(\$todo);
my $out;
my $result = &share({});
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;
}
inc/Test/Builder.pm view on Meta::CPAN
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 ) {
$self->diag(qq[ $msg test '$name'\n]);
$self->diag(qq[ at $file line $line.\n]);
}
else {
$self->diag(qq[ $msg test at $file line $line.\n]);
}
}
return $test ? 1 : 0;
}
sub _unoverload {
my $self = shift;
my $type = shift;
$self->_try(sub { require overload } ) || return;
foreach my $thing (@_) {
inc/Test/Builder.pm view on Meta::CPAN
#line 521
sub is_eq {
my($self, $got, $expect, $name) = @_;
local $Level = $Level + 1;
$self->_unoverload_str(\$got, \$expect);
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
$self->ok($test, $name);
$self->_is_diag($got, 'eq', $expect) unless $test;
return $test;
}
return $self->cmp_ok($got, 'eq', $expect, $name);
}
sub is_num {
my($self, $got, $expect, $name) = @_;
local $Level = $Level + 1;
$self->_unoverload_num(\$got, \$expect);
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
$self->ok($test, $name);
$self->_is_diag($got, '==', $expect) unless $test;
return $test;
}
return $self->cmp_ok($got, '==', $expect, $name);
}
sub _is_diag {
my($self, $got, $type, $expect) = @_;
foreach my $val (\$got, \$expect) {
if( defined $$val ) {
inc/Test/Builder.pm view on Meta::CPAN
}
#line 600
sub isnt_eq {
my($self, $got, $dont_expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $dont_expect ) {
# undef only matches undef and nothing else
my $test = defined $got || defined $dont_expect;
$self->ok($test, $name);
$self->_cmp_diag($got, 'ne', $dont_expect) unless $test;
return $test;
}
return $self->cmp_ok($got, 'ne', $dont_expect, $name);
}
sub isnt_num {
my($self, $got, $dont_expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $dont_expect ) {
# undef only matches undef and nothing else
my $test = defined $got || defined $dont_expect;
$self->ok($test, $name);
$self->_cmp_diag($got, '!=', $dont_expect) unless $test;
return $test;
}
return $self->cmp_ok($got, '!=', $dont_expect, $name);
}
#line 652
sub like {
my($self, $this, $regex, $name) = @_;
inc/Test/Builder.pm view on Meta::CPAN
my($self, $got, $type, $expect, $name) = @_;
# Treat overloaded objects as numbers if we're asked to do a
# numeric comparison.
my $unoverload = $numeric_cmps{$type} ? '_unoverload_num'
: '_unoverload_str';
$self->$unoverload(\$got, \$expect);
my $test;
{
local($@,$!,$SIG{__DIE__}); # isolate eval
my $code = $self->_caller_context;
# Yes, it has to look like this or 5.4.5 won't see the #line
# directive.
# Don't ask me, man, I just work here.
$test = eval "
$code" . "\$got $type \$expect;";
}
local $Level = $Level + 1;
my $ok = $self->ok($test, $name);
unless( $ok ) {
if( $type =~ /^(eq|==)$/ ) {
$self->_is_diag($got, $type, $expect);
}
else {
$self->_cmp_diag($got, $type, $expect);
}
}
return $ok;
inc/Test/Builder.pm view on Meta::CPAN
my $ok = 0;
my $usable_regex = $self->maybe_regex($regex);
unless (defined $usable_regex) {
$ok = $self->ok( 0, $name );
$self->diag(" '$regex' doesn't look much like a regex to me.");
return $ok;
}
{
my $test;
my $code = $self->_caller_context;
local($@, $!, $SIG{__DIE__}); # isolate eval
# Yes, it has to look like this or 5.4.5 won't see the #line
# directive.
# Don't ask me, man, I just work here.
$test = eval "
$code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
$test = !$test if $cmp eq '!~';
local $Level = $Level + 1;
$ok = $self->ok( $test, $name );
}
unless( $ok ) {
$this = defined $this ? "'$this'" : 'undef';
my $match = $cmp eq '=~' ? "doesn't match" : "matches";
local $Level = $Level + 1;
$self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
%s
%13s '%s'
inc/Test/Builder.pm view on Meta::CPAN
# I'm not ready to publish this. It doesn't deal with array return
# values from the code or context.
#line 1009
sub _try {
my($self, $code) = @_;
local $!; # eval can mess up $!
local $@; # don't set $@ in the test
local $SIG{__DIE__}; # don't trip an outside DIE handler.
my $return = eval { $code->() };
return wantarray ? ($return, $@) : $return;
}
#line 1031
sub is_fh {
my $self = shift;
inc/Test/Builder.pm view on Meta::CPAN
return 0;
}
#line 1234
sub _print {
my($self, @msgs) = @_;
# 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;
inc/Test/Builder.pm view on Meta::CPAN
sub _new_fh {
my $self = shift;
my($file_or_fh) = shift;
my $fh;
if( $self->is_fh($file_or_fh) ) {
$fh = $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;
}
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;
}
inc/Test/Builder.pm view on Meta::CPAN
sub croak {
my $self = shift;
die $self->_message_at_caller(@_);
}
sub _plan_check {
my $self = shift;
unless( $self->{Have_Plan} ) {
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;
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");
WHOA! $desc
inc/Test/Builder.pm view on Meta::CPAN
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
$exit_code = 0;
}
_my_exit( $exit_code ) && return;
}
elsif ( $self->{Skip_All} ) {
_my_exit( 0 ) && return;
}
elsif ( $real_exit_code ) {
$self->diag(<<'FAIL');
Looks like your test died before it could output anything.
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
inc/Test/Builder/Module.pm view on Meta::CPAN
#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(\@_);
$test->plan(@_);
$class->$_export_to_level(1, $class, @imports);
}
sub _strip_imports {
my $class = shift;
my $list = shift;
my @imports = ();
inc/Test/More.pm view on Meta::CPAN
$idx++;
}
@$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(@_);
}
inc/Test/More.pm view on Meta::CPAN
#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?";
$how_many = 1;
}
for( 1..$how_many ) {
$tb->skip($why);
}
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;
( run in 3.141 seconds using v1.01-cache-2.11-cpan-5c0b1e786e0 )