bareword slots

#!perl

use v5.18;

use strict;
use warnings;

use Test::More;
use Test::Fatal;

package Foo {
    use strict;
    use warnings;

    use experimental qw[ lexical_subs ];

    sub new {
        my ($class, %args) = @_;
        bless {
            bar   => $args{bar},
            alpha => $args{alpha},
        } => $class;
    }

    my sub bar () {
        local @DB::args = ();
        package DB { my () = caller(1) }
        $DB::args[0]->{bar};
    }

    sub baz {
        bar;
    }

    sub gorch {
        bar->baz;
    }

    my sub alpha () {
        local @DB::args = ();
        package DB { my () = caller(1) }
        $DB::args[0]->{alpha};
    }

    sub alpha_baz {
        join ', ' => alpha // 'undef', baz;
    }

}


subtest '... what happens when we have nothing there?' => sub {
    my $foo = Foo->new;
    ok(not(defined($foo->{bar})), '... no bar');

    like(
        exception { $foo->gorch },
        qr/Can't call method \"baz\" .* undefined value .* line 36\./,
        '... correctly report the slot name, that it is undefined and the line number/source location'
    );
};

subtest '... can the `baz` method read the value correctly through the private accessor?' => sub {
    my $foo = Foo->new( bar => 10 );
    ok(defined($foo->{bar}), '... got bar');

    is($foo->baz, 10, '... got the right value in bar (read interally via the private accessor)');

    like(
        exception { $foo->gorch },
        qr/Can\'t locate object method \"baz\" via package \"10\" .* line 36\./,
        '... correctly report the slot name, that it is undefined and the line number/source location'
    );
};

subtest '... can the `gorch` method call the `baz` method of the embedded object?' => sub {
    my $foo = Foo->new( bar => Foo->new( bar => 100 ) );
    ok(defined($foo->{bar}), '... got bar');

    isa_ok($foo->baz, 'Foo');
    is($foo->gorch, 100, '... got the right value from the delegated call whose invocant is a private accessor call');
};


done_testing;