File: 07-trigger.t

package info (click to toggle)
libmoosex-attributeshortcuts-perl 0.024-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 312 kB
  • ctags: 9
  • sloc: perl: 326; makefile: 2
file content (54 lines) | stat: -rw-r--r-- 1,090 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
use strict;
use warnings;

my $trigger_called = 0;

{
    package TestClass;

    use Moose;
    use namespace::autoclean;
    use MooseX::AttributeShortcuts;

    has foo => (is => 'rwp');
    has bar => (is => 'ro', builder => 1);
    has baz => (is => 'rwp', builder => 1);

    sub _build_bar {}
    sub _build_baz {}

    has fee => (is => 'rw', trigger => 1);
    sub _trigger_fee { $trigger_called++ }

    has _foe => (is => 'rw', trigger => 1);
    sub _trigger__foe { $trigger_called++ }
}

use Test::More;
use Test::Moose;

require 't/funcs.pm' unless eval { require funcs };

with_immutable {

    test_class('TestClass');

    for my $name (qw{ fee _foe }) {

        $trigger_called = 0;

        my $a = TestClass->meta->get_attribute($name);
        ok $a->has_trigger, "$name has a trigger";

        ok !$trigger_called, 'no trigger calls yet';
        my $tc = TestClass->new($name => 'Ian');
        is $trigger_called, 1, 'trigger called once';
        $tc->$name('Cormac');
        is $trigger_called, 2, 'trigger called again';

    }

} 'TestClass';

done_testing;