From: gfx <gfuji@cpan.org>
Date: Fri, 25 Sep 2009 09:40:44 +0000 (+0900)
Subject: Method modifiers are implemented in Mouse
X-Git-Tag: 0.35~15
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=43e6a50b260b096a34b0c46da87296bd220c4184;p=gitmo%2FMouse.git

Method modifiers are implemented in Mouse
---

diff --git a/lib/Mouse/Spec.pm b/lib/Mouse/Spec.pm
index ae173c1..f422d71 100644
--- a/lib/Mouse/Spec.pm
+++ b/lib/Mouse/Spec.pm
@@ -1,7 +1,6 @@
 package Mouse::Spec;
-
 use strict;
-use version;
+use warnings;
 
 our $VERSION = '0.33';
 
@@ -11,6 +10,5 @@ our $MooseVersion = '0.90';
 sub MouseVersion{ $MouseVersion }
 sub MooseVersion{ $MooseVersion }
 
-
 1;
 __END__
diff --git a/t/000-load.t b/t/000-load.t
index 0dceaec..e22f9ab 100644
--- a/t/000-load.t
+++ b/t/000-load.t
@@ -9,6 +9,8 @@ use_ok 'Mouse';
 no warnings 'uninitialized';
 
 diag "Soft dependency versions:";
+
+eval{ require MRO::Compat };
 diag "    MRO::Compat: $MRO::Compat::VERSION";
 
 eval { require Moose };
@@ -17,7 +19,3 @@ diag "    Moose: $Moose::VERSION";
 
 eval { require Class::Method::Modifiers::Fast };
 diag "    Class::Method::Modifiers::Fast: $Class::Method::Modifiers::Fast::VERSION";
-
-eval { require Class::Method::Modifiers };
-diag "    Class::Method::Modifiers: $Class::Method::Modifiers::VERSION";
-
diff --git a/t/000-recipes/001_point.t b/t/000-recipes/001_point.t
index 90b989b..0d1b9a9 100644
--- a/t/000-recipes/001_point.t
+++ b/t/000-recipes/001_point.t
@@ -3,15 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More;
-BEGIN {
-    if (eval "require Class::Method::Modifiers; 1") {
-        plan tests => 59;
-    }
-    else {
-        plan skip_all => "Class::Method::Modifiers required for this test";
-    }
-}
+use Test::More tests => 59;
 
 use Mouse::Util;
 use Test::Exception;
diff --git a/t/000-recipes/002_schwartz_tutorial.t b/t/000-recipes/002_schwartz_tutorial.t
index c15003e..b82572b 100755
--- a/t/000-recipes/002_schwartz_tutorial.t
+++ b/t/000-recipes/002_schwartz_tutorial.t
@@ -12,16 +12,6 @@ use strict;
 use warnings;
 use Test::More;
 
-BEGIN {
-    plan skip_all => 
-            "This test requires Class::Method::Modifiers or Class::Method::Modifiers::Fast" 
-        unless eval { 
-            require Class::Method::Modifiers::Fast;
-        } or   eval {
-            require Class::Method::Modifiers;
-        };
-}
-
 # functions to capture the output of the tutorial
 our $DUMMY_STDOUT = "";
 sub dprint { $DUMMY_STDOUT .= join "", @_ };
diff --git a/t/000-recipes/moose_cookbook_basics_recipe2.t b/t/000-recipes/moose_cookbook_basics_recipe2.t
index d7cb28f..5949981 100644
--- a/t/000-recipes/moose_cookbook_basics_recipe2.t
+++ b/t/000-recipes/moose_cookbook_basics_recipe2.t
@@ -1,15 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More;
-BEGIN{
-    if(eval{ require Class::Method::Modifiers::Fast } || eval{ require Class::Method::Modifiers }){
-        plan 'no_plan';
-    }
-    else{
-        plan skip_all => 'This test requires Class::Method::Modifiers(::Fast)?';
-    }
-}
+use Test::More 'no_plan';
 
 use Test::Exception;
 $| = 1;
