File Coverage

blib/lib/Test/AbstractMethod.pm

Criterion	Covered	Total	%
statement	32	32	100.0
branch			n/a
condition	4	6	66.6
subroutine	7	7	100.0
pod	3	3	100.0
total	46	48	95.8

package Test::AbstractMethod;

use strict;

use base qw(Test::Builder::Module);

use vars qw(@EXPORT $VERSION);

$VERSION = 0.01;

@EXPORT = qw(call_abstract_function_ok call_abstract_method_ok call_abstract_class_method_ok);

sub call_abstract_function_ok($$;$) {
    my ($pkg, $method, $description) = @_;

    my $builder = Test::AbstractMethod->builder();

    eval {
        $pkg->can($method)->(0);
    };

    my $threw_exception = $@ && $@ =~ qr/$method\(\) should not be called as a function/;
    my $ok = $builder->ok( $threw_exception, $description );

    return $ok;
}

sub _call_abstract_method_ok($$$;$) {
    my ($pkg, $method, $callee, $description) = @_;

    my $builder = Test::AbstractMethod->builder();
	local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $cv = $pkg->can($method);
    eval {
        $cv->($callee);
    };

    my $threw_exception = $@ && $@ =~ qr/Class '$pkg' does not override ${method}()/;
    my $ok = $builder->ok( $threw_exception, $description );

    return $ok;
}

sub call_abstract_method_ok($$;$) {
    my ($pkg, $method, $description) = @_;

    my $callee = bless do { my $sv; \$sv; }, $pkg;
    return _call_abstract_method_ok($pkg, $method, $callee, $description);
}

sub call_abstract_class_method_ok($$;$) {
    my ($pkg, $method, $description) = @_;

    return _call_abstract_method_ok($pkg, $method, $pkg, $description);
}

1;
__END__