From: Tomas Doran <bobtfish@bobtfish.net>
Date: Tue, 24 Mar 2009 00:14:08 +0000 (+0000)
Subject: svn merge -r 9548:9549 http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime... 
X-Git-Tag: 5.71001~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=3879ae540f9ad4f33d7ec357114db4070789f827

svn merge -r 9548:9549 dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime/5.80/trunk
Make chaining to yourself explode at app load time
---

diff --git a/Changes b/Changes
index d885eab..8d92492 100644
--- a/Changes
+++ b/Changes
@@ -11,6 +11,9 @@
           for dispatchable actions so that ->visit or ->going to ActionChains
           with qw/Class::Name method_name/ works correctly (t0m)
           - Tests for this (Radoslaw Zielinski)
+        - Throw an exception rather than loading an app if an action
+          tries to chain to itself (t0m)
+          - Tests for this
         - Added Catalyst::Test::ctx_request to be able to inspect
           the context object after a request is made (Jos Boumans)
 
diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm
index dccd3c9..4edb889 100644
--- a/lib/Catalyst/DispatchType/Chained.pm
+++ b/lib/Catalyst/DispatchType/Chained.pm
@@ -222,8 +222,13 @@ sub register {
           "Multiple Chained attributes not supported registering ${action}"
         );
     }
+    my $chained_to = $chained_attr[0];
 
-    my $children = ($self->{children_of}{ $chained_attr[0] } ||= {});
+    Catalyst::Exception->throw(
+      "Actions cannot chain to themselves registering /${action}"
+    ) if ($chained_to eq '/' . $action);
+
+    my $children = ($self->{children_of}->{ $chained_to } ||= {});
 
     my @path_part = @{ $action->attributes->{PathPart} || [] };
 
diff --git a/t/dead_load_multiple_chained_attributes.t b/t/dead_load_multiple_chained_attributes.t
index 7d1ad34..b870a75 100644
--- a/t/dead_load_multiple_chained_attributes.t
+++ b/t/dead_load_multiple_chained_attributes.t
@@ -10,16 +10,16 @@ plan tests => 4;
 
 use Catalyst::Test 'TestApp';
 
-eval q{  
+eval q{
     package TestApp::Controller::Action::Chained;
     sub should_fail : Chained('/') Chained('foo') Args(0) {}
 };
 ok(!$@);
 
-eval { TestApp->setup_actions; }; 
+eval { TestApp->setup_actions; };
 ok($@, 'Multiple chained attributes make action setup fail');
 
-eval q{      
+eval q{
     package TestApp::Controller::Action::Chained;
     no warnings 'redefine';
     sub should_fail {}
diff --git a/t/dead_recursive_chained_attributes.t b/t/dead_recursive_chained_attributes.t
new file mode 100644
index 0000000..77b9bcd
--- /dev/null
+++ b/t/dead_recursive_chained_attributes.t
@@ -0,0 +1,43 @@
+#!perl
+
+use strict;
+use warnings;
+use lib 't/lib';
+
+use Test::More tests => 6;
+
+use Catalyst::Test 'TestApp';
+
+eval q{
+    package TestApp::Controller::Action::Chained;
+    sub should_fail : Chained('should_fail') Args(0) {}
+};
+ok(!$@);
+
+eval { TestApp->setup_actions; };
+like($@, qr|Actions cannot chain to themselves registering /action/chained/should_fail|,
+    'Local self referencing attributes makes action setup fail');
+
+eval q{
+    package TestApp::Controller::Action::Chained;
+    no warnings 'redefine';
+    sub should_fail {}
+    use warnings 'redefine';
+    sub should_also_fail : Chained('/action/chained/should_also_fail') Args(0) {}
+};
+ok(!$@);
+
+eval { TestApp->setup_actions };
+like($@, qr|Actions cannot chain to themselves registering /action/chained/should_also_fail|,
+    'Full path self referencing attributes makes action setup fail');
+
+eval q{
+    package TestApp::Controller::Action::Chained;
+    no warnings 'redefine';
+    sub should_also_fail {}
+};
+ok(!$@);
+
+eval { TestApp->setup_actions };
+ok(!$@, 'And ok again') or warn $@;
+
diff --git a/t/lib/TestApp/Controller/Root.pm b/t/lib/TestApp/Controller/Root.pm
index a3978d6..53d79e2 100644
--- a/t/lib/TestApp/Controller/Root.pm
+++ b/t/lib/TestApp/Controller/Root.pm
@@ -20,8 +20,4 @@ sub localregex : LocalRegex('^localregex$') {
     $c->forward('TestApp::View::Dump::Request');
 }
 
-sub chain_to_self : Chained('chain_to_self') PathPart('') CaptureArgs(1) { }
-
-sub chain_recurse_endoint : Chained('chain_to_self') Args(0) { }
-
 1;
diff --git a/t/unit_core_action_chained.t b/t/unit_core_action_chained.t
deleted file mode 100644
index 1d4f4a8..0000000
--- a/t/unit_core_action_chained.t
+++ /dev/null
@@ -1,26 +0,0 @@
-#!perl
-
-use strict;
-use warnings;
-
-use FindBin;
-use lib "$FindBin::Bin/lib";
-
-use Test::More tests => 3;
-
-
-use TestApp;
-
-my $dispatch_type = TestApp->dispatcher->dispatch_type('Chained');
-isa_ok($dispatch_type, "Catalyst::DispatchType::Chained", "got dispatch type");
-
-# This test was failing due to recursion/OOM. set up an alarm so things dont
-# runaway
-local $SIG{ALRM} = sub { 
-    ok(0, "Chained->list didn't loop");
-    die "alarm expired - test probably looping";
-};
-alarm 10;
-
-$dispatch_type->list("TestApp");
-ok(1, "Chained->list didn't loop");