Test validity of Args attribute for Chained actions

diff --git a/Changes b/Changes
index 4089670..b27c165 100644 (file)
--- a/Changes
+++ b/Changes
@@ -15,6 +15,10 @@
         - Fix Catalyst failing to start if any plugin changed $_ whilst
           loading (t0m)
           - Tests for this
+        - Be stricter about arguments to Args attributes for Chained actions,
+          so that they blow up on load instead of causing undefined behavior
+          later on (hdp)
+          - Tests for this
 
    New features:
         - Add $c->req->remote_user to disambiguate from $c->req->user (dwc)

diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm
index 18e7c59..a29cb74 100644 (file)
--- a/lib/Catalyst/DispatchType/Chained.pm
+++ b/lib/Catalyst/DispatchType/Chained.pm
@@ -7,6 +7,7 @@ use Text::SimpleTable;
 use Catalyst::ActionChain;
 use Catalyst::Utils;
 use URI;
+use Scalar::Util ();
 
 has _endpoints => (
                    is => 'rw',
@@ -307,6 +308,23 @@ 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>)'"
+            );
+        }
+    }
+
     unless ($action->attributes->{CaptureArgs}) {
         unshift(@{ $self->_endpoints }, $action);
     }

diff --git a/t/dead_load_bad_args.t b/t/dead_load_bad_args.t
new file mode 100644 (file)
index 0000000..67fe64b
--- /dev/null
+++ b/t/dead_load_bad_args.t
@@ -0,0 +1,46 @@
+#!perl
+
+use strict;
+use warnings;
+use lib 't/lib';
+
+use Test::More;
+
+plan tests => 16;
+
+use Catalyst::Test 'TestApp';
+
+for my $fail (
+    "(' ')",
+    "('')",
+    "('1.23')",
+) {
+
+    eval <<"END";
+        package TestApp::Controller::Action::Chained;
+        no warnings 'redefine';
+        sub should_fail : Chained('/') Args$fail {}
+END
+    ok(!$@);
+
+    eval { TestApp->setup_actions };
+    like($@, qr/Invalid Args\Q$fail\E/,
+        "Bad Args$fail attribute makes action setup fail");
+}
+
+for my $ok (
+    "()",
+    "(0)",
+    "(1)",
+    "('0')",
+    "",
+) {
+    eval <<"END";
+        package TestApp::Controller::Action::Chained;
+        no warnings 'redefine';
+        sub should_fail : Chained('/') Args$ok {}
+END
+    ok(!$@);
+    eval { TestApp->setup_actions };
+    ok(!$@, "Args$ok works");
+}