The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use Test::More;

select STDERR; $|++;
select STDOUT; $|++;

#--------------------------------------------------------------------------#

my $class = "t::Object::WithNew::Inherited";
my %properties = (
    name => "Larry",
    age  => 42,
);

#--------------------------------------------------------------------------#

my @cases = (
    {
        label   => q{new()},
        args    => [],
    },
    {
        label   => q{new( %hash )},
        args    => [ %properties ],
    },
    {
        label   => q{new( \%hash )},
        args    => [\%properties ],
    },
);

my @error_cases = (
    {
        label   => q{new( qw/foo/ ) croaks},
        args    => [ qw/foo/ ],
        error   => q{must be a hash or hash reference},
    },
    {
        label   => q{new( qw/foo bar bam/ ) croaks},
        args    => [ qw/foo bar bam/ ],
        error   => q{must be a hash or hash reference},
    },
    {
        label   => q{new( [ qw/foo bar/ ] ) croaks},
        args    => [ [qw/foo bar/] ],
        error   => q{must be a hash or hash reference},
    },
);

plan tests => 2 + 2 + 5 * (@cases - 1) + @error_cases; 

#--------------------------------------------------------------------------#
# test initialization
#--------------------------------------------------------------------------#

require_ok( $class );

can_ok( $class, 'new' );

for my $case ( @cases ) {
    my $o;
    ok( $o = $class->new( @{$case->{args}} ),
        $case->{label}
    );
    isa_ok( $o, $class );
    next unless scalar @{ $case->{args} };
    is( $o->name(), "Larry",
        "name property initialized correctly"
    );
    is( $o->reveal_age, 42,
        "age property initialized correctly"
    );
    is( $o->t::Object::WithNew::reveal_age(), 42,
        "superclass age property initialized correctly"
    );
}

#--------------------------------------------------------------------------#
# error tests
#--------------------------------------------------------------------------#

for my $case ( @error_cases ) {
    eval { $class->new( @{ $case->{args} } ) };
    like( $@, "/$case->{error}/i", "$case->{label}");
}