t/class_traits.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4 use Class::MOP;
   5
   6 BEGIN {
   7   my %hidden = map { (my $m = "$_.pm") =~ s{::}{/}g; $m => 1 } qw(
   8     Foo
   9     Bar
  10   );
  11   unshift @INC, sub {
  12     return unless exists $hidden{$_[1]};
  13     die "Can't locate $_[1] in \@INC (hidden)\n";
  14   };
  15 }
  16
  17 BEGIN {
  18   package TestRole;
  19   $INC{'TestRole'} = __FILE__;
  20   use Moose::Role;
  21
  22   sub a { 'a' }
  23   sub b { 'b' }
  24
  25   package Catalyst::TraitFor::Request::Foo;
  26   $INC{'Catalyst/TraitFor/Request/Foo.pm'} = __FILE__;
  27   use Moose::Role;
  28
  29   sub c { 'c' }
  30
  31   package TestApp::TraitFor::Request::Bar;
  32   $INC{'TestApp/TraitFor/Request/Bar.pm'} = __FILE__;
  33   use Moose::Role;
  34
  35   sub d { 'd' }
  36
  37   package Catalyst::TraitFor::Response::Foo;
  38   $INC{'Catalyst/TraitFor/Response/Foo.pm'} = __FILE__;
  39
  40   use Moose::Role;
  41
  42   sub c { 'c' }
  43
  44   package TestApp::TraitFor::Response::Bar;
  45   $INC{'TestApp/TraitFor/Response/Bar.pm'} = __FILE__;
  46
  47   use Moose::Role;
  48
  49   sub d { 'd' }
  50 }
  51
  52 BEGIN {
  53   package TestApp::Controller::Root;
  54   $INC{'TestApp/Controller/Root.pm'} = __FILE__;
  55
  56   use Moose;
  57
  58   BEGIN { extends 'Catalyst::Controller' };
  59
  60   sub root :Path('/') {}
  61 }
  62
  63 {
  64   package TestApp;
  65   $INC{'TestApp.pm'} = __FILE__;
  66
  67   use Catalyst;
  68
  69   __PACKAGE__->request_class_traits([qw/TestRole Foo Bar/]);
  70   __PACKAGE__->response_class_traits([qw/TestRole Foo Bar/]);
  71   __PACKAGE__->stats_class_traits([qw/TestRole/]);
  72
  73   __PACKAGE__->setup;
  74 }
  75
  76
  77 foreach my $class_prefix (qw/request response stats/) {
  78   my $method = 'composed_' .$class_prefix. '_class';
  79   ok(
  80     Class::MOP::class_of(TestApp->$method)->does_role('TestRole'),
  81     "$method does TestRole",
  82   );
  83 }
  84
  85 use Catalyst::Test 'TestApp';
  86
  87 my ($res, $c) = ctx_request '/';
  88
  89 is $c->req->a, 'a';
  90 is $c->req->b, 'b';
  91 is $c->req->c, 'c';
  92 is $c->req->d, 'd';
  93 is $c->res->a, 'a';
  94 is $c->res->b, 'b';
  95 is $c->res->c, 'c';
  96 is $c->res->d, 'd';
  97
  98 done_testing;