view release on metacpan or  search on metacpan

t/04-objects.t  view on Meta::CPAN

#!perl

use strict;
use warnings;

use Test::More tests => 11;

use Util::Underscore;

BEGIN {

    package Local::Parent;
    sub meth   { $_[1] }
    sub marker { }

    package Local::Child;
    push our @ISA, 'Local::Parent';

    package Local::Mock;
    sub meth { $_[1] }

    sub DOES {
        my ($self, $what) = @_;
        return 1 if $what eq 'Local::Parent';
        return $self->SUPER::DOES($what);
    }

    package Local::Unrelated;
    sub meth { $_[1] }
}

my %class = (
    parent    => 'Local::Parent',
    child     => 'Local::Child',
    mock      => 'Local::Mock',
    unrelated => 'Local::Unrelated',
);

my %object;
$object{$_} = bless [] => $class{$_} for keys %class;

my $zero_object = bless [] => '0';

subtest 'fixtures' => sub {
    plan tests => 6;

    for (keys %object) {
        is ref $object{$_}, $class{$_}, "instantiation for $_ successful";
    }

    is ref $zero_object, '0', "zero object has correct ref type";
    ok !ref $zero_object, "zero object class appears to be false";
};

subtest 'identity tests' => sub {
    plan tests => 2;

    is \&_::class,       \&_::blessed, "_::class";
    is \&_::is_instance, \&_::does,    "_::is_instance";
};

subtest '_::blessed' => sub {
    plan tests => 2;

    subtest 'boolean usage' => sub {
        plan tests => 11;

        ok _::blessed $object{parent}, "positive object";
        ok _::blessed qr//, "positive regex object";
        ok defined _::blessed $zero_object, "zero object correct return value";

        ok !_::blessed undef, "negative undef";
        ok !_::blessed 42,    "negative number";
        ok !_::blessed "foo", "negative string";
        ok !_::blessed [], "negative array reference";
        ok !_::blessed {}, "negative hash reference";
        ok !_::blessed $class{parent}, "negative class";

        ok _::blessed,  "positive implicit argument" for $object{parent};
        ok !_::blessed, "negative implicit argument" for undef;

    };

    subtest 'return values' => sub {
        plan tests => 8 + (keys %class);

        for (keys %class) {
            is _::blessed $object{$_}, $class{$_}, "positive return value $_";
        }

        is _::blessed $zero_object, '0', "positive return value zero object";
        is _::blessed qr//, 'Regexp', "positive return value Regexp";

        ok !defined _::blessed undef, "negative undef";
        ok !defined _::blessed 42,    "negative number";
        ok !defined _::blessed "foo", "negative string";
        ok !defined _::blessed [], "negative array reference";
        ok !defined _::blessed {}, "negative hash reference";
        ok !defined _::blessed $class{parent}, "negative class";
    };