Perltidy this code a bit.
[gitmo/Moose.git] / t / 010_basics / 010_method_modifier_with_regexp.t
CommitLineData
5f71050b 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
634c8bda 6use Test::More tests => 10;
401cb5a6 7use Test::Exception;
5f71050b 8
9BEGIN {
10 use_ok('Moose');
11}
12
13{
14
15 package Dog;
16 use Moose;
17
18 sub bark_once {
19 my $self = shift;
20 return 'bark';
21 }
22
23 sub bark_twice {
24 return 'barkbark';
25 }
26
27 around qr/bark.*/ => sub {
401cb5a6 28 'Dog::around(' . $_[0]->() . ')';
5f71050b 29 };
30
31}
32
33my $dog = Dog->new;
401cb5a6 34is( $dog->bark_once, 'Dog::around(bark)', 'around modifier is called' );
35is( $dog->bark_twice, 'Dog::around(barkbark)', 'around modifier is called' );
5f71050b 36
37{
38
39 package Cat;
40 use Moose;
41 our $BEFORE_BARK_COUNTER = 0;
42 our $AFTER_BARK_COUNTER = 0;
43
44 sub bark_once {
45 my $self = shift;
46 return 'bark';
47 }
48
49 sub bark_twice {
50 return 'barkbark';
51 }
52
53 before qr/bark.*/ => sub {
54 $BEFORE_BARK_COUNTER++;
55 };
56
57 after qr/bark.*/ => sub {
58 $AFTER_BARK_COUNTER++;
59 };
60
61}
62
63my $cat = Cat->new;
64$cat->bark_once;
65is( $Cat::BEFORE_BARK_COUNTER, 1, 'before modifier is called once' );
66is( $Cat::AFTER_BARK_COUNTER, 1, 'after modifier is called once' );
67$cat->bark_twice;
68is( $Cat::BEFORE_BARK_COUNTER, 2, 'before modifier is called twice' );
69is( $Cat::AFTER_BARK_COUNTER, 2, 'after modifier is called twice' );
70
71{
401cb5a6 72 package Dog::Role;
73 use Moose::Role;
5f71050b 74
401cb5a6 75 ::dies_ok {
76 before qr/bark.*/ => sub {};
77 } '... this is not currently supported';
5f71050b 78
401cb5a6 79 ::dies_ok {
80 around qr/bark.*/ => sub {};
81 } '... this is not currently supported';
5f71050b 82
401cb5a6 83 ::dies_ok {
84 after qr/bark.*/ => sub {};
85 } '... this is not currently supported';
5f71050b 86
87}
88