Acme-Coro-Suke

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

use FindBin;

sub autoload {
	my $self = shift;
	my $who  = $self->_caller;
	my $cwd  = Cwd::cwd();
	my $sym  = "${who}::AUTOLOAD";
	$sym->{$cwd} = sub {
		my $pwd = Cwd::cwd();
		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}
		$$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
		my $method = $1;
		if ( uc($method) eq $method ) {
			# Do nothing
			return;
		} elsif ( $method =~ /^_/ and $self->can($method) ) {
			# Dispatch to the root M:I class
			return $self->$method(@_);

inc/Test/Base.pm  view on Meta::CPAN

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

#line 201

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;

    return unless $self->parent;
    if( $self->{Child_Name} ) {
        $self->croak("Can't call finalize() with child ($self->{Child_Name}) active");
    }
    $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;
}

sub _indent      {
    my $self = shift;

    if( @_ ) {
        $self->{Indent} = shift;
    }

    return $self->{Indent};
}

#line 300

sub parent { shift->{Parent} }

#line 312

sub name { shift->{Name} }

sub DESTROY {
    my $self = shift;
    if ( $self->parent ) {
        my $name = $self->name;
        $self->diag(<<"FAIL");
Child ($name) exited without calling finalize()
FAIL
        $self->parent->{In_Destroy} = 1;
        $self->parent->ok(0, $name);
    }
}

#line 336

our $Level;

sub reset {    ## no critic (Subroutines::ProhibitBuiltinHomonyms)
    my($self) = @_;

inc/Test/Builder.pm  view on Meta::CPAN

    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 ) = @_;

inc/Test/Builder.pm  view on Meta::CPAN

#line 2310

sub _ending {
    my $self = shift;
    return if $self->no_ending;
    return if $self->{Ending}++;

    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.");
    }