[Catalyst-commits] r10430 - in Catalyst-Runtime/5.80/trunk: . lib/Catalyst/DispatchType t

[hdp at dev.catalyst.perl.org]

Author: hdp
Date: 2009-06-04 17:12:47 +0000 (Thu, 04 Jun 2009)
New Revision: 10430

Added:
   Catalyst-Runtime/5.80/trunk/t/dead_load_bad_args.t
Modified:
   Catalyst-Runtime/5.80/trunk/Changes
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/DispatchType/Chained.pm
Log:
Test validity of Args attribute for Chained actions

Modified: Catalyst-Runtime/5.80/trunk/Changes
===================================================================
--- Catalyst-Runtime/5.80/trunk/Changes	2009-06-04 02:44:15 UTC (rev 10429)
+++ Catalyst-Runtime/5.80/trunk/Changes	2009-06-04 17:12:47 UTC (rev 10430)
@@ -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)

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/DispatchType/Chained.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/DispatchType/Chained.pm	2009-06-04 02:44:15 UTC (rev 10429)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/DispatchType/Chained.pm	2009-06-04 17:12:47 UTC (rev 10430)
@@ -7,6 +7,7 @@
 use Catalyst::ActionChain;
 use Catalyst::Utils;
 use URI;
+use Scalar::Util ();
 
 has _endpoints => (
                    is => 'rw',
@@ -307,6 +308,23 @@
 
     $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);
     }

Added: Catalyst-Runtime/5.80/trunk/t/dead_load_bad_args.t
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/dead_load_bad_args.t	                        (rev 0)
+++ Catalyst-Runtime/5.80/trunk/t/dead_load_bad_args.t	2009-06-04 17:12:47 UTC (rev 10430)
@@ -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");
+}