1use Test::More 'no_plan';
2
3package MyBase;
4use Class::Std;
5{
6    sub everyone             { return 'everyone' }
7    sub family   :RESTRICTED { return 'family'   }
8    sub personal :PRIVATE    { return 'personal' }
9
10    sub try_all {
11        $self = shift;
12        for my $method (qw(everyone family personal)) {
13            ::is $self->$method(), $method => "Called $method";
14        }
15    }
16}
17
18package MyDer;
19use Class::Std;
20use base qw( MyBase );
21{
22    sub everyone             { my $self = shift; $self->SUPER::everyone(); }
23    sub family   :RESTRICTED { my $self = shift; $self->SUPER::family(); }
24    sub personal :PRIVATE    { my $self = shift; $self->SUPER::personal(); }
25}
26
27package main;
28
29my $base_obj = MyBase->new();
30my $der_obj  = MyDer->new();
31
32$base_obj->try_all();
33
34ok !eval { $der_obj->try_all(); 1 }   => 'Derived call failed';
35like $@, qr/Can't call private method MyDer::personal\(\) from class MyBase/
36                                      => '...with correct error message';
37
38
39is $base_obj->everyone, 'everyone' => 'External everyone succeeded';
40ok !eval { $base_obj->family }     => 'External family failed as expected';
41like $@, qr/Can't call restricted method MyBase::family\(\) from class main/
42                                      => '...with correct error message';
43
44ok !eval { $base_obj->personal }   => 'External personal failed as expected';
45
46like $@, qr/Can't call private method MyBase::personal\(\) from class main/
47                                      => '...with correct error message';
48
49is $der_obj->everyone, 'everyone' => 'External derived everyone succeeded';
50ok !eval { $der_obj->family }     => 'External derived family failed as expected';
51like $@, qr/Can't call restricted method MyDer::family\(\) from class main/
52                                      => '...with correct error message';
53
54ok !eval { $der_obj->personal }   => 'External derived personal failed as expected';
55
56like $@, qr/Can't call private method MyDer::personal\(\) from class main/
57                                      => '...with correct error message';
58
59