Merge branch 'stricter-chained-arg-attrs' into SicilianButtercup

diff --git a/Changes b/Changes
index 115949c..ae21dcc 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+  ! Stricter checking of attributes in Catalyst::DispatchType::Chained:
+    1) Only allow one of either :CaptureArgs or :Args
+    2) :CaptureArgs() argument must be numeric
   - Add Devel::InnerPackage to dependencies, fixing tests on perl 5.17.11
     as it's been removed from core. RT#84787
 

diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm
index 44f890e..615f5aa 100644 (file)
--- a/lib/Catalyst/DispatchType/Chained.pm
+++ b/lib/Catalyst/DispatchType/Chained.pm
@@ -285,6 +285,32 @@ Calls register_path for every Path attribute for the given $action.
 
 =cut
 
+sub _check_args_attr {
+    my ( $self, $action, $name ) = @_;
+
+    return unless exists $action->attributes->{$name};
+
+    if (@{$action->attributes->{$name}} > 1) {
+        Catalyst::Exception->throw(
+          "Multiple $name attributes not supported registering " . $action->reverse()
+        );
+    }
+    my $args = $action->attributes->{$name}->[0];
+    if (defined($args) and not (
+        Scalar::Util::looks_like_number($args) and
+        int($args) == $args
+    )) {
+        require Data::Dumper;
+        local $Data::Dumper::Terse = 1;
+        local $Data::Dumper::Indent = 0;
+        $args = Data::Dumper::Dumper($args);
+        Catalyst::Exception->throw(
+          "Invalid $name($args) for action " . $action->reverse() .
+          " (use '$name' or '$name(<number>)')"
+        );
+    }
+}
+
 sub register {
     my ( $self, $c, $action ) = @_;
 
@@ -329,21 +355,15 @@ sub register {
 
     $self->_actions->{'/'.$action->reverse} = $action;
 
-    if (exists $action->attributes->{Args}) {
-        my $args = $action->attributes->{Args}->[0];
-        if (defined($args) and not (
-            Scalar::Util::looks_like_number($args) and
-            int($args) == $args
-        )) {
-            require Data::Dumper;
-            local $Data::Dumper::Terse = 1;
-            local $Data::Dumper::Indent = 0;
-            $args = Data::Dumper::Dumper($args);
-            Catalyst::Exception->throw(
-              "Invalid Args($args) for action " . $action->reverse() .
-              " (use 'Args' or 'Args(<number>)')"
-            );
-        }
+    foreach my $name (qw(Args CaptureArgs)) {
+        $self->_check_args_attr($action, $name);
+    }
+
+    if (exists $action->attributes->{Args} and exists $action->attributes->{CaptureArgs}) {
+        Catalyst::Exception->throw(
+          "Combining Args and CaptureArgs attributes not supported registering " .
+          $action->reverse()
+        );
     }
 
     unless ($action->attributes->{CaptureArgs}) {

diff --git a/t/dead_load_bad_args.t b/t/dead_load_bad_args.t
index 67fe64b..8542a13 100644 (file)
--- a/t/dead_load_bad_args.t
+++ b/t/dead_load_bad_args.t
@@ -6,8 +6,6 @@ use lib 't/lib';
 
 use Test::More;
 
-plan tests => 16;
-
 use Catalyst::Test 'TestApp';
 
 for my $fail (
@@ -15,17 +13,18 @@ for my $fail (
     "('')",
     "('1.23')",
 ) {
-
-    eval <<"END";
-        package TestApp::Controller::Action::Chained;
-        no warnings 'redefine';
-        sub should_fail : Chained('/') Args$fail {}
+    for my $type (qw(Args CaptureArgs)) {
+        eval <<"END";
+            package TestApp::Controller::Action::Chained;
+            no warnings 'redefine';
+            sub should_fail : Chained('/') ${type}${fail} {}
 END
-    ok(!$@);
+        ok(!$@);
 
-    eval { TestApp->setup_actions };
-    like($@, qr/Invalid Args\Q$fail\E/,
-        "Bad Args$fail attribute makes action setup fail");
+        eval { TestApp->setup_actions };
+        like($@, qr/Invalid \Q${type}${fail}\E/,
+             "Bad ${type}${fail} attribute makes action setup fail");
+    }
 }
 
 for my $ok (
@@ -35,12 +34,33 @@ for my $ok (
     "('0')",
     "",
 ) {
-    eval <<"END";
-        package TestApp::Controller::Action::Chained;
-        no warnings 'redefine';
-        sub should_fail : Chained('/') Args$ok {}
+    for my $type (qw(Args CaptureArgs)) {
+        eval <<"END";
+            package TestApp::Controller::Action::Chained;
+            no warnings 'redefine';
+            sub should_fail : Chained('/') ${type}${ok} {}
+END
+        ok(!$@);
+        eval { TestApp->setup_actions };
+        ok(!$@, "${type}${ok} works");
+    }
+}
+
+for my $first (qw(Args CaptureArgs)) {
+    for my $second (qw(Args CaptureArgs)) {
+        eval <<"END";
+            package TestApp::Controller::Action::Chained;
+            no warnings 'redefine';
+            sub should_fail :Chained('/') $first $second {}
 END
-    ok(!$@);
-    eval { TestApp->setup_actions };
-    ok(!$@, "Args$ok works");
+        ok(!$@);
+        eval { TestApp->setup_actions };
+        my $msg = $first eq $second
+           ? "Multiple $first"
+           : "Combining Args and CaptureArgs";
+        like($@, qr/$msg attributes not supported registering/,
+             "$first + $second attribute makes action setup fail");
+    }
 }
+
+done_testing();