File Coverage

blib/lib/Test/Class/Most.pm

Criterion	Covered	Total	%
statement	81	84	96.4
branch	16	22	72.7
condition	5	9	55.5
subroutine	19	19	100.0
pod	0	1	0.0
total	121	135	89.6

package Test::Class::Most;

use warnings;
use strict;
use Test::Class;
use Carp 'croak';

=head1 NAME

Test::Class::Most - Test Classes the easy way

=head1 VERSION

Version 0.08

=cut

our $VERSION = '0.08';
$VERSION = eval $VERSION;

=head1 SYNOPSIS

Instead of this:

    use strict;
    use warnings;
    use Test::Exception 0.88;
    use Test::Differences 0.500;
    use Test::Deep 0.106;
    use Test::Warn 0.11;
    use Test::More 0.88;

    use parent 'My::Test::Class';

    sub some_test : Tests { ... }

You type this:

    use Test::Class::Most parent => 'My::Test::Class';

    sub some_test : Tests { ... }

=head1 DESCRIPTION

When people write test classes with the excellent C, you often
see the following at the top of the code:

  package Some::Test::Class;

  use strict;
  use warnings;
  use base 'My::Test::Class';
  use Test::More;
  use Test::Exception;

  # and then the tests ...

That's a lot of boilerplate and I don't like boilerplate.  So now you can do
this:

  use Test::Class::Most parent => 'My::Test::Class';

That automatically imports L and L for you.  It also gives
you all of the testing goodness from L.

=head1 CREATING YOUR OWN BASE CLASS

You probably want to create your own base class for testing.  To do this,
simply specify no import list:

  package My::Test::Class;
  use Test::Class::Most; # we now inherit from Test::Class

  INIT { Test::Class->runtests }

  1;

And then your other classes inherit as normal (well, the way we do it):

  package Tests::For::Foo;
  use Test::Class::Most parent => 'My::Test::Class';

And you can inherit from those other classes, too:

  package Tests::For::Foo::Child;
  use Test::Class::Most parent => 'Tests::For::Foo';

Of course, it's quite possible that you're a fan of multiple inheritance, so
you can do that, too (I was I tempted to not allow this, but I
figured I shouldn't force too many of my personal beliefs on you):

 package Tests::For::ISuckAtOO;
 use Test::Class::Most parent => [qw/
    Tests::For::Foo
    Tests::For::Bar
    Some::Other::Class::For::Increased::Stupidity
 /];

As a side note, it's recommended that even if you don't need test control
methods in your base class, put stubs in there:

  package My::Test::Class;
  use Test::Class::Most; # we now inherit from Test::Class

  INIT { Test::Class->runtests }

  sub startup  : Tests(startup)  {}
  sub setup    : Tests(setup)    {}
  sub teardown : Tests(teardown) {}
  sub shutdown : Tests(shutdown) {}

  1;

This allows developers to I be able to safely call parent test control
methods rather than wonder if they are there:

  package Tests::For::Customer;
  use Test::Class::Most parent => 'My::Test::Class';

  sub setup : Tests(setup) {
    my $test = shift;
    $test->next::method; # safe due to stub in base class
    ...
  }

=head1 ATTRIBUTES

You can also specify "attributes" which are merely very simple getter/setters.

  use Test::Class::Most
    parent      => 'My::Test::Class',
    attributes  => [qw/customer items/],
    is_abstract => 1;

  sub setup : Tests(setup) {
    my $test = shift;
    $test->SUPER::setup;
    $test->customer( ... );
    $test->items( ... );
  }

  sub some_tests : Tests {
    my $test     = shift;
    my $customer = $test->customer;
    ...
  }

If called with no arguments, returns the current value.  If called with one
argument, sets that argument as the current value.  If called with more than
one argument, it croaks.

=head1 ABSTRACT CLASSES

You may pass an optional C parameter in the import list. It takes
a boolean value. This value is advisory only and is not inherited. It defaults
to false if not provided.

Sometimes you want to identify a test class as "abstract". It may have a bunch
of tests, but those should only run for its subclasses. You can pass
C< 1>> in the import list. Then, to test if a given class or
instance of that class is "abstract":

 sub dont_run_in_abstract_base_class : Tests {
     my $test = shift;
     return if Test::Class::Most->is_abstract($test);
     ...
 }

Note that C is strictly B. You are expected
(required) to check the value yourself and take appropriate action.

We recommend adding the following method to your base class:

 sub is_abstract {
     my $test = shift;
     return Test::Class::Most->is_abstract($test);
 }

And later in a subclass:

 if ( $test->is_abstract ) { ... }

=head1 EXPORT

All functions from L are automatically exported into your
namespace.

=cut

{
    my %IS_ABSTRACT;

    sub is_abstract {
        my ( undef, $proto ) = @_;
        my $test_class = ref $proto || $proto;
        return $IS_ABSTRACT{$test_class};
    }

    sub import {
        my ( $class, %args ) = @_;
        my $caller = caller;
        eval "package $caller; use Test::Most;";
        croak($@) if $@;
        warnings->import;
        strict->import;
        if ( my $parent = delete $args{parent} ) {
            if ( ref $parent && 'ARRAY' ne ref $parent ) {
                croak(
    "Argument to 'parent' must be a classname or array of classnames, not ($parent)"
                );
            }
            $parent = [$parent] unless ref $parent;
            foreach my $p (@$parent) {
                eval "use $p";
                croak($@) if $@;
            }
            no strict 'refs';
            push @{"${caller}::ISA"} => @$parent;
        }
        else {
            no strict 'refs';
            push @{"${caller}::ISA"} => 'Test::Class';
        }
        if ( my $attributes = delete $args{attributes} ) {
            if ( ref $attributes && 'ARRAY' ne ref $attributes ) {
                croak(
    "Argument to 'attributes' must be a classname or array of classnames, not ($attributes)"
                );
            }
            $attributes = [$attributes] unless ref $attributes;
            foreach my $attr (@$attributes) {
                my $method = "$caller\::$attr";
                no strict 'refs';
                *$method = sub {
                    my $test = shift;
                    return $test->{$method} unless @_;
                    if ( @_ > 1 ) {
                        croak("You may not pass more than one argument to '$method'");
                    }
                    $test->{$method} = shift;
                    return $test;
                };
            }
        }
        if ( my $is_abstract = delete $args{is_abstract} ) {
            $IS_ABSTRACT{$caller} = $is_abstract;
        }
        else {
            $IS_ABSTRACT{$caller} = 0;
        }
    }
}

=head1 TUTORIAL

If you're not familiar with using L, please see my tutorial at:

=over 4

=item * L

=item * L

=item * L

=item * L

=item * L

=back


=head1 AUTHOR

Curtis "Ovid" Poe, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C
rt.cpan.org>, or through the web interface at
L.  I will be
notified, and then you'll automatically be notified of progress on your bug as
I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Test::Class::Most

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back

=head1 SEE ALSO

=over 4

=item * L

xUnit-style testing in Perl

=item * L

The most popular CPAN test modules bundled into one module.

=item * L

I stole this code.  Thanks C!

=back

=head1 ACKNOWLEDGEMENTS

Thanks to Adrian Howard for L, Adam Kennedy for maintaining it
and C for L.

=head1 COPYRIGHT & LICENSE

Copyright 2010 Curtis "Ovid" Poe, all rights reserved.

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut

no warnings 'void';
"Boilerplate is bad, m'kay";