Bump version
[gitmo/Moo.git] / t / method-generate-accessor.t
1 use strictures 1;
2 use Test::More;
3 use Test::Fatal;
4
5 use Method::Generate::Accessor;
6
7 my $gen = Method::Generate::Accessor->new;
8
9 {
10   package Foo;
11   use Moo;
12 }
13
14 {
15   package WithOverload;
16   use overload '&{}' => sub { sub { 5 } }, fallback => 1;
17   sub new { bless {} }
18 }
19
20 $gen->generate_method('Foo' => 'one' => { is => 'ro' });
21
22 $gen->generate_method('Foo' => 'two' => { is => 'rw' });
23
24 like(
25   exception { $gen->generate_method('Foo' => 'three' => {}) },
26   qr/Must have an is/, 'No is rejected'
27 );
28
29 like(
30   exception { $gen->generate_method('Foo' => 'three' => { is => 'purple' }) },
31   qr/Unknown is purple/, 'is purple rejected'
32 );
33
34 for my $setting (qw( default coerce )) {
35   like(
36     exception { $gen->generate_method('Foo' => 'four' => { is => 'ro', $setting => 5 }) },
37     qr/Invalid $setting/, "$setting - scalar rejected"
38   );
39
40   like(
41     exception { $gen->generate_method('Foo' => 'five' => { is => 'ro', $setting => [] }) },
42     qr/Invalid $setting/, "$setting - arrayref rejected"
43   );
44
45   like(
46     exception { $gen->generate_method('Foo' => 'five' => { is => 'ro', $setting => Foo->new }) },
47     qr/Invalid $setting/, "$setting - non-code-convertible object rejected"
48   );
49
50   is(
51     exception { $gen->generate_method('Foo' => 'six' => { is => 'ro', $setting => sub { 5 } }) },
52     undef, "$setting - coderef accepted"
53   );
54
55   is(
56     exception { $gen->generate_method('Foo' => 'seven' => { is => 'ro', $setting => bless sub { 5 } => 'Blah' }) },
57     undef, "$setting - blessed sub accepted"
58   );
59
60   is(
61     exception { $gen->generate_method('Foo' => 'eight' => { is => 'ro', $setting => WithOverload->new }) },
62     undef, "$setting - object with overloaded ->() accepted"
63   );
64
65   like(
66     exception { $gen->generate_method('Foo' => 'nine' => { is => 'ro', $setting => bless {} => 'Blah' }) },
67     qr/Invalid $setting/, "$setting - object rejected"
68   );
69 }
70
71 is(
72   exception { $gen->generate_method('Foo' => 'ten' => { is => 'ro', builder => '_build_ten' }) },
73   undef, 'builder - string accepted',
74 );
75
76 like(
77   exception { $gen->generate_method('Foo' => 'eleven' => { is => 'ro', builder => sub {} }) },
78   qr/Invalid builder/, 'builder - coderef rejected'
79 );
80
81 like(
82   exception { $gen->generate_method('Foo' => 'twelve' => { is => 'ro', builder => 'build:twelve' }) },
83   qr/Invalid builder/, 'builder - invalid name rejected',
84 );
85
86 is(
87   exception { $gen->generate_method('Foo' => 'thirteen' => { is => 'ro', builder => 'build::thirteen' }) },
88   undef, 'builder - fully-qualified name accepted',
89 );
90
91 my $foo = Foo->new(one => 1);
92
93 is($foo->one, 1, 'ro reads');
94 ok(exception { $foo->one(-3) }, 'ro dies on write attempt');
95 is($foo->one, 1, 'ro does not write');
96
97 is($foo->two, undef, 'rw reads');
98 $foo->two(-3);
99 is($foo->two, -3, 'rw writes');
100
101 done_testing;