The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;

use mop;

role Foo {
    has $!foo is ro = 10;
}

class Bar with Foo {
    has $!bar is ro = 20;
}

class Baz extends Bar {
    has $!baz is ro = 30;
}

{
    my $baz = Baz->new;
    is_deeply(
        mop::dump_object($baz),
        {
            __ID__    => mop::id($baz),
            __CLASS__ => 'Baz',
            __SELF__  => $baz,
            '$!foo'   => 10,
            '$!bar'   => 20,
            '$!baz'   => 30,
        }
    );
}

{
    my $bar = Bar->new;
    my $baz = Baz->new(foo => $bar);
    is_deeply(
        mop::dump_object($baz),
        {
            __ID__    => mop::id($baz),
            __CLASS__ => 'Baz',
            __SELF__  => $baz,
            '$!foo'   => {
                __ID__    => mop::id($bar),
                __CLASS__ => 'Bar',
                __SELF__  => $bar,
                '$!foo'   => 10,
                '$!bar'   => 20,
            },
            '$!bar'   => 20,
            '$!baz'   => 30,
        }
    );
}

# see https://github.com/pjcj/Devel--Cover/issues/72
SKIP: { skip "__SUB__ is broken with Devel::Cover", 1 if $INC{'Devel/Cover.pm'};
{
    my $bar = Bar->new(foo => [1, "foo"], bar => { quux => 10 });
    my $baz = Baz->new(baz => { a => [ 2, $bar ] });
    is_deeply(
        mop::dump_object($baz),
        {
            __ID__    => mop::id($baz),
            __CLASS__ => 'Baz',
            __SELF__  => $baz,
            '$!foo'   => 10,
            '$!bar'   => 20,
            '$!baz'   => {
                a => [
                    2,
                    {
                        __ID__    => mop::id($bar),
                        __CLASS__ => 'Bar',
                        __SELF__  => $bar,
                        '$!foo'   => [ 1, "foo" ],
                        '$!bar'   => { quux => 10 },
                    },
                ],
            },
        }
    );
}
}

class Quux {
    has $!storage = 10;
}

{
    my $quux = Quux->new;
    is_deeply(
        mop::dump_object($quux),
        {
            __ID__      => mop::id($quux),
            __CLASS__   => 'Quux',
            __SELF__    => $quux,
            '$!storage' => 10,
        }
    );
}

# see https://github.com/pjcj/Devel--Cover/issues/72
SKIP: { skip "__SUB__ is broken with Devel::Cover", 4 if $INC{'Devel/Cover.pm'};
{
    my $Foo = mop::meta('Foo');
    my $dump = mop::dump_object($Foo);

    is(
        $dump->{'$!attributes'}{'$!foo'}{'__SELF__'},
        $Foo->get_attribute('$!foo'),
    );
    delete $dump->{'$!attributes'}{'$!foo'};
    is(
        $dump->{'$!methods'}{'foo'}{'__SELF__'},
        $Foo->get_method('foo'),
    );
    delete $dump->{'$!methods'}{'foo'};

    is_deeply(
        $dump,
        {
            __ID__               => mop::id($Foo),
            __CLASS__            => 'mop::role',
            __SELF__             => $Foo,
            '$!name'             => 'Foo',
            '$!version'          => undef,
            '$!authority'        => undef,
            '$!roles'            => [],
            '$!attributes'       => {},
            '$!methods'          => {},
            '$!required_methods' => {},
            '$!callbacks'        => undef,
        }
    );
}

{
    my $Bar = mop::meta('Bar');
    my $dump = mop::dump_object($Bar);

    is(
        $dump->{'$!attributes'}{'$!foo'}{'__SELF__'},
        $Bar->get_attribute('$!foo'),
    );
    delete $dump->{'$!attributes'}{'$!foo'};
    is(
        $dump->{'$!methods'}{'foo'}{'__SELF__'},
        $Bar->get_method('foo'),
    );
    delete $dump->{'$!methods'}{'foo'};
    is(
        $dump->{'$!attributes'}{'$!bar'}{'__SELF__'},
        $Bar->get_attribute('$!bar'),
    );
    delete $dump->{'$!attributes'}{'$!bar'};
    is(
        $dump->{'$!methods'}{'bar'}{'__SELF__'},
        $Bar->get_method('bar'),
    );
    delete $dump->{'$!methods'}{'bar'};
    is(
        $dump->{'$!roles'}[0]{'__SELF__'},
        mop::meta('Foo'),
    );
    shift @{ $dump->{'$!roles'} };
    is(ref($dump->{'$!instance_generator'}), 'CODE');
    delete $dump->{'$!instance_generator'};

    is_deeply(
        $dump,
        {
            __ID__               => mop::id($Bar),
            __CLASS__            => 'mop::class',
            __SELF__             => $Bar,
            '$!name'             => 'Bar',
            '$!version'          => undef,
            '$!authority'        => undef,
            '$!roles'            => [],
            '$!attributes'       => {},
            '$!methods'          => {},
            '$!required_methods' => {},
            '$!callbacks'        => undef,
            '$!superclass'       => 'mop::object',
            '$!is_abstract'      => 0,
        }
    );
}

{
    my $Bar = mop::meta('Bar');
    my $bar = $Bar->get_attribute('$!bar');
    my $dump = mop::dump_object($bar);

    is($dump->{'$!associated_meta'}{'__SELF__'}, $Bar);
    delete $dump->{'$!associated_meta'};

    is_deeply(
        $dump,
        {
            __ID__          => mop::id($bar),
            __CLASS__       => 'mop::attribute',
            __SELF__        => $bar,
            '$!name'        => '$!bar',
            '$!default'     => 20,
            '$!storage'     => '__INTERNAL_DETAILS__',
            '$!original_id' => mop::id($bar),
            '$!callbacks'   => undef,
        }
    );
}

{
    my $Bar = mop::meta('Bar');
    my $bar = $Bar->get_method('bar');
    my $dump = mop::dump_object($bar);

    is(ref($dump->{'$!body'}), 'CODE');
    delete $dump->{'$!body'};
    is($dump->{'$!associated_meta'}{'__SELF__'}, $Bar);
    delete $dump->{'$!associated_meta'};

    is_deeply(
        $dump,
        {
            __ID__          => mop::id($bar),
            __CLASS__       => 'mop::method',
            __SELF__        => $bar,
            '$!name'        => 'bar',
            '$!original_id' => mop::id($bar),
            '$!callbacks'   => undef,
        }
    );
}
}

{
    my $nonmop = bless {}, 'NonMop';
    my $bar = Bar->new(bar => $nonmop);
    is_deeply(
        mop::dump_object($bar),
        {
            __ID__          => mop::id($bar),
            __CLASS__       => 'Bar',
            __SELF__        => $bar,
            '$!foo'         => 10,
            '$!bar'         => $nonmop,
        }
    );
}

done_testing;