#! /usr/local/bin/perl

use lib qw(./t);
use warnings;
use strict;
use Test_Framework;
use Class::Generate qw(&class &subclass);

# Test the different constructor styles (key/value, positional, mix).

use constant SPEC => { type => "\$", readonly => 1, required => 1 };

sub members_valid($$)
{
    my ( $obj, $max ) = @_;
    for ( my $i = 1 ; $i <= $max ; $i++ )
    {
        return 0 if !eval "\$obj->m$i == $i";
    }
    return 1;
}

Test
{
    class KV_Class  => { map( ( $_ => SPEC ), qw(m1 m2 m3) ) };
    class Pos_Class => {
        map( ( $_ => SPEC ), qw(m1 m2 m3) ),
        new => { style => 'positional m1 m2 m3' }
    };
    class Mix_Class => {
        map( ( $_ => SPEC ), qw(m1 m2 m3 m4) ),
        new => { style => 'mix m1 m2' }
    };
    1
};

Test { members_valid KV_Class->new( m1 => 1, m2 => 2, m3 => 3 ), 3 };
Test { members_valid KV_Class->new( m2 => 2, m1 => 1, m3 => 3 ), 3 };
Test { members_valid Pos_Class->new( 1, 2, 3 ), 3 };
Test { members_valid Mix_Class->new( 1, 2, m3 => 3, m4 => 4 ), 4 };
Test { members_valid Mix_Class->new( 1, 2, m4 => 4, m3 => 3 ), 4 };

Test
{
    subclass
        KV_Subclass => { map( ( $_ => SPEC ), qw(m4) ) },
        -parent     => 'KV_Class';
    subclass
        Pos_Subclass =>
        { map( ( $_ => SPEC ), qw(m4) ), new => { style => 'positional m4' } },
        -parent => 'Pos_Class';
    subclass
        Mix_Subclass =>
        { map( ( $_ => SPEC ), qw(m5 m6) ), new => { style => 'mix m5' } },
        -parent => 'Mix_Class';
    1
};

Test { members_valid KV_Subclass->new( m1 => 1, m2 => 2, m3 => 3, m4 => 4 ), 4 };
Test { members_valid Pos_Subclass->new( 4, 1, 2, 3 ), 4 };
Test {
    members_valid Mix_Subclass->new( 5, m6 => 6, 1, 2, m3 => 3, m4 => 4 ), 6
};

Test
{
    class Mix_Parent =>
        { map( ( $_ => SPEC ), qw(m1 m2 m3) ), new => { style => 'mix m1' } };
    class
        Mix_Child_1 => { new => { style => 'mix' } },
        -parent     => 'Mix_Parent';
    class
        Mix_Child_2 =>
        { map( ( $_ => SPEC ), qw(m4) ), new => { style => 'mix' } },
        -parent => 'Mix_Parent';
    1
};

Test { members_valid Mix_Child_1->new( 1, m2 => 2, m3 => 3 ), 3 };
Test { members_valid Mix_Child_2->new( m4 => 4, 1, m2 => 2, m3 => 3 ), 4 };
Test_Failure { Mix_Child_2->new( 1, m2 => 2, m3 => 3, m4 => 4 ) };

Test
{
    class Own_Class => {
        m1  => SPEC,
        m2  => SPEC,
        new => {
            style => 'own',
            post  => q{$m1 = $_[0]; $m2 = $_[1];}
        }
    };
    1
};

Test { members_valid Own_Class->new( 1, 2 ), 2 };

Test
{
    class Own_Parent => { m1 => SPEC };
    1
};

Test
{
    class
        Own_Child_1 => { new => { style => 'own @_' } },
        -parent     => 'Own_Parent';
    members_valid Own_Child_1->new( m1 => 1 ), 1
};

Test_Failure
{
    class Own_Child_2 => {
        new => { style => 'own' }    # Doesn't pass anything to parent.
        },
        -parent => 'Own_Parent';
    Own_Child_2->new( m1 => 1 )      # Therefore, parent croaks.
};

Test
{
    class
        Own_Child_3 => {
        m2  => SPEC,
        new => {
            style => q{own 'm1' $_[1]},
            post  => q{$m2 = $_[0];}
        }
        },
        -parent => 'Own_Parent';
    members_valid Own_Child_3->new( 2, 1 ), 2
};

Test
{
    # Initialize superclass member to a constant.
    # Use a constant with an embedded quote to make sure Class::Generate is
    # quoting strings properly.
    class
        Own_Child_4 => { new => { style => q{own 'm1' "embeded'quote"} } },
        -parent     => 'Own_Parent';
    Own_Child_4->new->m1 eq "embeded'quote"
};

Report_Results;