diff --git a/t/000-recipes/moose_cookbook_basics_recipe4.t b/t/000-recipes/moose_cookbook_basics_recipe4.t
index c7f0089..7f8f907 100644
--- a/t/000-recipes/moose_cookbook_basics_recipe4.t
+++ b/t/000-recipes/moose_cookbook_basics_recipe4.t
@@ -3,17 +3,12 @@
 use strict;
 use Test::More;
 BEGIN{
-    if(eval{ require Class::Method::Modifiers::Fast } || eval{ require Class::Method::Modifiers }){
-        eval 'use Regexp::Common; use Locale::US;';
-        if ($@) {
-            plan skip_all => 'Regexp::Common & Locale::US required for this test';
-        }
-        else{
-            plan 'no_plan';
-        }
+    eval 'use Regexp::Common; use Locale::US;';
+    if ($@) {
+        plan skip_all => 'Regexp::Common & Locale::US required for this test';
     }
     else{
-        plan skip_all => 'This test requires Class::Method::Modifiers(::Fast)?';
+        plan 'no_plan';
     }
 }
 
diff --git a/t/020_attributes/015_attribute_traits.t b/t/020_attributes/015_attribute_traits.t
index 2c557ca..aaa6ece 100644
--- a/t/020_attributes/015_attribute_traits.t
+++ b/t/020_attributes/015_attribute_traits.t
@@ -4,15 +4,8 @@ use lib 't/lib';
 use strict;
 use warnings;
 
-use Test::More;
-BEGIN{
-    if(eval{ require Class::Method::Modifiers::Fast } || eval{ require Class::Method::Modifiers }){
-        plan tests => 12;
-    }
-    else{
-        plan skip_all => 'This test requires Class::Method::Modifiers(::Fast)?';
-    }
-}
+use Test::More tests => 12;
+
 use Test::Exception;
 use Test::Mouse;
 
diff --git a/t/027-modifiers.t b/t/027-modifiers.t
index 84e3930..b8560ba 100644
--- a/t/027-modifiers.t
+++ b/t/027-modifiers.t
@@ -2,15 +2,7 @@
 use strict;
 use warnings;
 
-use Test::More;
-BEGIN {
-    if (eval "require Class::Method::Modifiers; 1") {
-        plan tests => 1;
-    }
-    else {
-        plan skip_all => "Class::Method::Modifiers required for this test";
-    }
-}
+use Test::More tests => 25;
 
 my @seen;
 my @expected = ("before 4",
@@ -117,3 +109,152 @@ BEGIN {
     };
 }
 
+# from Class::Method::Modifers' t/020-multiple-inheritance.t
+
+# inheritance tree looks like:
+#
+#    SuperL        SuperR
+#      \             /
+#      MiddleL  MiddleR
+#         \       /
+#          -Child-
+
+# the Child and MiddleR modules use modifiers
+# Child will modify a method in SuperL (sl_c)
+# Child will modify a method in SuperR (sr_c)
+# Child will modify a method in SuperR already modified by MiddleR (sr_m_c)
+# SuperL and MiddleR will both have a method of the same name, doing different
+#     things (called 'conflict' and 'cnf_mod')
+
+# every method and modifier will just return <Class:Method:STUFF>
+
+BEGIN
+{
+    {
+        package SuperL;
+        use Mouse;
+
+        sub superl { "<SuperL:superl>" }
+        sub conflict { "<SuperL:conflict>" }
+        sub cnf_mod { "<SuperL:cnf_mod>" }
+        sub sl_c { "<SuperL:sl_c>" }
+    }
+
+    {
+        package SuperR;
+        use Mouse;
+
+        sub superr { "<SuperR:superr>" }
+        sub sr_c { "<SuperR:sr_c>" }
+        sub sr_m_c { "<SuperR:sr_m_c>" }
+    }
+
+    {
+        package MiddleL;
+        use Mouse;
+        extends 'SuperL';
+
+        sub middlel { "<MiddleL:middlel>" }
+    }
+
+    {
+        package MiddleR;
+        use Mouse;
+        extends 'SuperR';
+
+        sub middler { "<MiddleR:middler>" }
+        sub conflict { "<MiddleR:conflict>" }
+        sub cnf_mod { "<MiddleR:cnf_mod>" }
+        around sr_m_c => sub {
+            my $orig = shift;
+            return "<MiddleR:sr_m_c:".$orig->(@_).">"
+        };
+    }
+
+    {
+        package Child;
+        use Mouse;
+        extends qw(MiddleL MiddleR);
+
+        sub child { "<Child:child>" }
+        around cnf_mod => sub { "<Child:cnf_mod:".shift->(@_).">" };
+        around sl_c => sub { "<Child:sl_c:".shift->(@_).">" };
+        around sr_c => sub { "<Child:sr_c:".shift->(@_).">" };
+        around sr_m_c => sub {
+            my $orig = shift;
+            return "<Child:sr_m_c:".$orig->(@_).">"
+        };
+    }
+}
+
+
+my $SuperL = SuperL->new();
+my $SuperR = SuperR->new();
+my $MiddleL = MiddleL->new();
+my $MiddleR = MiddleR->new();
+my $Child = Child->new();
+
+is($SuperL->superl, "<SuperL:superl>", "SuperL loaded correctly");
+is($SuperR->superr, "<SuperR:superr>", "SuperR loaded correctly");
+is($MiddleL->middlel, "<MiddleL:middlel>", "MiddleL loaded correctly");
+is($MiddleR->middler, "<MiddleR:middler>", "MiddleR loaded correctly");
+is($Child->child, "<Child:child>", "Child loaded correctly");
+
+is($SuperL->sl_c, "<SuperL:sl_c>", "SuperL->sl_c on SuperL");
+is($Child->sl_c, "<Child:sl_c:<SuperL:sl_c>>", "SuperL->sl_c wrapped by Child's around");
+
+is($SuperR->sr_c, "<SuperR:sr_c>", "SuperR->sr_c on SuperR");
+is($Child->sr_c, "<Child:sr_c:<SuperR:sr_c>>", "SuperR->sr_c wrapped by Child's around");
+
+is($SuperR->sr_m_c, "<SuperR:sr_m_c>", "SuperR->sr_m_c on SuperR");
+is($MiddleR->sr_m_c, "<MiddleR:sr_m_c:<SuperR:sr_m_c>>", "SuperR->sr_m_c wrapped by MiddleR's around");
+is($Child->sr_m_c, "<Child:sr_m_c:<MiddleR:sr_m_c:<SuperR:sr_m_c>>>", "MiddleR->sr_m_c's wrapping wrapped by Child's around");
+
+is($SuperL->conflict, "<SuperL:conflict>", "SuperL->conflict on SuperL");
+is($MiddleR->conflict, "<MiddleR:conflict>", "MiddleR->conflict on MiddleR");
+is($Child->conflict, "<SuperL:conflict>", "SuperL->conflict on Child");
+
+is($SuperL->cnf_mod, "<SuperL:cnf_mod>", "SuperL->cnf_mod on SuperL");
+is($MiddleR->cnf_mod, "<MiddleR:cnf_mod>", "MiddleR->cnf_mod on MiddleR");
+is($Child->cnf_mod, "<Child:cnf_mod:<SuperL:cnf_mod>>", "SuperL->cnf_mod wrapped by Child's around");
+
+# taken from Class::Method::Modifiers' t/051-undef-list-ctxt.t
+my($orig_called, $after_called);
+BEGIN
+{
+    package ParentX;
+    use Mouse;
+
+    sub orig
+    {
+        my $self = shift;
+        $orig_called = 1;
+        return;
+    }
+
+    package ChildX;
+    use Mouse;
+    extends 'ParentX';
+
+    after 'orig' => sub
+    {
+        $after_called = 1;
+    };
+}
+
+{
+    ($after_called, $orig_called) = (0, 0);
+    my $child = ChildX->new();
+    my @results = $child->orig();
+
+    ok($orig_called, "original method called");
+    ok($after_called, "after-modifier called");
+    is(@results, 0, "list context with after doesn't screw up 'return'");
+
+    ($after_called, $orig_called) = (0, 0);
+    my $result = $child->orig();
+
+    ok($orig_called, "original method called");
+    ok($after_called, "after-modifier called");
+    is($result, undef, "scalar context with after doesn't screw up 'return'");
+}
diff --git a/t/030_roles/003_apply_role.t b/t/030_roles/003_apply_role.t
index c933208..b4d2b38 100755
--- a/t/030_roles/003_apply_role.t
+++ b/t/030_roles/003_apply_role.t
@@ -3,15 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More;
-BEGIN{
-    if(eval{ require Class::Method::Modifiers::Fast } || eval{ require Class::Method::Modifiers }){
-        plan tests => 86;
-    }
-    else{
-        plan skip_all => 'This test requires Class::Method::Modifiers(::Fast)?';
-    }
-}
+use Test::More tests => 86;
 use Test::Exception;
 
 {
diff --git a/t/030_roles/009_more_role_edge_cases.t b/t/030_roles/009_more_role_edge_cases.t
index 535a00b..1849496 100644
--- a/t/030_roles/009_more_role_edge_cases.t
+++ b/t/030_roles/009_more_role_edge_cases.t
@@ -2,16 +2,7 @@
 
 use strict;
 use warnings;
-use Test::More;
-BEGIN{
-    if(eval{ require Class::Method::Modifiers::Fast } || eval{ require Class::Method::Modifiers }){
-        plan tests => 74;
-    }
-    else{
-        plan skip_all => 'This test requires Class::Method::Modifiers(::Fast)?';
-    }
-}
-
+use Test::More tests => 74;
 use Test::Exception;
 
 
diff --git a/t/030_roles/019_build.t b/t/030_roles/019_build.t
index 1a7a402..c520f81 100755
--- a/t/030_roles/019_build.t
+++ b/t/030_roles/019_build.t
@@ -6,10 +6,6 @@ BEGIN {
     eval "use Test::Output;";
     plan skip_all => "Test::Output is required for this test" if $@;
 
-    unless(eval { require Class::Method::Modifiers::Fast } or eval{ require Class::Method::Modifiers }){
-        plan skip_all => "Class::Method::Modifiers(::Fast)? is required for this test" if $@;
-    }
-
     plan tests => 8;
 }
 
diff --git a/t/200_examples/001_example.t b/t/200_examples/001_example.t
index 58264b0..515fc1a 100644
--- a/t/200_examples/001_example.t
+++ b/t/200_examples/001_example.t
@@ -3,15 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More;
-BEGIN{
-    if(eval{ require Class::Method::Modifiers::Fast } || eval{ require Class::Method::Modifiers }){
-        plan tests => 20;
-    }
-    else{
-        plan skip_all => 'This test requires Class::Method::Modifiers(::Fast)?';
-    }
-}
+use Test::More tests => 20;
 use Test::Exception;
 
 ## Roles
diff --git a/t/400-define-role.t b/t/400-define-role.t
index 1cb7397..47ac4ee 100644
--- a/t/400-define-role.t
+++ b/t/400-define-role.t
@@ -1,15 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More;
-BEGIN{
-    if(eval{ require Class::Method::Modifiers::Fast } || eval{ require Class::Method::Modifiers }){
-        plan tests => 11;
-    }
-    else{
-        plan skip_all => 'This test requires Class::Method::Modifiers(::Fast)?';
-    }
-}
+use Test::More tests => 11;
 use Test::Exception;
 
 lives_ok {
diff --git a/t/403-method-modifiers.t b/t/403-method-modifiers.t
index 8a4317f..67b0d6f 100644
--- a/t/403-method-modifiers.t
+++ b/t/403-method-modifiers.t
@@ -1,15 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More;
-BEGIN {
-    if (eval {require Class::Method::Modifiers::Fast } || eval {require Class::Method::Modifiers }) {
-        plan tests => 4;
-    }
-    else {
-        plan skip_all => "Class::Method::Modifiers required for this test";
-    }
-}
+use Test::More tests => 4;
 use Test::Exception;
 
 my @calls;