t/dead_load_bad_args.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5 use lib 't/lib';
   6
   7 use Test::More;
   8
   9 use Catalyst::Test 'TestApp';
  10
  11 for my $fail (
  12     "(' ')",
  13     "('')",
  14     "('1.23')",
  15     "(-1)",
  16 ) {
  17     for my $type (qw(Args CaptureArgs)) {
  18         eval <<"END";
  19             package TestApp::Controller::Action::Chained;
  20             no warnings 'redefine';
  21             sub should_fail : Chained('/') ${type}${fail} {}
  22 END
  23         ok(!$@);
  24
  25         eval { TestApp->setup_actions };
  26         like($@, qr/Invalid \Q${type}${fail}\E/,
  27              "Bad ${type}${fail} attribute makes action setup fail");
  28     }
  29 }
  30
  31 for my $ok (
  32     "()",
  33     "(0)",
  34     "(1)",
  35     "('0')",
  36     "",
  37 ) {
  38     for my $type (qw(Args CaptureArgs)) {
  39         eval <<"END";
  40             package TestApp::Controller::Action::Chained;
  41             no warnings 'redefine';
  42             sub should_fail : Chained('/') ${type}${ok} {}
  43 END
  44         ok(!$@);
  45         eval { TestApp->setup_actions };
  46         ok(!$@, "${type}${ok} works");
  47     }
  48 }
  49
  50 for my $first (qw(Args CaptureArgs)) {
  51     for my $second (qw(Args CaptureArgs)) {
  52         eval <<"END";
  53             package TestApp::Controller::Action::Chained;
  54             no warnings 'redefine';
  55             sub should_fail :Chained('/') $first $second {}
  56 END
  57         ok(!$@);
  58         eval { TestApp->setup_actions };
  59         my $msg = $first eq $second
  60            ? "Multiple $first"
  61            : "Combining Args and CaptureArgs";
  62         like($@, qr/$msg attributes not supported registering/,
  63              "$first + $second attribute makes action setup fail");
  64     }
  65 }
  66
  67 done_testing();