backcompat for NEXT in &COMPONENT + test
Guillermo Roditi [Mon, 23 Jun 2008 21:20:41 +0000 (21:20 +0000)]
r18399@martha (orig r7893):  groditi | 2008-06-04 12:15:25 -0400

lib/Catalyst/Component.pm
t/unit_core_component_mro.t [new file with mode: 0644]

index 876f682..0d80785 100644 (file)
@@ -1,8 +1,11 @@
 package Catalyst::Component;
 
 use Moose;
+use Class::MOP;
 use MooseX::Adopt::Class::Accessor::Fast;
 use Catalyst::Utils;
+use MRO::Compat;
+use mro 'c3';
 
 with 'MooseX::Emulate::Class::Accessor::Fast';
 with 'Catalyst::ClassData';
@@ -70,6 +73,12 @@ sub COMPONENT {
 
     # Temporary fix, some components does not pass context to constructor
     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
+    if( my $next = $self->next::can ){
+      my $class = blessed $self || $self;
+      my ($next_package) = Class::MOP::get_code_info($next);
+      warn "There is a COMPONENT method resolving after Catalyst::Component in ${next_package}. This behavior is deprecated and will stop working in future releases.";
+      return $next->($self, $arguments);
+    }
     return $self->new($c, $arguments);
 }
 
diff --git a/t/unit_core_component_mro.t b/t/unit_core_component_mro.t
new file mode 100644 (file)
index 0000000..7818402
--- /dev/null
@@ -0,0 +1,26 @@
+use Test::More tests => 2;
+use strict;
+use warnings;
+
+{
+  package MyApp::Component;
+  use Test::More;
+
+  sub COMPONENT{
+    my $caller = caller;
+    is($caller, 'Catalyst::Component', 'Correct method resolution');
+  }
+
+  package MyApp::MyComponent;
+
+  use base 'Catalyst::Component', 'MyApp::Component';
+
+}
+
+{
+  my $expects = qr/after Catalyst::Component in MyApp::Component/;
+  local $SIG{__WARN__} = sub {
+    like($_[0], $expects, 'correct warning thrown');
+  };
+  MyApp::MyComponent->COMPONENT('MyApp');
+}