The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;

use mop;

use B::Deparse;

class Foo {
    method foo { __CLASS__ }
    method bar { __PACKAGE__ }
}
{
    my $method = mop::meta('Foo')->get_method('foo');
    my $body = mop::meta($method)->get_attribute('$!body')->fetch_data_in_slot_for($method);
    unlike(B::Deparse->new->coderef2text($body), qr/__CLASS__/);
}

is(Foo->foo, 'Foo');
is(Foo->bar, 'main');

role Bar {
    method foo { __ROLE__ }
    method bar { __PACKAGE__ }
}
class Baz with Bar { }
{
    my $method = mop::meta('Bar')->get_method('foo');
    my $body = mop::meta($method)->get_attribute('$!body')->fetch_data_in_slot_for($method);
    unlike(B::Deparse->new->coderef2text($body), qr/__ROLE__/);
}

is(Baz->foo, 'Bar');
is(Baz->bar, 'main');

eval "
class Error {
    method foo { __ROLE__ }
}
";
like($@, qr/Bareword "__ROLE__" not allowed/);

eval "
role Error2 {
    method foo { __CLASS__ }
}
";
like($@, qr/Bareword "__CLASS__" not allowed/);

eval "__CLASS__";
like($@, qr/Bareword "__CLASS__" not allowed/);
eval "__ROLE__";
like($@, qr/Bareword "__ROLE__" not allowed/);

package InPackage {
    use mop;

    class Foo {
        method foo { __CLASS__ }
        method bar { __PACKAGE__ }
    }
    role Bar {
        method foo { __ROLE__ }
        method bar { __PACKAGE__ }
    }
    class Baz with InPackage::Bar { }
}

is(InPackage::Foo->foo, 'InPackage::Foo');
is(InPackage::Foo->bar, 'InPackage');
is(InPackage::Baz->foo, 'InPackage::Bar');
is(InPackage::Baz->bar, 'InPackage');

done_testing;