File Coverage

blib/lib/Test/Unit/Assertion/CodeRef.pm

Criterion	Covered	Total	%
statement	30	31	96.7
branch	8	10	80.0
condition	10	11	90.9
subroutine	7	7	100.0
pod	2	3	66.6
total	57	62	91.9

package Test::Unit::Assertion::CodeRef;

use strict;
use base qw/Test::Unit::Assertion/;

use Carp;
use Test::Unit::Debug qw(debug);

my $deparser;

sub new {
    my $class = shift;
    my $code = shift;
    croak "$class\::new needs a CODEREF" unless ref($code) eq 'CODE';
    bless \$code => $class;
}

sub do_assertion {
    my $self = shift;
    my $possible_object = $_[0];
    debug("Called do_assertion(" . ($possible_object || 'undef') . ")\n");
    if (ref($possible_object) and
        ref($possible_object) ne 'Regexp' and
        eval { $possible_object->isa('UNIVERSAL') })
    {
        debug("  [$possible_object] isa [" . ref($possible_object) . "]\n");
        $possible_object->$$self(@_[1..$#_]);
    }
    else {
        debug("  asserting [$self]"
              . (@_ ? " on args " . join(', ', map { $_ || '' } @_) : '')
              . "\n");
        $$self->(@_);
    }
}

sub to_string {
    my $self = shift;
    if (eval "require B::Deparse") {
        $deparser ||= B::Deparse->new("-p");
        return join '', "sub ", $deparser->coderef2text($$self);
    }
    else {
        return "sub {
    # If you had a working B::Deparse, you'd know what was in
    # this subroutine.
}";
    }
}

1;
__END__