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 } };
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 my $foo = Foo->new(one => 1);
72
73 is($foo->one, 1, 'ro reads');
74 ok(exception { $foo->one(-3) }, 'ro dies on write attempt');
75 is($foo->one, 1, 'ro does not write');
76
77 is($foo->two, undef, 'rw reads');
78 $foo->two(-3);
79 is($foo->two, -3, 'rw writes');
80
81 done_testing;