Detect redispatch exceptions by a class check, not by checking the exception message.
[catagits/Catalyst-Runtime.git] / t / unit_core_component_loading.t
1 # 2 initial tests, and 6 per component in the loop below
2 # (do not forget to update the number of components in test 3 as well)
3 # 5 extra tests for the loading options
4 use Test::More tests => 2 + 6 * 24 + 5;
5
6 use strict;
7 use warnings;
8
9 use File::Spec;
10 use File::Path;
11
12 my $libdir = 'test_trash';
13 unshift(@INC, $libdir);
14
15 my $appclass = 'TestComponents';
16 my @components = (
17     { type => 'Controller', prefix => 'C', name => 'Bar' },
18     { type => 'Controller', prefix => 'C', name => 'Foo::Bar' },
19     { type => 'Controller', prefix => 'C', name => 'Foo::Foo::Bar' },
20     { type => 'Controller', prefix => 'C', name => 'Foo::Foo::Foo::Bar' },
21     { type => 'Controller', prefix => 'Controller', name => 'Bar::Bar::Bar::Foo' },
22     { type => 'Controller', prefix => 'Controller', name => 'Bar::Bar::Foo' },
23     { type => 'Controller', prefix => 'Controller', name => 'Bar::Foo' },
24     { type => 'Controller', prefix => 'Controller', name => 'Foo' },
25     { type => 'Model', prefix => 'M', name => 'Bar' },
26     { type => 'Model', prefix => 'M', name => 'Foo::Bar' },
27     { type => 'Model', prefix => 'M', name => 'Foo::Foo::Bar' },
28     { type => 'Model', prefix => 'M', name => 'Foo::Foo::Foo::Bar' },
29     { type => 'Model', prefix => 'Model', name => 'Bar::Bar::Bar::Foo' },
30     { type => 'Model', prefix => 'Model', name => 'Bar::Bar::Foo' },
31     { type => 'Model', prefix => 'Model', name => 'Bar::Foo' },
32     { type => 'Model', prefix => 'Model', name => 'Foo' },
33     { type => 'View', prefix => 'V', name => 'Bar' },
34     { type => 'View', prefix => 'V', name => 'Foo::Bar' },
35     { type => 'View', prefix => 'V', name => 'Foo::Foo::Bar' },
36     { type => 'View', prefix => 'V', name => 'Foo::Foo::Foo::Bar' },
37     { type => 'View', prefix => 'View', name => 'Bar::Bar::Bar::Foo' },
38     { type => 'View', prefix => 'View', name => 'Bar::Bar::Foo' },
39     { type => 'View', prefix => 'View', name => 'Bar::Foo' },
40     { type => 'View', prefix => 'View', name => 'Foo' },
41 );
42
43 sub write_component_file { 
44   my ($dir_list, $module_name, $content) = @_;
45
46   my $dir  = File::Spec->catdir(@$dir_list);
47   my $file = File::Spec->catfile($dir, $module_name . '.pm');
48
49   mkpath(join(q{/}, @$dir_list) );
50   open(my $fh, '>', $file) or die "Could not open file $file for writing: $!";
51   print $fh $content;
52   close $fh;
53 }
54
55 sub make_component_file {
56     my ($type, $prefix, $name) = @_;
57
58     my $compbase = "Catalyst::${type}";
59     my $fullname = "${appclass}::${prefix}::${name}";
60     my @namedirs = split(/::/, $name);
61     my $name_final = pop(@namedirs);
62     my @dir_list = ($libdir, $appclass, $prefix, @namedirs);
63
64     write_component_file(\@dir_list, $name_final, <<EOF);
65 package $fullname;
66 use MRO::Compat;
67 use base '$compbase';
68 sub COMPONENT {
69     my \$self = shift->next::method(\@_);
70     no strict 'refs';
71     *{\__PACKAGE__ . "::whoami"} = sub { return \__PACKAGE__; };
72     \$self;
73 }
74 1;
75
76 EOF
77 }
78
79 foreach my $component (@components) {
80     make_component_file($component->{type},
81                         $component->{prefix},
82                         $component->{name});
83 }
84
85 my $shut_up_deprecated_warnings = q{
86     __PACKAGE__->log(Catalyst::Log->new('fatal'));
87 };
88
89 eval "package $appclass; use Catalyst; $shut_up_deprecated_warnings __PACKAGE__->setup";
90
91 can_ok( $appclass, 'components');
92
93 my $complist = $appclass->components;
94
95 # the +1 below is for the app class itself
96 is(scalar keys %$complist, 24+1, "Correct number of components loaded");
97
98 foreach (keys %$complist) {
99
100     # Skip the component which happens to be the app itself
101     next if $_ eq $appclass;
102
103     my $instance = $appclass->component($_);
104     isa_ok($instance, $_);
105     can_ok($instance, 'whoami');
106     is($instance->whoami, $_);
107
108     if($_ =~ /^${appclass}::(?:V|View)::(.*)/) {
109         my $moniker = $1;
110         isa_ok($instance, 'Catalyst::View');
111         can_ok($appclass->view($moniker), 'whoami');
112         is($appclass->view($moniker)->whoami, $_);
113     }
114     elsif($_ =~ /^${appclass}::(?:M|Model)::(.*)/) {
115         my $moniker = $1;
116         isa_ok($instance, 'Catalyst::Model');
117         can_ok($appclass->model($moniker), 'whoami');
118         is($appclass->model($moniker)->whoami, $_);
119     }
120     elsif($_ =~ /^${appclass}::(?:C|Controller)::(.*)/) {
121         my $moniker = $1;
122         isa_ok($instance, 'Catalyst::Controller');
123         can_ok($appclass->controller($moniker), 'whoami');
124         is($appclass->controller($moniker)->whoami, $_);
125     }
126     else {
127         die "Something is wrong with this test, this should"
128             . " have been unreachable";
129     }
130 }
131
132 rmtree($libdir);
133
134 # test extra component loading options
135
136 $appclass = 'ExtraOptions';
137 push @components, { type => 'View', prefix => 'Extra', name => 'Foo' };
138
139 foreach my $component (@components) {
140     make_component_file($component->{type},
141                         $component->{prefix},
142                         $component->{name});
143 }
144
145 eval qq(
146 package $appclass;
147 use Catalyst;
148 $shut_up_deprecated_warnings
149 __PACKAGE__->config->{ setup_components } = {
150     search_extra => [ '::Extra' ],
151     except       => [ "${appclass}::Controller::Foo" ]
152 };
153 __PACKAGE__->setup;
154 );
155
156 can_ok( $appclass, 'components');
157
158 $complist = $appclass->components;
159
160 is(scalar keys %$complist, 24+1, "Correct number of components loaded");
161
162 ok( !exists $complist->{ "${appclass}::Controller::Foo" }, 'Controller::Foo was skipped' );
163 ok( exists $complist->{ "${appclass}::Extra::Foo" }, 'Extra::Foo was loaded' );
164
165 rmtree($libdir);
166
167 $appclass = "ComponentOnce";
168
169 write_component_file([$libdir, $appclass, 'Model'], 'TopLevel', <<EOF);
170 package ${appclass}::Model::TopLevel;
171 use base 'Catalyst::Model';
172 sub COMPONENT {
173  
174     my \$self = shift->next::method(\@_);
175     no strict 'refs';
176     *{\__PACKAGE__ . "::whoami"} = sub { return \__PACKAGE__; };
177     \$self;
178 }
179
180 package ${appclass}::Model::TopLevel::Nested;
181
182 sub COMPONENT { die "COMPONENT called in the wrong order!"; }
183
184 1;
185
186 EOF
187
188 write_component_file([$libdir, $appclass, 'Model', 'TopLevel'], 'Nested', <<EOF);
189 package ${appclass}::Model::TopLevel::Nested;
190 use base 'Catalyst::Model';
191
192 no warnings 'redefine';
193 sub COMPONENT { return shift->next::method(\@_); }
194 1;
195
196 EOF
197
198 eval "package $appclass; use Catalyst; __PACKAGE__->setup";
199
200 is($@, '', "Didn't load component twice");
201
202 rmtree($libdir);