The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

use strict;
use warnings;
use 5.016;

use Test::More;

use mop;

# create a meta-class (class to create classes with)
role WithData {

    has $!data = [];

    method get_data { $!data }

    method add_to_data ($value) {
        push @{$!data} => $value;
    }
}

sub data {
    my ($meta, @data) = @_;
    if (!$meta->does('WithData')) {
        my $class = mop::meta($meta);
        my $new_subclass = mop::meta($class)->new_instance(
            name       => sprintf("mop::instance_application::%d", ++state($i)),
            superclass => $class->name,
            roles      => [ mop::meta('WithData') ],
        );
        $new_subclass->FINALIZE;

        mop::rebless $meta, $new_subclass->name;
    }
    $meta->add_to_data($_) for @data;
}

# create a class (using our meta-class)
class Foo is data {
    method get_meta_data {
        mop::meta($self)->get_data
    }
}

# create a class (using our meta-class and extra data)
class Bar is data(1, 2, 3) {
    method get_meta_data {
        mop::meta($self)->get_data
    }
}

ok(mop::meta('Foo')->isa( 'mop::object' ), '... Foo is an Object');
ok(mop::meta('Foo')->isa( 'mop::class' ), '... Foo is a Class');
ok(mop::meta('Foo')->does( 'WithData' ), '... Foo does WithData');

is_deeply(mop::meta('Foo')->get_data, [], '... called the static method on Foo');

ok(mop::meta('Bar')->isa( 'mop::object' ), '... Bar is an Object');
ok(mop::meta('Bar')->isa( 'mop::class' ), '... Bar is a Class');
ok(mop::meta('Bar')->does( 'WithData' ), '... Bar does WithData');

is_deeply(mop::meta('Bar')->get_data, [ 1, 2, 3 ], '... called the static method on Bar');

isnt(mop::meta('Foo')->get_data, mop::meta('Bar')->get_data, '... the two classes share a different class level data');

{
    my $foo = Foo->new;
    ok($foo->isa( 'Foo' ), '... got an instance of Foo');
    is_deeply($foo->get_meta_data, [], '... got the expected foo metadata');
    is($foo->get_meta_data, mop::meta('Foo')->get_data, '... and it matches the metadata for Foo');

    my $foo2 = Foo->new;
    ok($foo2->isa( 'Foo' ), '... got an instance of Foo');
    is_deeply($foo2->get_meta_data, [], '... got the expected foo metadata');
    is($foo2->get_meta_data, mop::meta('Foo')->get_data, '... and it matches the metadata for Foo');
    is($foo2->get_meta_data, $foo->get_meta_data, '... and it is shared across instances');

    mop::meta('Foo')->add_to_data( 10 );
    is_deeply(mop::meta('Foo')->get_data, [ 10 ], '... got the expected (changed) Foo metadata');

    is_deeply($foo->get_meta_data, [ 10 ], '... got the expected (changed) foo metadata');
    is_deeply($foo2->get_meta_data, [ 10 ], '... got the expected (changed) foo metadata');

    is($foo->get_meta_data, mop::meta('Foo')->get_data, '... and it matches the metadata for Foo still');
    is($foo2->get_meta_data, mop::meta('Foo')->get_data, '... and it matches the metadata for Foo still');
    is($foo2->get_meta_data, $foo->get_meta_data, '... and it is shared across instances still');
}

{
    my $bar = Bar->new;
    ok($bar->isa( 'Bar' ), '... got an instance of Bar');
    is_deeply($bar->get_meta_data, [ 1, 2, 3 ], '... got the expected bar metadata');
    is($bar->get_meta_data, mop::meta('Bar')->get_data, '... and it matches the metadata for Bar');

    my $bar2 = Bar->new;
    ok($bar2->isa( 'Bar' ), '... got an instance of Bar');
    is_deeply($bar2->get_meta_data, [1, 2, 3], '... got the expected bar metadata');
    is($bar2->get_meta_data, mop::meta('Bar')->get_data, '... and it matches the metadata for Bar');
    is($bar2->get_meta_data, $bar->get_meta_data, '... and it is shared across instances');

    mop::meta('Bar')->add_to_data( 10 );
    is_deeply(mop::meta('Bar')->get_data, [ 1, 2, 3, 10 ], '... got the expected (changed) Bar metadata');

    is_deeply($bar->get_meta_data, [ 1, 2, 3, 10 ], '... got the expected (changed) bar metadata');
    is_deeply($bar2->get_meta_data, [ 1, 2, 3, 10 ], '... got the expected (changed) bar metadata');

    is($bar->get_meta_data, mop::meta('Bar')->get_data, '... and it matches the metadata for Bar still');
    is($bar2->get_meta_data, mop::meta('Bar')->get_data, '... and it matches the metadata for Bar still');
    is($bar2->get_meta_data, $bar->get_meta_data, '... and it is shared across instances still');

    is_deeply(mop::meta('Foo')->get_data, [ 10 ], '... got the expected (unchanged) Foo metadata');
}

done_testing;