X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=t%2F010_basics%2Ffailing%2F010_method_modifier_with_regexp.t;fp=t%2F010_basics%2Ffailing%2F010_method_modifier_with_regexp.t;h=786b8c37db9d7245c544ba619343f25b9d33d00a;hp=0000000000000000000000000000000000000000;hb=60ad2cb7bf657ab608ab73b9fc7895008d220b7b;hpb=924c05c360ec9003649c5886fed23836bcafa8b4

diff --git a/t/010_basics/failing/010_method_modifier_with_regexp.t b/t/010_basics/failing/010_method_modifier_with_regexp.t
new file mode 100755
index 0000000..786b8c3
--- /dev/null
+++ b/t/010_basics/failing/010_method_modifier_with_regexp.t
@@ -0,0 +1,84 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+use Test::Exception;
+
+{
+
+    package Dog;
+    use Mouse;
+
+    sub bark_once {
+        my $self = shift;
+        return 'bark';
+    }
+
+    sub bark_twice {
+        return 'barkbark';
+    }
+
+    around qr/bark.*/ => sub {
+        'Dog::around(' . $_[0]->() . ')';
+    };
+
+}
+
+my $dog = Dog->new;
+is( $dog->bark_once,  'Dog::around(bark)', 'around modifier is called' );
+is( $dog->bark_twice, 'Dog::around(barkbark)', 'around modifier is called' );
+
+{
+
+    package Cat;
+    use Mouse;
+    our $BEFORE_BARK_COUNTER = 0;
+    our $AFTER_BARK_COUNTER  = 0;
+
+    sub bark_once {
+        my $self = shift;
+        return 'bark';
+    }
+
+    sub bark_twice {
+        return 'barkbark';
+    }
+
+    before qr/bark.*/ => sub {
+        $BEFORE_BARK_COUNTER++;
+    };
+
+    after qr/bark.*/ => sub {
+        $AFTER_BARK_COUNTER++;
+    };
+
+}
+
+my $cat = Cat->new;
+$cat->bark_once;
+is( $Cat::BEFORE_BARK_COUNTER, 1, 'before modifier is called once' );
+is( $Cat::AFTER_BARK_COUNTER,  1, 'after modifier is called once' );
+$cat->bark_twice;
+is( $Cat::BEFORE_BARK_COUNTER, 2, 'before modifier is called twice' );
+is( $Cat::AFTER_BARK_COUNTER,  2, 'after modifier is called twice' );
+
+{
+    package Dog::Role;
+    use Mouse::Role;
+
+    ::dies_ok {
+        before qr/bark.*/ => sub {};
+    } '... this is not currently supported';
+
+    ::dies_ok {
+        around qr/bark.*/ => sub {};
+    } '... this is not currently supported';
+
+    ::dies_ok {
+        after  qr/bark.*/ => sub {};
+    } '... this is not currently supported';
+
+}
+