########################################################################
# housekeeping
########################################################################
package Testify;
use v5.34;
use mro qw( c3 );
use FindBin::libs;

use Test::More;

use List::Util  qw( uniq );

my $madness = 'Object::Lvalue';
my @base_methodz
= qw
(
    new
    construct
    initialize

    shallow
    clone

    DESTROY
    cleanup

    class_attr
    attributes

    verbose
);

require_ok $madness;

#$madness->verbose   = 1;

########################################################################
# set up the test packges

# order of inheritence must go down @classdefz.
# two classes share a parent.

my @classdefz   = 
(
    # class  base       attributes

    [ foo => ''  => qw( bar bletch blort   ) ]
  , [ bim => foo => qw( bam                ) ]
  , [ fee => foo => qw( fie foe fum        ) ]
);
my %class2attrz = ();

note "Class meta:\n", explain \@classdefz;

for( @classdefz )
{
    local $"    = ' ';
    state $obj  = '$obj';
    state $ISA  = '@ISA';

    my ( $class, $base, @pkg_attrz ) = @$_;
    note "Install: $class ($base) => @pkg_attrz";

    # install the class itself

    my $pkg = <<"PKG";
package $class;
use v5.34;
BEGIN
{
    # r/p parent w/o exterior module files.
    our $ISA = qw( $base );
}

use $madness qw( @pkg_attrz );

sub initialize
{
    my $obj    = shift;
    $obj->\$_   = ( 2 * shift )
    for $obj->attributes;
}

1
PKG

    note "$pkg";
    eval qq|$pkg|
    // BAIL_OUT "Failed prepare: $class, $@";

    # compte the attribute metadata for testing

    my $class_attrz = $class2attrz{ $class } = {};

    $class_attrz->{ class_attr  } = \@pkg_attrz;
    $class_attrz->{ attributes  } = 
    [
        uniq
        map
        {
            if( my $prior = $class2attrz{ $_ }{ class_attr } )
            {
                @$prior
            }
            else
            {
                ()
            }
        }
        $class->mro::get_linear_isa->@*
    ];
}

note "Attr meta:\n", explain \%class2attrz;

########################################################################
# test the packages

$DB::single = 1;

for( @classdefz )
{
    my ( $class ) = $_->[0];

    while
    (
        my ( $method, $expect ) 
        = each $class2attrz{ $class }->%*
    )
    {
        my $found   = $class->$method;

        my $attrs   = join ' ' => @$found;

        is_deeply $found, $expect, "$class $method => $attrs"
        or diag
            "Mismatched $method:\n",
          , "Expect:\n", explain $expect
          ,  "Found:\n", explain $found
        ;
    }
}

pass 'Survived';
done_testing;
__END__
