[Catalyst-commits] r11432 - in
Catalyst-Runtime/5.80/branches/aggregate_more/t: . aggregate
rafl at dev.catalyst.perl.org
rafl at dev.catalyst.perl.org
Sun Sep 27 15:06:27 GMT 2009
Author: rafl
Date: 2009-09-27 15:06:26 +0000 (Sun, 27 Sep 2009)
New Revision: 11432
Added:
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_controller_actions.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_controller_config.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_controller_namespace.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_action.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_classdata.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_component.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_component_loading.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_component_mro.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_engine_fixenv-iis6.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_engine_fixenv-lighttpd.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_log.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_merge_config_hashes.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_mvc.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_path_to.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_plugin.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_setup.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_setup_log.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_setup_stats.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_uri_for.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_uri_with.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_dispatcher_requestargs_restore.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_response.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_utils_env_value.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_utils_prefix.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_utils_request.t
Removed:
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_actions.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_config.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_namespace.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_action.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_classdata.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component_loading.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component_mro.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_engine_fixenv-iis6.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_engine_fixenv-lighttpd.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_log.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_merge_config_hashes.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_mvc.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_path_to.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_plugin.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup_log.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup_stats.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_uri_for.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_uri_with.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_dispatcher_requestargs_restore.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_response.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_env_value.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_prefix.t
Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_request.t
Log:
More aggregated tests.
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_controller_actions.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_actions.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_controller_actions.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_controller_actions.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,26 @@
+use strict;
+use warnings;
+use Test::More tests => 4;
+
+use Catalyst ();
+{
+ package TestController;
+ use Moose;
+ BEGIN { extends 'Catalyst::Controller' }
+
+ sub action : Local {}
+
+ sub foo : Path {}
+
+ no Moose;
+}
+
+my $mock_app = Class::MOP::Class->create_anon_class( superclasses => ['Catalyst'] );
+my $app = $mock_app->name->new;
+my $controller = TestController->new($app, {actions => { foo => { Path => '/some/path' }}});
+
+ok $controller->can('_controller_actions');
+is_deeply $controller->_controller_actions => { foo => { Path => '/some/path' }};
+is_deeply $controller->{actions} => { foo => { Path => '/some/path' }}; # Back compat.
+is_deeply [ sort grep { ! /^_/ } map { $_->name } $controller->get_action_methods ], [sort qw/action foo/];
+
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_controller_config.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_config.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_controller_config.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_controller_config.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,91 @@
+## ============================================================================
+## Test to make sure that subclassed controllers (catalyst controllers
+## that inherit from a custom base catalyst controller) don't experienc
+## any namespace collision in the values under config.
+## ============================================================================
+
+use Test::More tests => 9;
+
+use strict;
+use warnings;
+
+use_ok('Catalyst');
+
+## ----------------------------------------------------------------------------
+## First We define a base controller that inherits from Catalyst::Controller
+## We add something to the config that we expect all children classes to
+## be able to find.
+## ----------------------------------------------------------------------------
+
+{
+ package base_controller;
+
+ use base 'Catalyst::Controller';
+
+ __PACKAGE__->config( base_key => 'base_value' );
+}
+
+## ----------------------------------------------------------------------------
+## Next we instantiate two classes that inherit from the base controller. We
+## Add some local config information to these.
+## ----------------------------------------------------------------------------
+
+{
+ package controller_a;
+
+ use base 'base_controller';
+
+ __PACKAGE__->config( key_a => 'value_a' );
+}
+
+
+{
+ package controller_b;
+
+ use base 'base_controller';
+
+ __PACKAGE__->config->{key_b} = 'value_b';
+}
+
+## Okay, we expect that the base controller has a config with one key
+## and that the two children controllers inherit that config key and then
+## add one more. So the base controller has one config value and the two
+## children each have two.
+
+## ----------------------------------------------------------------------------
+## THE TESTS. Basically we first check to make sure that all the children of
+## the base_controller properly inherit the {base_key => 'base_value'} info
+## and that each of the children also has its local config data and that none
+## of the classes have data that is unexpected.
+## ----------------------------------------------------------------------------
+
+
+# First round, does everything have what we expect to find? If these tests fail there is something
+# wrong with the way config is storing its information.
+
+ok( base_controller->config->{base_key} eq 'base_value', 'base_controller has expected config value for "base_key"') or
+ diag('"base_key" defined as "'.base_controller->config->{base_key}.'" and not "base_value" in config');
+
+ok( controller_a->config->{base_key} eq 'base_value', 'controller_a has expected config value for "base_key"') or
+ diag('"base_key" defined as "'.controller_a->config->{base_key}.'" and not "base_value" in config');
+
+ok( controller_a->config->{key_a} eq 'value_a', 'controller_a has expected config value for "key_a"') or
+ diag('"key_a" defined as "'.controller_a->config->{key_a}.'" and not "value_a" in config');
+
+ok( controller_b->config->{base_key} eq 'base_value', 'controller_b has expected config value for "base_key"') or
+ diag('"base_key" defined as "'.controller_b->config->{base_key}.'" and not "base_value" in config');
+
+ok( controller_b->config->{key_b} eq 'value_b', 'controller_b has expected config value for "key_b"') or
+ diag('"key_b" defined as "'.controller_b->config->{key_b}.'" and not "value_b" in config');
+
+# second round, does each controller have the expected number of config values? If this test fails there is
+# probably some data collision between the controllers.
+
+ok( scalar(keys %{base_controller->config}) == 1, 'base_controller has the expected number of config values') or
+ diag("base_controller should have 1 config value, but it has ".scalar(keys %{base_controller->config}));
+
+ok( scalar(keys %{controller_a->config}) == 2, 'controller_a has the expected number of config values') or
+ diag("controller_a should have 2 config value, but it has ".scalar(keys %{base_controller->config}));
+
+ok( scalar(keys %{controller_b->config}) == 2, 'controller_b has the expected number of config values') or
+ diag("controller_a should have 2 config value, but it has ".scalar(keys %{base_controller->config}));
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_controller_namespace.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_namespace.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_controller_namespace.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_controller_namespace.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+BEGIN {
+ package MyApp::Controller::Foo;
+
+ use base qw/Catalyst::Controller/;
+
+ package MyApp::Controller::Root;
+
+ use base qw/Catalyst::Controller/;
+
+ __PACKAGE__->config(namespace => '');
+
+ package Stub;
+
+ sub config { {} };
+}
+
+is(MyApp::Controller::Foo->action_namespace('Stub'), 'foo');
+
+is(MyApp::Controller::Root->action_namespace('Stub'), '');
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_action.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_action.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_action.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_action.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,54 @@
+use Test::More tests => 6;
+use strict;
+use warnings;
+use Moose::Meta::Class;
+#use Moose::Meta::Attribute;
+use Catalyst::Request;
+
+use_ok('Catalyst::Action');
+
+my $action_1 = Catalyst::Action->new(
+ name => 'foo',
+ code => sub { "DUMMY" },
+ reverse => 'bar/foo',
+ namespace => 'bar',
+ attributes => {
+ Args => [ 1 ],
+ attr2 => [ 2 ],
+ },
+);
+
+my $action_2 = Catalyst::Action->new(
+ name => 'foo',
+ code => sub { "DUMMY" },
+ reverse => 'bar/foo',
+ namespace => 'bar',
+ attributes => {
+ Args => [ 2 ],
+ attr2 => [ 2 ],
+ },
+);
+
+is("${action_1}", $action_1->reverse, 'overload string');
+is($action_1->(), 'DUMMY', 'overload code');
+
+my $anon_meta = Moose::Meta::Class->create_anon_class(
+ attributes => [
+ Moose::Meta::Attribute->new(
+ request => (
+ reader => 'request',
+ required => 1,
+ default => sub { Catalyst::Request->new(arguments => [qw/one two/]) },
+ ),
+ ),
+ ],
+ methods => { req => sub { shift->request(@_) } }
+);
+
+my $mock_c = $anon_meta->new_object();
+$mock_c->request;
+
+ok(!$action_1->match($mock_c), 'bad match fails');
+ok($action_2->match($mock_c), 'good match works');
+
+ok($action_2->compare( $action_1 ), 'compare works');
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_classdata.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_classdata.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_classdata.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_classdata.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,106 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Scalar::Util qw/refaddr blessed/;
+use Test::More tests => 37;
+
+{
+ package ClassDataTest;
+ use Moose;
+ with 'Catalyst::ClassData';
+
+ package ClassDataTest2;
+ use Moose;
+ extends 'ClassDataTest';
+
+}
+
+ my $scalar = '100';
+ my $arrayref = [];
+ my $hashref = {};
+ my $scalarref = \$scalar;
+ my $coderef = sub { "beep" };
+
+ my $scalar2 = '200';
+ my $arrayref2 = [];
+ my $hashref2 = {};
+ my $scalarref2 = \$scalar2;
+ my $coderef2 = sub { "beep" };
+
+ my $scalar3 = '300';
+ my $arrayref3 = [];
+ my $hashref3 = {};
+ my $scalarref3 = \$scalar3;
+ my $coderef3 = sub { "beep" };
+
+
+my @accessors = qw/_arrayref _hashref _scalarref _coderef _scalar/;
+ClassDataTest->mk_classdata($_) for @accessors;
+can_ok('ClassDataTest', @accessors);
+
+ClassDataTest2->mk_classdata("beep", "meep");
+is(ClassDataTest2->beep, "meep");
+
+ClassDataTest->_arrayref($arrayref);
+ClassDataTest->_hashref($hashref);
+ClassDataTest->_scalarref($scalarref);
+ClassDataTest->_coderef($coderef);
+ClassDataTest->_scalar($scalar);
+
+is(ref(ClassDataTest->_arrayref), 'ARRAY');
+is(ref(ClassDataTest->_hashref), 'HASH');
+is(ref(ClassDataTest->_scalarref), 'SCALAR');
+is(ref(ClassDataTest->_coderef), 'CODE');
+ok( !ref(ClassDataTest->_scalar) );
+is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref));
+is(refaddr(ClassDataTest->_hashref), refaddr($hashref));
+is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref));
+is(refaddr(ClassDataTest->_coderef), refaddr($coderef));
+is(ClassDataTest->_scalar, $scalar);
+
+
+is(ref(ClassDataTest2->_arrayref), 'ARRAY');
+is(ref(ClassDataTest2->_hashref), 'HASH');
+is(ref(ClassDataTest2->_scalarref), 'SCALAR');
+is(ref(ClassDataTest2->_coderef), 'CODE');
+ok( !ref(ClassDataTest2->_scalar) );
+is(refaddr(ClassDataTest2->_arrayref), refaddr($arrayref));
+is(refaddr(ClassDataTest2->_hashref), refaddr($hashref));
+is(refaddr(ClassDataTest2->_scalarref), refaddr($scalarref));
+is(refaddr(ClassDataTest2->_coderef), refaddr($coderef));
+is(ClassDataTest2->_scalar, $scalar);
+
+ClassDataTest2->_arrayref($arrayref2);
+ClassDataTest2->_hashref($hashref2);
+ClassDataTest2->_scalarref($scalarref2);
+ClassDataTest2->_coderef($coderef2);
+ClassDataTest2->_scalar($scalar2);
+
+is(refaddr(ClassDataTest2->_arrayref), refaddr($arrayref2));
+is(refaddr(ClassDataTest2->_hashref), refaddr($hashref2));
+is(refaddr(ClassDataTest2->_scalarref), refaddr($scalarref2));
+is(refaddr(ClassDataTest2->_coderef), refaddr($coderef2));
+is(ClassDataTest2->_scalar, $scalar2);
+
+is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref));
+is(refaddr(ClassDataTest->_hashref), refaddr($hashref));
+is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref));
+is(refaddr(ClassDataTest->_coderef), refaddr($coderef));
+is(ClassDataTest->_scalar, $scalar);
+
+ClassDataTest->_arrayref($arrayref3);
+ClassDataTest->_hashref($hashref3);
+ClassDataTest->_scalarref($scalarref3);
+ClassDataTest->_coderef($coderef3);
+ClassDataTest->_scalar($scalar3);
+
+is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref3));
+is(refaddr(ClassDataTest->_hashref), refaddr($hashref3));
+is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref3));
+is(refaddr(ClassDataTest->_coderef), refaddr($coderef3));
+is(ClassDataTest->_scalar, $scalar3);
+
+my $i = bless {}, 'ClassDataTest';
+$i->_scalar('foo');
+
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_component.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_component.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_component.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,93 @@
+use Test::More tests => 22;
+use strict;
+use warnings;
+
+use_ok('Catalyst');
+
+my @complist = map { "MyApp::$_"; } qw/C::Controller M::Model V::View/;
+
+{
+ package MyApp;
+
+ use base qw/Catalyst/;
+
+ __PACKAGE__->components({ map { ($_, $_) } @complist });
+
+ # this is so $c->log->warn will work
+ __PACKAGE__->setup_log;
+}
+
+is(MyApp->comp('MyApp::V::View'), 'MyApp::V::View', 'Explicit return ok');
+
+is(MyApp->comp('C::Controller'), 'MyApp::C::Controller', 'Two-part return ok');
+
+is(MyApp->comp('Model'), 'MyApp::M::Model', 'Single part return ok');
+
+is_deeply([ MyApp->comp() ], \@complist, 'Empty return ok');
+
+# Is this desired behaviour?
+is_deeply([ MyApp->comp('Foo') ], \@complist, 'Fallthrough return ok');
+
+# regexp behavior
+{
+ is_deeply( [ MyApp->comp( qr{Model} ) ], [ 'MyApp::M::Model'], 'regexp ok' );
+ is_deeply( [ MyApp->comp('MyApp::V::View$') ], [ 'MyApp::V::View' ], 'Explicit return ok');
+ is_deeply( [ MyApp->comp('MyApp::C::Controller$') ], [ 'MyApp::C::Controller' ], 'Explicit return ok');
+ is_deeply( [ MyApp->comp('MyApp::M::Model$') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
+
+ # a couple other varieties for regexp fallback
+ is_deeply( [ MyApp->comp('M::Model') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
+
+ {
+ my $warnings = 0;
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+
+ is_deeply( [ MyApp->comp('::M::Model') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
+ ok( $warnings, 'regexp fallback warnings' );
+
+ $warnings = 0;
+ is_deeply( [ MyApp->comp('Mode') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
+ ok( $warnings, 'regexp fallback warnings' );
+
+ $warnings = 0;
+ is(MyApp->comp('::M::'), 'MyApp::M::Model', 'Regex return ok');
+ ok( $warnings, 'regexp fallback for comp() warns' );
+ }
+
+}
+
+# multiple returns
+{
+ my @expected = sort qw( MyApp::C::Controller MyApp::M::Model );
+ my @got = sort MyApp->comp( qr{::[MC]::} );
+ is_deeply( \@got, \@expected, 'multiple results from regexp ok' );
+}
+
+# failed search
+{
+ is_deeply( scalar MyApp->comp( qr{DNE} ), 0, 'no results for failed search' );
+}
+
+
+#checking @args passed to ACCEPT_CONTEXT
+{
+ my $args;
+
+ {
+ no warnings 'once';
+ *MyApp::M::Model::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
+ }
+
+ my $c = bless {}, 'MyApp';
+
+ $c->component('MyApp::M::Model', qw/foo bar/);
+ is_deeply($args, [qw/foo bar/], 'args passed to ACCEPT_CONTEXT ok');
+
+ $c->component('M::Model', qw/foo2 bar2/);
+ is_deeply($args, [qw/foo2 bar2/], 'args passed to ACCEPT_CONTEXT ok');
+
+ $c->component('Mode', qw/foo3 bar3/);
+ is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok');
+}
+
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_component_loading.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component_loading.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_component_loading.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_component_loading.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,226 @@
+# 2 initial tests, and 6 per component in the loop below
+# (do not forget to update the number of components in test 3 as well)
+# 5 extra tests for the loading options
+# One test for components in inner packages
+use Test::More tests => 2 + 6 * 24 + 8 + 1;
+
+use strict;
+use warnings;
+
+use File::Spec;
+use File::Path;
+
+my $libdir = 'test_trash';
+unshift(@INC, $libdir);
+
+my $appclass = 'TestComponents';
+my @components = (
+ { type => 'Controller', prefix => 'C', name => 'Bar' },
+ { type => 'Controller', prefix => 'C', name => 'Foo::Bar' },
+ { type => 'Controller', prefix => 'C', name => 'Foo::Foo::Bar' },
+ { type => 'Controller', prefix => 'C', name => 'Foo::Foo::Foo::Bar' },
+ { type => 'Controller', prefix => 'Controller', name => 'Bar::Bar::Bar::Foo' },
+ { type => 'Controller', prefix => 'Controller', name => 'Bar::Bar::Foo' },
+ { type => 'Controller', prefix => 'Controller', name => 'Bar::Foo' },
+ { type => 'Controller', prefix => 'Controller', name => 'Foo' },
+ { type => 'Model', prefix => 'M', name => 'Bar' },
+ { type => 'Model', prefix => 'M', name => 'Foo::Bar' },
+ { type => 'Model', prefix => 'M', name => 'Foo::Foo::Bar' },
+ { type => 'Model', prefix => 'M', name => 'Foo::Foo::Foo::Bar' },
+ { type => 'Model', prefix => 'Model', name => 'Bar::Bar::Bar::Foo' },
+ { type => 'Model', prefix => 'Model', name => 'Bar::Bar::Foo' },
+ { type => 'Model', prefix => 'Model', name => 'Bar::Foo' },
+ { type => 'Model', prefix => 'Model', name => 'Foo' },
+ { type => 'View', prefix => 'V', name => 'Bar' },
+ { type => 'View', prefix => 'V', name => 'Foo::Bar' },
+ { type => 'View', prefix => 'V', name => 'Foo::Foo::Bar' },
+ { type => 'View', prefix => 'V', name => 'Foo::Foo::Foo::Bar' },
+ { type => 'View', prefix => 'View', name => 'Bar::Bar::Bar::Foo' },
+ { type => 'View', prefix => 'View', name => 'Bar::Bar::Foo' },
+ { type => 'View', prefix => 'View', name => 'Bar::Foo' },
+ { type => 'View', prefix => 'View', name => 'Foo' },
+);
+
+sub write_component_file {
+ my ($dir_list, $module_name, $content) = @_;
+
+ my $dir = File::Spec->catdir(@$dir_list);
+ my $file = File::Spec->catfile($dir, $module_name . '.pm');
+
+ mkpath(join(q{/}, @$dir_list) );
+ open(my $fh, '>', $file) or die "Could not open file $file for writing: $!";
+ print $fh $content;
+ close $fh;
+}
+
+sub make_component_file {
+ my ($type, $prefix, $name) = @_;
+
+ my $compbase = "Catalyst::${type}";
+ my $fullname = "${appclass}::${prefix}::${name}";
+ my @namedirs = split(/::/, $name);
+ my $name_final = pop(@namedirs);
+ my @dir_list = ($libdir, $appclass, $prefix, @namedirs);
+
+ write_component_file(\@dir_list, $name_final, <<EOF);
+package $fullname;
+use MRO::Compat;
+use base '$compbase';
+sub COMPONENT {
+ my \$self = shift->next::method(\@_);
+ no strict 'refs';
+ *{\__PACKAGE__ . "::whoami"} = sub { return \__PACKAGE__; };
+ \$self;
+}
+1;
+
+EOF
+}
+
+foreach my $component (@components) {
+ make_component_file($component->{type},
+ $component->{prefix},
+ $component->{name});
+}
+
+my $shut_up_deprecated_warnings = q{
+ __PACKAGE__->log(Catalyst::Log->new('fatal'));
+};
+
+eval "package $appclass; use Catalyst; $shut_up_deprecated_warnings __PACKAGE__->setup";
+
+can_ok( $appclass, 'components');
+
+my $complist = $appclass->components;
+
+# the +1 below is for the app class itself
+is(scalar keys %$complist, 24+1, "Correct number of components loaded");
+
+foreach (keys %$complist) {
+
+ # Skip the component which happens to be the app itself
+ next if $_ eq $appclass;
+
+ my $instance = $appclass->component($_);
+ isa_ok($instance, $_);
+ can_ok($instance, 'whoami');
+ is($instance->whoami, $_);
+
+ if($_ =~ /^${appclass}::(?:V|View)::(.*)/) {
+ my $moniker = $1;
+ isa_ok($instance, 'Catalyst::View');
+ can_ok($appclass->view($moniker), 'whoami');
+ is($appclass->view($moniker)->whoami, $_);
+ }
+ elsif($_ =~ /^${appclass}::(?:M|Model)::(.*)/) {
+ my $moniker = $1;
+ isa_ok($instance, 'Catalyst::Model');
+ can_ok($appclass->model($moniker), 'whoami');
+ is($appclass->model($moniker)->whoami, $_);
+ }
+ elsif($_ =~ /^${appclass}::(?:C|Controller)::(.*)/) {
+ my $moniker = $1;
+ isa_ok($instance, 'Catalyst::Controller');
+ can_ok($appclass->controller($moniker), 'whoami');
+ is($appclass->controller($moniker)->whoami, $_);
+ }
+ else {
+ die "Something is wrong with this test, this should"
+ . " have been unreachable";
+ }
+}
+
+rmtree($libdir);
+
+# test extra component loading options
+
+$appclass = 'ExtraOptions';
+push @components, { type => 'View', prefix => 'Extra', name => 'Foo' };
+
+foreach my $component (@components) {
+ make_component_file($component->{type},
+ $component->{prefix},
+ $component->{name});
+}
+
+eval qq(
+package $appclass;
+use Catalyst;
+$shut_up_deprecated_warnings
+__PACKAGE__->config->{ setup_components } = {
+ search_extra => [ '::Extra' ],
+ except => [ "${appclass}::Controller::Foo" ]
+};
+__PACKAGE__->setup;
+);
+
+can_ok( $appclass, 'components');
+
+$complist = $appclass->components;
+
+is(scalar keys %$complist, 24+1, "Correct number of components loaded");
+
+ok( !exists $complist->{ "${appclass}::Controller::Foo" }, 'Controller::Foo was skipped' );
+ok( exists $complist->{ "${appclass}::Extra::Foo" }, 'Extra::Foo was loaded' );
+
+rmtree($libdir);
+
+$appclass = "ComponentOnce";
+
+write_component_file([$libdir, $appclass, 'Model'], 'TopLevel', <<EOF);
+package ${appclass}::Model::TopLevel;
+use base 'Catalyst::Model';
+sub COMPONENT {
+
+ my \$self = shift->next::method(\@_);
+ no strict 'refs';
+ *{\__PACKAGE__ . "::whoami"} = sub { return \__PACKAGE__; };
+ *${appclass}::Model::TopLevel::GENERATED::ACCEPT_CONTEXT = sub {
+ return bless {}, 'FooBarBazQuux';
+ };
+ \$self;
+}
+
+package ${appclass}::Model::TopLevel::Nested;
+
+sub COMPONENT { die "COMPONENT called in the wrong order!"; }
+
+1;
+
+EOF
+
+write_component_file([$libdir, $appclass, 'Model', 'TopLevel'], 'Nested', <<EOF);
+package ${appclass}::Model::TopLevel::Nested;
+use base 'Catalyst::Model';
+
+my \$called=0;
+no warnings 'redefine';
+sub COMPONENT { \$called++;return shift->next::method(\@_); }
+sub called { return \$called };
+1;
+
+EOF
+
+eval "package $appclass; use Catalyst; __PACKAGE__->setup";
+
+is($@, '', "Didn't load component twice");
+is($appclass->model('TopLevel::Nested')->called,1, 'COMPONENT called once');
+
+ok($appclass->model('TopLevel::Generated'), 'Have generated model');
+is(ref($appclass->model('TopLevel::Generated')), 'FooBarBazQuux',
+ 'ACCEPT_CONTEXT in generated inner package fired as expected');
+
+$appclass = "InnerComponent";
+
+{
+ package InnerComponent::Controller::Test;
+ use base 'Catalyst::Controller';
+}
+
+$INC{'InnerComponent/Controller/Test.pm'} = 1;
+
+eval "package $appclass; use Catalyst; __PACKAGE__->setup";
+
+isa_ok($appclass->controller('Test'), 'Catalyst::Controller');
+
+rmtree($libdir);
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_component_mro.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component_mro.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_component_mro.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_component_mro.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,29 @@
+use Test::More tests => 1;
+use strict;
+use warnings;
+
+{
+ package MyApp::Component;
+ use Test::More;
+
+ sub COMPONENT {
+ fail 'This no longer gets dispatched to';
+ }
+
+ package MyApp::MyComponent;
+
+ use base 'Catalyst::Component', 'MyApp::Component';
+
+}
+
+my $warn = '';
+{
+ local $SIG{__WARN__} = sub {
+ $warn .= $_[0];
+ };
+ MyApp::MyComponent->COMPONENT('MyApp');
+}
+
+like($warn, qr/after Catalyst::Component in MyApp::Component/,
+ 'correct warning thrown');
+
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_engine_fixenv-iis6.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_engine_fixenv-iis6.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_engine_fixenv-iis6.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_engine_fixenv-iis6.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,62 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use FCGI";
+plan skip_all => 'FCGI required' if $@;
+
+plan tests => 2;
+
+require Catalyst::Engine::FastCGI;
+
+my %env = (
+ 'SCRIPT_NAME' => '/koo/blurb',
+ 'PATH_INFO' => '/koo/blurb',
+ 'HTTP_ACCEPT' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
+ 'REQUEST_METHOD' => 'GET',
+ 'SCRIPT_FILENAME' => 'C:\\Foo\\script\\blurb',
+ 'INSTANCE_META_PATH' => '/LM/W3SVC/793536',
+ 'SERVER_SOFTWARE' => 'Microsoft-IIS/6.0',
+ 'AUTH_PASSWORD' => '',
+ 'AUTH_TYPE' => '',
+ 'HTTP_USER_AGENT' => 'Mozilla/5.0 (Windows; U; Windows NT 5.2; de; rv:1.9.0.4) Gecko/2008102920 Firefox/3.0.4 (.NET CLR 3.5.30729)',
+ 'REMOTE_PORT' => '1281',
+ 'QUERY_STRING' => '',
+ 'URL' => '/koo/blurb',
+ 'HTTP_ACCEPT_LANGUAGE' => 'de-de,de;q=0.8,en-us;q=0.5,en;q=0.3',
+ 'FCGI_ROLE' => 'RESPONDER',
+ 'HTTP_KEEP_ALIVE' => '300',
+ 'CONTENT_TYPE' => '',
+ 'LOCAL_ADDR' => '127.0.0.1',
+ 'GATEWAY_INTERFACE' => 'CGI/1.1',
+ 'HTTPS' => 'off',
+ 'DOCUMENT_ROOT' => 'C:\\Foo\\script',
+ 'REMOTE_HOST' => '127.0.0.1',
+ 'PATH_TRANSLATED' => 'C:\\Foo\\script\\blurb',
+ 'APPL_PHYSICAL_PATH' => 'C:\\Foo\\script\\',
+ 'SERVER_NAME' => '127.0.0.1',
+ 'HTTP_ACCEPT_ENCODING' => 'gzip,deflate',
+ 'HTTP_CONNECTION' => 'keep-alive',
+ 'INSTANCE_ID' => '793536',
+ 'CONTENT_LENGTH' => '0',
+ 'AUTH_USER' => '',
+ 'APPL_MD_PATH' => '/LM/W3SVC/793536/Root/koo',
+ 'HTTP_ACCEPT_CHARSET' => 'ISO-8859-1,utf-8;q=0.7,*;q=0.7',
+ 'REMOTE_USER' => '',
+ 'SERVER_PORT_SECURE' => '0',
+ 'SERVER_PORT' => 83,
+ 'REMOTE_ADDR' => '127.0.0.1',
+ 'SERVER_PROTOCOL' => 'HTTP/1.1',
+ 'REQUEST_URI' => '/koo/blurb',
+ 'APP_POOL_ID' => 'DefaultAppPool',
+ 'HTTP_HOST' => '127.0.0.1:83'
+);
+
+Catalyst::Engine::FastCGI->_fix_env(\%env);
+
+is($env{PATH_INFO}, '//blurb', 'check PATH_INFO');
+is($env{SCRIPT_NAME}, '/koo', 'check SCRIPT_NAME');
+
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_engine_fixenv-lighttpd.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_engine_fixenv-lighttpd.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_engine_fixenv-lighttpd.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_engine_fixenv-lighttpd.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,46 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use FCGI";
+plan skip_all => 'FCGI required' if $@;
+
+plan tests => 2;
+
+require Catalyst::Engine::FastCGI;
+
+my %env = (
+ 'SCRIPT_NAME' => '/bar',
+ 'SERVER_NAME' => 'localhost:8000',
+ 'HTTP_ACCEPT_ENCODING' => 'gzip,deflate',
+ 'HTTP_CONNECTION' => 'keep-alive',
+ 'PATH_INFO' => '',
+ 'HTTP_ACCEPT' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
+ 'REQUEST_METHOD' => 'GET',
+ 'SCRIPT_FILENAME' => '/tmp/Foo/root/bar',
+ 'HTTP_ACCEPT_CHARSET' => 'ISO-8859-1,utf-8;q=0.7,*;q=0.7',
+ 'SERVER_SOFTWARE' => 'lighttpd/1.4.15',
+ 'QUERY_STRING' => '',
+ 'REMOTE_PORT' => '22207',
+ 'SERVER_PORT' => 8000,
+ 'REDIRECT_STATUS' => '200',
+ 'HTTP_ACCEPT_LANGUAGE' => 'en-us,en;q=0.5',
+ 'REMOTE_ADDR' => '127.0.0.1',
+ 'FCGI_ROLE' => 'RESPONDER',
+ 'HTTP_KEEP_ALIVE' => '300',
+ 'SERVER_PROTOCOL' => 'HTTP/1.1',
+ 'REQUEST_URI' => '/bar',
+ 'GATEWAY_INTERFACE' => 'CGI/1.1',
+ 'SERVER_ADDR' => '127.0.0.1',
+ 'DOCUMENT_ROOT' => '/tmp/Foo/root',
+ 'HTTP_HOST' => 'localhost:8000',
+);
+
+Catalyst::Engine::FastCGI->_fix_env(\%env);
+
+is($env{PATH_INFO}, '/bar', 'check PATH_INFO');
+ok(!exists($env{SCRIPT_NAME}), 'check SCRIPT_NAME');
+
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_log.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_log.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_log.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_log.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,70 @@
+use strict;
+use warnings;
+
+use Test::More tests => 23;
+
+use Catalyst::Log;
+
+local *Catalyst::Log::_send_to_log;
+
+my @MESSAGES;
+{
+ no warnings 'redefine';
+ *Catalyst::Log::_send_to_log = sub {
+ my $self = shift;
+ push @MESSAGES, @_;
+ };
+}
+
+my $LOG = 'Catalyst::Log';
+
+can_ok $LOG, 'new';
+ok my $log = $LOG->new, '... and creating a new log object should succeed';
+isa_ok $log, $LOG, '... and the object it returns';
+
+can_ok $log, 'is_info';
+ok $log->is_info, '... and the default behavior is to allow info messages';
+
+can_ok $log, 'info';
+ok $log->info('hello there!'),
+ '... passing it an info message should succeed';
+
+can_ok $log, "_flush";
+$log->_flush;
+ok @MESSAGES, '... and flushing the log should succeed';
+is scalar @MESSAGES, 1, '... with one log message';
+like $MESSAGES[0], qr/^\[info\] hello there!$/,
+ '... which should match the format we expect';
+
+{
+
+ package Catalyst::Log::Subclass;
+ use base qw/Catalyst::Log/;
+
+ sub _send_to_log {
+ my $self = shift;
+ push @MESSAGES, '---';
+ push @MESSAGES, @_;
+ }
+}
+
+my $SUBCLASS = 'Catalyst::Log::Subclass';
+can_ok $SUBCLASS, 'new';
+ok $log = Catalyst::Log::Subclass->new,
+ '... and the log subclass constructor shoudl return a new object';
+isa_ok $log, $SUBCLASS, '... and the object it returns';
+isa_ok $log, $LOG, '... and it also';
+
+can_ok $log, 'info';
+ok $log->info('hi there!'),
+ '... passing it an info message should succeed';
+
+can_ok $log, "_flush";
+ at MESSAGES = (); # clear the message log
+$log->_flush;
+ok @MESSAGES, '... and flushing the log should succeed';
+is scalar @MESSAGES, 2, '... with two log messages';
+is $MESSAGES[0], '---', '... with the first one being our new data';
+like $MESSAGES[1], qr/^\[info\] hi there!$/,
+ '... which should match the format we expect';
+
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_merge_config_hashes.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_merge_config_hashes.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_merge_config_hashes.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_merge_config_hashes.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,43 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+my @tests = (
+ {
+ given => [ { a => 1 }, { b => 1 } ],
+ expects => { a => 1, b => 1 }
+ },
+ {
+ given => [ { a => 1 }, { a => { b => 1 } } ],
+ expects => { a => { b => 1 } }
+ },
+ {
+ given => [ { a => { b => 1 } }, { a => 1 } ],
+ expects => { a => 1 }
+ },
+ {
+ given => [ { a => 1 }, { a => [ 1 ] } ],
+ expects => { a => [ 1 ] }
+ },
+ {
+ given => [ { a => [ 1 ] }, { a => 1 } ],
+ expects => { a => 1 }
+ },
+ {
+ given => [ { a => { b => 1 } }, { a => { b => 2 } } ],
+ expects => { a => { b => 2 } }
+ },
+ {
+ given => [ { a => { b => 1 } }, { a => { c => 1 } } ],
+ expects => { a => { b => 1, c => 1 } }
+ },
+);
+
+plan tests => scalar @tests;
+
+use Catalyst::Component;
+
+for my $test ( @ tests ) {
+ is_deeply( Catalyst::Component->merge_config_hashes( @{ $test->{ given } } ), $test->{ expects } );
+}
Added: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_mvc.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_mvc.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_mvc.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,183 @@
+use Test::More tests => 46;
+use strict;
+use warnings;
+
+use_ok('Catalyst');
+
+my @complist =
+ map { "MyMVCTestApp::$_"; }
+ qw/C::Controller M::Model V::View Controller::C Model::M View::V Controller::Model::Dummy::Model Model::Dummy::Model/;
+
+{
+
+ package MyMVCTestApp;
+
+ use base qw/Catalyst/;
+
+ __PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } @complist } );
+
+ my $thingie={};
+ bless $thingie, 'Some::Test::Object';
+ __PACKAGE__->components->{'MyMVCTestApp::Model::Test::Object'} = $thingie;
+
+ # allow $c->log->warn to work
+ __PACKAGE__->setup_log;
+}
+
+is( MyMVCTestApp->view('View'), 'MyMVCTestApp::V::View', 'V::View ok' );
+
+is( MyMVCTestApp->controller('Controller'),
+ 'MyMVCTestApp::C::Controller', 'C::Controller ok' );
+
+is( MyMVCTestApp->model('Model'), 'MyMVCTestApp::M::Model', 'M::Model ok' );
+
+is( MyMVCTestApp->model('Dummy::Model'), 'MyMVCTestApp::Model::Dummy::Model', 'Model::Dummy::Model ok' );
+
+isa_ok( MyMVCTestApp->model('Test::Object'), 'Some::Test::Object', 'Test::Object ok' );
+
+is( MyMVCTestApp->controller('Model::Dummy::Model'), 'MyMVCTestApp::Controller::Model::Dummy::Model', 'Controller::Model::Dummy::Model ok' );
+
+is( MyMVCTestApp->view('V'), 'MyMVCTestApp::View::V', 'View::V ok' );
+
+is( MyMVCTestApp->controller('C'), 'MyMVCTestApp::Controller::C', 'Controller::C ok' );
+
+is( MyMVCTestApp->model('M'), 'MyMVCTestApp::Model::M', 'Model::M ok' );
+
+# failed search
+{
+ is( MyMVCTestApp->model('DNE'), undef, 'undef for invalid search' );
+}
+
+is_deeply( [ sort MyMVCTestApp->views ],
+ [ qw/V View/ ],
+ 'views ok' );
+
+is_deeply( [ sort MyMVCTestApp->controllers ],
+ [ qw/C Controller Model::Dummy::Model/ ],
+ 'controllers ok');
+
+is_deeply( [ sort MyMVCTestApp->models ],
+ [ qw/Dummy::Model M Model Test::Object/ ],
+ 'models ok');
+
+{
+ my $warnings = 0;
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+
+ like (MyMVCTestApp->view , qr/^MyMVCTestApp\::(V|View)\::/ , 'view() with no defaults returns *something*');
+ ok( $warnings, 'view() w/o a default is random, warnings thrown' );
+}
+
+is ( bless ({stash=>{current_view=>'V'}}, 'MyMVCTestApp')->view , 'MyMVCTestApp::View::V', 'current_view ok');
+
+my $view = bless {} , 'MyMVCTestApp::View::V';
+is ( bless ({stash=>{current_view_instance=> $view }}, 'MyMVCTestApp')->view , $view, 'current_view_instance ok');
+
+is ( bless ({stash=>{current_view_instance=> $view, current_view=>'MyMVCTestApp::V::View' }}, 'MyMVCTestApp')->view , $view,
+ 'current_view_instance precedes current_view ok');
+
+{
+ my $warnings = 0;
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+
+ ok( my $model = MyMVCTestApp->model );
+
+ ok( (($model =~ /^MyMVCTestApp\::(M|Model)\::/) ||
+ $model->isa('Some::Test::Object')),
+ 'model() with no defaults returns *something*' );
+
+ ok( $warnings, 'model() w/o a default is random, warnings thrown' );
+}
+
+is ( bless ({stash=>{current_model=>'M'}}, 'MyMVCTestApp')->model , 'MyMVCTestApp::Model::M', 'current_model ok');
+
+my $model = bless {} , 'MyMVCTestApp::Model::M';
+is ( bless ({stash=>{current_model_instance=> $model }}, 'MyMVCTestApp')->model , $model, 'current_model_instance ok');
+
+is ( bless ({stash=>{current_model_instance=> $model, current_model=>'MyMVCTestApp::M::Model' }}, 'MyMVCTestApp')->model , $model,
+ 'current_model_instance precedes current_model ok');
+
+MyMVCTestApp->config->{default_view} = 'V';
+is ( bless ({stash=>{}}, 'MyMVCTestApp')->view , 'MyMVCTestApp::View::V', 'default_view ok');
+is ( MyMVCTestApp->view , 'MyMVCTestApp::View::V', 'default_view in class method ok');
+
+MyMVCTestApp->config->{default_model} = 'M';
+is ( bless ({stash=>{}}, 'MyMVCTestApp')->model , 'MyMVCTestApp::Model::M', 'default_model ok');
+is ( MyMVCTestApp->model , 'MyMVCTestApp::Model::M', 'default_model in class method ok');
+
+# regexp behavior tests
+{
+ # is_deeply is used because regexp behavior means list context
+ is_deeply( [ MyMVCTestApp->view( qr{^V[ie]+w$} ) ], [ 'MyMVCTestApp::V::View' ], 'regexp view ok' );
+ is_deeply( [ MyMVCTestApp->controller( qr{Dummy\::Model$} ) ], [ 'MyMVCTestApp::Controller::Model::Dummy::Model' ], 'regexp controller ok' );
+ is_deeply( [ MyMVCTestApp->model( qr{Dum{2}y} ) ], [ 'MyMVCTestApp::Model::Dummy::Model' ], 'regexp model ok' );
+
+ # object w/ qr{}
+ is_deeply( [ MyMVCTestApp->model( qr{Test} ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::Model::Test::Object'} ], 'Object returned' );
+
+ {
+ my $warnings = 0;
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+
+ # object w/ regexp fallback
+ is_deeply( [ MyMVCTestApp->model( 'Test' ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::Model::Test::Object'} ], 'Object returned' );
+ ok( $warnings, 'regexp fallback warnings' );
+ }
+
+ is_deeply( [ MyMVCTestApp->view('MyMVCTestApp::V::View$') ], [ 'MyMVCTestApp::V::View' ], 'Explicit return ok');
+ is_deeply( [ MyMVCTestApp->controller('MyMVCTestApp::C::Controller$') ], [ 'MyMVCTestApp::C::Controller' ], 'Explicit return ok');
+ is_deeply( [ MyMVCTestApp->model('MyMVCTestApp::M::Model$') ], [ 'MyMVCTestApp::M::Model' ], 'Explicit return ok');
+}
+
+{
+ my @expected = qw( MyMVCTestApp::C::Controller MyMVCTestApp::Controller::C );
+ is_deeply( [ sort MyMVCTestApp->controller( qr{^C} ) ], \@expected, 'multiple controller returns from regexp search' );
+}
+
+{
+ my @expected = qw( MyMVCTestApp::V::View MyMVCTestApp::View::V );
+ is_deeply( [ sort MyMVCTestApp->view( qr{^V} ) ], \@expected, 'multiple view returns from regexp search' );
+}
+
+{
+ my @expected = qw( MyMVCTestApp::M::Model MyMVCTestApp::Model::M );
+ is_deeply( [ sort MyMVCTestApp->model( qr{^M} ) ], \@expected, 'multiple model returns from regexp search' );
+}
+
+# failed search
+{
+ is( scalar MyMVCTestApp->controller( qr{DNE} ), 0, '0 results for failed search' );
+}
+
+#checking @args passed to ACCEPT_CONTEXT
+{
+ my $args;
+
+ {
+ no warnings 'once';
+ *MyMVCTestApp::Model::M::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
+ *MyMVCTestApp::View::V::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
+ }
+
+ my $c = bless {}, 'MyMVCTestApp';
+
+ # test accept-context with class rather than instance
+ MyMVCTestApp->model('M', qw/foo bar/);
+ is_deeply($args, [qw/foo bar/], 'MyMVCTestApp->model args passed to ACCEPT_CONTEXT ok');
+
+
+ $c->model('M', qw/foo bar/);
+ is_deeply($args, [qw/foo bar/], '$c->model args passed to ACCEPT_CONTEXT ok');
+
+ my $x = $c->view('V', qw/foo2 bar2/);
+ is_deeply($args, [qw/foo2 bar2/], '$c->view args passed to ACCEPT_CONTEXT ok');
+
+ # regexp fallback
+ $c->view('::View::V', qw/foo3 bar3/);
+ is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok');
+
+
+}
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_path_to.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_path_to.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_path_to.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_path_to.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+my %non_unix = (
+ MacOS => 1,
+ MSWin32 => 1,
+ os2 => 1,
+ VMS => 1,
+ epoc => 1,
+ NetWare => 1,
+ dos => 1,
+ cygwin => 1
+);
+
+my $os = $non_unix{$^O} ? $^O : 'Unix';
+
+if( $os ne 'Unix' ) {
+ plan skip_all => 'tests require Unix';
+}
+else {
+ plan tests => 3;
+}
+
+use_ok('Catalyst');
+
+my $context = 'Catalyst';
+
+my $config = Catalyst->config;
+
+$config->{home} = '/home/sri/my-app/';
+
+is( Catalyst::path_to( $context, 'foo' ), '/home/sri/my-app/foo', 'Unix path' );
+
+$config->{home} = '/Users/sri/myapp/';
+
+is( Catalyst::path_to( $context, 'foo', 'bar' ),
+ '/Users/sri/myapp/foo/bar', 'deep Unix path' );
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_plugin.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_plugin.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_plugin.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_plugin.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 24;
+
+use lib 't/lib';
+
+{
+
+ package Faux::Plugin;
+
+ sub new { bless {}, shift }
+ my $count = 1;
+ sub count { $count++ }
+}
+
+my $warnings = 0;
+
+use PluginTestApp;
+my $logger = Class::MOP::Class->create_anon_class(
+ methods => {
+ error => sub {0},
+ debug => sub {0},
+ info => sub {0},
+ warn => sub {
+ if ($_[1] =~ /plugin method is deprecated/) {
+ $warnings++;
+ return;
+ }
+ die "Caught unexpected warning: " . $_[1];
+ },
+ },
+)->new_object;
+PluginTestApp->log($logger);
+
+use Catalyst::Test qw/PluginTestApp/;
+
+ok( get("/compile_time_plugins"), "get ok" );
+is( $warnings, 0, 'no warnings' );
+# FIXME - Run time plugin support is insane, and should be removed
+# for Catalyst 5.9
+ok( get("/run_time_plugins"), "get ok" );
+
+local $ENV{CATALYST_DEBUG} = 0;
+
+is( $warnings, 1, '1 warning' );
+
+use_ok 'TestApp';
+my @expected = qw(
+ Catalyst::Plugin::Test::Errors
+ Catalyst::Plugin::Test::Headers
+ Catalyst::Plugin::Test::Inline
+ Catalyst::Plugin::Test::MangleDollarUnderScore
+ Catalyst::Plugin::Test::Plugin
+ TestApp::Plugin::AddDispatchTypes
+ TestApp::Plugin::FullyQualified
+);
+
+# Faux::Plugin is no longer reported
+is_deeply [ TestApp->registered_plugins ], \@expected,
+ 'registered_plugins() should only report the plugins for the current class';
+
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_setup.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_setup.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_setup.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,88 @@
+use strict;
+use warnings;
+use Class::MOP::Class;
+use Catalyst::Runtime;
+
+use Test::More tests => 29;
+
+{
+ # Silence the log.
+ my $meta = Catalyst::Log->meta;
+ $meta->make_mutable;
+ $meta->remove_method('_send_to_log');
+ $meta->add_method('_send_to_log', sub {});
+}
+
+sub build_test_app_with_setup {
+ my ($name, @flags) = @_;
+ my $flags = '(' . join(', ', map { "'".$_."'" } @flags) . ')';
+ $flags = '' if $flags eq '()';
+ eval qq{
+ package $name;
+ use Catalyst $flags;
+ $name->setup;
+ };
+ die $@ if $@;
+ return $name;
+}
+
+local %ENV = %ENV;
+
+# Remove all relevant env variables to avoid accidental fail
+foreach my $name (grep { /^(CATALYST|TESTAPP)/ } keys %ENV) {
+ delete $ENV{$name};
+}
+
+{
+ my $app = build_test_app_with_setup('TestAppMyTestDebug', '-Debug');
+
+ ok my $c = $app->new, 'Get debug app object';
+ ok my $log = $c->log, 'Get log object';
+ isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object';
+ ok $log->is_warn, 'Warnings should be enabled';
+ ok $log->is_error, 'Errors should be enabled';
+ ok $log->is_fatal, 'Fatal errors should be enabled';
+ ok $log->is_info, 'Info should be enabled';
+ ok $log->is_debug, 'Debugging should be enabled';
+ ok $app->debug, 'debug method should return true';
+}
+
+{
+ my $app = build_test_app_with_setup('TestAppMyTestLogParam', '-Log=warn,error,fatal');
+
+ ok my $c = $app->new, 'Get log app object';
+ ok my $log = $c->log, 'Get log object';
+ isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object';
+ ok $log->is_warn, 'Warnings should be enabled';
+ ok $log->is_error, 'Errors should be enabled';
+ ok $log->is_fatal, 'Fatal errors should be enabled';
+ ok !$log->is_info, 'Info should be disabled';
+ ok !$log->is_debug, 'Debugging should be disabled';
+ ok !$c->debug, 'Catalyst debugging is off';
+}
+{
+ my $app = build_test_app_with_setup('TestAppMyTestNoParams');
+
+ ok my $c = $app->new, 'Get log app object';
+ ok my $log = $c->log, 'Get log object';
+ isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object';
+ ok $log->is_warn, 'Warnings should be enabled';
+ ok $log->is_error, 'Errors should be enabled';
+ ok $log->is_fatal, 'Fatal errors should be enabled';
+ ok $log->is_info, 'Info should be enabled';
+ ok $log->is_debug, 'Debugging should be enabled';
+ ok !$c->debug, 'Catalyst debugging turned off';
+}
+my $log_meta = Class::MOP::Class->create_anon_class(
+ methods => { map { $_ => sub { 0 } } qw/debug error fatal info warn/ },
+);
+{
+ package TestAppWithOwnLogger;
+ use base qw/Catalyst/;
+ __PACKAGE__->log($log_meta->new_object);
+ __PACKAGE__->setup('-Debug');
+}
+
+ok my $c = TestAppWithOwnLogger->new, 'Get with own logger app object';
+ok $c->debug, '$c->debug is true';
+
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_setup_log.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup_log.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_setup_log.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_setup_log.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,101 @@
+use strict;
+use warnings;
+
+use Test::More tests => 30;
+use Test::Exception;
+
+use Catalyst ();
+
+sub mock_app {
+ my $name = shift;
+ print "Setting up mock application: $name\n";
+ my $meta = Moose->init_meta( for_class => $name );
+ $meta->superclasses('Catalyst');
+ return $meta->name;
+}
+
+sub test_log_object {
+ my ($log, %expected) = @_;
+ foreach my $level (keys %expected) {
+ my $method_name = "is_$level";
+ if ($expected{$level}) {
+ ok( $log->$method_name(), "Level $level on" );
+ }
+ else {
+ ok( !$log->$method_name(), "Level $level off" );
+ }
+ }
+}
+
+local %ENV = %ENV;
+
+# Remove all relevant env variables to avoid accidental fail
+foreach my $name (grep { /^(CATALYST|TESTAPP)/ } keys %ENV) {
+ delete $ENV{$name};
+}
+
+{
+ my $app = mock_app('TestAppParseLogLevels');
+ $app->setup_log('error,warn');
+ ok !$app->debug, 'Not in debug mode';
+ test_log_object($app->log,
+ fatal => 1,
+ error => 1,
+ warn => 1,
+ info => 0,
+ debug => 0,
+ );
+}
+{
+ local %ENV = %ENV;
+ $ENV{CATALYST_DEBUG} = 1;
+ my $app = mock_app('TestAppLogDebugEnvSet');
+ $app->setup_log('');
+ ok $app->debug, 'In debug mode';
+ test_log_object($app->log,
+ fatal => 1,
+ error => 1,
+ warn => 1,
+ info => 1,
+ debug => 1,
+ );
+}
+{
+ local %ENV = %ENV;
+ $ENV{CATALYST_DEBUG} = 0;
+ my $app = mock_app('TestAppLogDebugEnvUnset');
+ $app->setup_log('warn');
+ ok !$app->debug, 'Not In debug mode';
+ test_log_object($app->log,
+ fatal => 1,
+ error => 1,
+ warn => 1,
+ info => 0,
+ debug => 0,
+ );
+}
+{
+ my $app = mock_app('TestAppLogEmptyString');
+ $app->setup_log('');
+ ok !$app->debug, 'Not In debug mode';
+ # Note that by default, you get _all_ the log levels turned on
+ test_log_object($app->log,
+ fatal => 1,
+ error => 1,
+ warn => 1,
+ info => 1,
+ debug => 1,
+ );
+}
+{
+ my $app = mock_app('TestAppLogDebugOnly');
+ $app->setup_log('debug');
+ ok $app->debug, 'In debug mode';
+ test_log_object($app->log,
+ fatal => 1,
+ error => 1,
+ warn => 1,
+ info => 1,
+ debug => 1,
+ );
+}
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_setup_stats.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup_stats.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_setup_stats.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_setup_stats.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,69 @@
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+use Class::MOP::Class;
+
+use Catalyst ();
+
+my %log_messages; # TODO - Test log messages as expected.
+my $mock_log = Class::MOP::Class->create_anon_class(
+ methods => {
+ map { my $level = $_;
+ $level => sub {
+ $log_messages{$level} ||= [];
+ push(@{ $log_messages{$level} }, $_[1]);
+ },
+ }
+ qw/debug info warn error fatal/,
+ },
+)->new_object;
+
+sub mock_app {
+ my $name = shift;
+ %log_messages = (); # Flatten log messages.
+ my $meta = Moose->init_meta( for_class => $name );
+ $meta->superclasses('Catalyst');
+ $meta->add_method('log', sub { $mock_log });
+ return $meta->name;
+}
+
+local %ENV = %ENV;
+
+# Remove all relevant env variables to avoid accidental fail
+foreach my $name (grep { /^(CATALYST|TESTAPP)/ } keys %ENV) {
+ delete $ENV{$name};
+}
+
+{
+ my $app = mock_app('TestAppNoStats');
+ $app->setup_stats();
+ ok !$app->use_stats, 'stats off by default';
+}
+{
+ my $app = mock_app('TestAppStats');
+ $app->setup_stats(1);
+ ok $app->use_stats, 'stats on if you say >setup_stats(1)';
+}
+{
+ my $app = mock_app('TestAppStatsDebugTurnsStatsOn');
+ $app->meta->add_method('debug' => sub { 1 });
+ $app->setup_stats();
+ ok $app->use_stats, 'debug on turns stats on';
+}
+{
+ local %ENV = %ENV;
+ $ENV{CATALYST_STATS} = 1;
+ my $app = mock_app('TestAppStatsEnvSet');
+ $app->setup_stats();
+ ok $app->use_stats, 'ENV turns stats on';
+}
+{
+ local %ENV = %ENV;
+ $ENV{CATALYST_STATS} = 0;
+ my $app = mock_app('TestAppStatsEnvUnset');
+ $app->meta->add_method('debug' => sub { 1 });
+ $app->setup_stats(1);
+ ok !$app->use_stats, 'ENV turns stats off, even when debug on and ->setup_stats(1)';
+}
+
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_uri_for.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_uri_for.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_uri_for.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_uri_for.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,145 @@
+use strict;
+use warnings;
+
+use Test::More tests => 20;
+use URI;
+
+use_ok('Catalyst');
+
+my $request = Catalyst::Request->new( {
+ base => URI->new('http://127.0.0.1/foo')
+ } );
+
+my $context = Catalyst->new( {
+ request => $request,
+ namespace => 'yada',
+ } );
+
+is(
+ Catalyst::uri_for( $context, '/bar/baz' )->as_string,
+ 'http://127.0.0.1/foo/bar/baz',
+ 'URI for absolute path'
+);
+
+is(
+ Catalyst::uri_for( $context, 'bar/baz' )->as_string,
+ 'http://127.0.0.1/foo/yada/bar/baz',
+ 'URI for relative path'
+);
+
+is(
+ Catalyst::uri_for( $context, '', 'arg1', 'arg2' )->as_string,
+ 'http://127.0.0.1/foo/yada/arg1/arg2',
+ 'URI for undef action with args'
+);
+
+
+is( Catalyst::uri_for( $context, '../quux' )->as_string,
+ 'http://127.0.0.1/foo/quux', 'URI for relative dot path' );
+
+is(
+ Catalyst::uri_for( $context, 'quux', { param1 => 'value1' } )->as_string,
+ 'http://127.0.0.1/foo/yada/quux?param1=value1',
+ 'URI for undef action with query params'
+);
+
+is (Catalyst::uri_for( $context, '/bar/wibble?' )->as_string,
+ 'http://127.0.0.1/foo/bar/wibble%3F', 'Question Mark gets encoded'
+);
+
+is( Catalyst::uri_for( $context, qw/bar wibble?/, 'with space' )->as_string,
+ 'http://127.0.0.1/foo/yada/bar/wibble%3F/with%20space', 'Space gets encoded'
+);
+
+is(
+ Catalyst::uri_for( $context, '/bar', 'with+plus', { 'also' => 'with+plus' })->as_string,
+ 'http://127.0.0.1/foo/bar/with+plus?also=with%2Bplus',
+ 'Plus is not encoded'
+);
+
+# test with utf-8
+is(
+ Catalyst::uri_for( $context, 'quux', { param1 => "\x{2620}" } )->as_string,
+ 'http://127.0.0.1/foo/yada/quux?param1=%E2%98%A0',
+ 'URI for undef action with query params in unicode'
+);
+is(
+ Catalyst::uri_for( $context, 'quux', { 'param:1' => "foo" } )->as_string,
+ 'http://127.0.0.1/foo/yada/quux?param%3A1=foo',
+ 'URI for undef action with query params in unicode'
+);
+
+# test with object
+is(
+ Catalyst::uri_for( $context, 'quux', { param1 => $request->base } )->as_string,
+ 'http://127.0.0.1/foo/yada/quux?param1=http%3A%2F%2F127.0.0.1%2Ffoo',
+ 'URI for undef action with query param as object'
+);
+
+$request->base( URI->new('http://localhost:3000/') );
+$request->match( 'orderentry/contract' );
+is(
+ Catalyst::uri_for( $context, '/Orderentry/saveContract' )->as_string,
+ 'http://localhost:3000/Orderentry/saveContract',
+ 'URI for absolute path'
+);
+
+{
+ $request->base( URI->new('http://127.0.0.1/') );
+
+ $context->namespace('');
+
+ is( Catalyst::uri_for( $context, '/bar/baz' )->as_string,
+ 'http://127.0.0.1/bar/baz', 'URI with no base or match' );
+
+ # test "0" as the path
+ is( Catalyst::uri_for( $context, qw/0 foo/ )->as_string,
+ 'http://127.0.0.1/0/foo', '0 as path is ok'
+ );
+
+}
+
+# test with undef -- no warnings should be thrown
+{
+ my $warnings = 0;
+ local $SIG{__WARN__} = sub { $warnings++ };
+
+ Catalyst::uri_for( $context, '/bar/baz', { foo => undef } )->as_string,
+ is( $warnings, 0, "no warnings emitted" );
+}
+
+# Test with parameters '/', 'foo', 'bar' - should not generate a //
+is( Catalyst::uri_for( $context, qw| / foo bar | )->as_string,
+ 'http://127.0.0.1/foo/bar', 'uri is /foo/bar, not //foo/bar'
+);
+
+TODO: {
+ local $TODO = 'RFCs are for people who, erm - fix this test..';
+ # Test rfc3986 reserved characters. These characters should all be escaped
+ # according to the RFC, but it is a very big feature change so I've removed it
+ no warnings; # Yes, everything in qw is sane
+ is(
+ Catalyst::uri_for( $context, qw|! * ' ( ) ; : @ & = $ / ? % # [ ] ,|, )->as_string,
+ 'http://127.0.0.1/%21/%2A/%27/%2B/%29/%3B/%3A/%40/%26/%3D/%24/%2C/%2F/%3F/%25/%23/%5B/%5D',
+ 'rfc 3986 reserved characters'
+ );
+
+ # jshirley bug - why the hell does only one of these get encoded
+ # has been like this forever however.
+ is(
+ Catalyst::uri_for( $context, qw|{1} {2}| )->as_string,
+ 'http://127.0.0.1/{1}/{2}',
+ 'not-escaping unreserved characters'
+ );
+}
+
+# make sure caller's query parameter hash isn't messed up
+{
+ my $query_params_base = {test => "one two",
+ bar => ["foo baz", "bar"]};
+ my $query_params_test = {test => "one two",
+ bar => ["foo baz", "bar"]};
+ Catalyst::uri_for($context, '/bar/baz', $query_params_test);
+ is_deeply($query_params_base, $query_params_test,
+ "uri_for() doesn't mess up query parameter hash in the caller");
+}
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_uri_with.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_uri_with.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_uri_with.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_core_uri_with.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,69 @@
+use strict;
+use warnings;
+
+use Test::More tests => 10;
+use URI;
+
+use_ok('Catalyst::Request');
+
+my $request = Catalyst::Request->new( {
+ uri => URI->new('http://127.0.0.1/foo/bar/baz')
+ } );
+
+is(
+ $request->uri_with({}),
+ 'http://127.0.0.1/foo/bar/baz',
+ 'URI for absolute path'
+);
+
+is(
+ $request->uri_with({ foo => 'bar' }),
+ 'http://127.0.0.1/foo/bar/baz?foo=bar',
+ 'URI adds param'
+);
+
+my $request2 = Catalyst::Request->new( {
+ uri => URI->new('http://127.0.0.1/foo/bar/baz?bar=gorch')
+ } );
+is(
+ $request2->uri_with({}),
+ 'http://127.0.0.1/foo/bar/baz?bar=gorch',
+ 'URI retains param'
+);
+
+is(
+ $request2->uri_with({ me => 'awesome' }),
+ 'http://127.0.0.1/foo/bar/baz?bar=gorch&me=awesome',
+ 'URI retains param and adds new'
+);
+
+is(
+ $request2->uri_with({ bar => undef }),
+ 'http://127.0.0.1/foo/bar/baz',
+ 'URI loses param when explicitly undef'
+);
+
+is(
+ $request2->uri_with({ bar => 'snort' }),
+ 'http://127.0.0.1/foo/bar/baz?bar=snort',
+ 'URI changes param'
+);
+
+is(
+ $request2->uri_with({ bar => [ 'snort', 'ewok' ] }),
+ 'http://127.0.0.1/foo/bar/baz?bar=snort&bar=ewok',
+ 'overwrite mode URI appends arrayref param'
+);
+
+is(
+ $request2->uri_with({ bar => 'snort' }, { mode => 'append' }),
+ 'http://127.0.0.1/foo/bar/baz?bar=gorch&bar=snort',
+ 'append mode URI appends param'
+);
+
+is(
+ $request2->uri_with({ bar => [ 'snort', 'ewok' ] }, { mode => 'append' }),
+ 'http://127.0.0.1/foo/bar/baz?bar=gorch&bar=snort&bar=ewok',
+ 'append mode URI appends arrayref param'
+);
+
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_dispatcher_requestargs_restore.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_dispatcher_requestargs_restore.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_dispatcher_requestargs_restore.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_dispatcher_requestargs_restore.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,21 @@
+# Insane test case for the behavior needed by Plugin::Auhorization::ACL
+
+# We have to localise $c->request->{arguments} in
+# Catalyst::Dispatcher::_do_forward, rather than using save and restore,
+# as otherwise, the calling $c->detach on an action which says
+# die $Catalyst:DETACH causes the request arguments to not get restored,
+# and therefore sub gorch gets the wrong string $frozjob parameter.
+
+# Please feel free to break this behavior once a sane hook for safely
+# executing another action from the dispatcher (i.e. wrapping actions)
+# is present, so that the Authorization::ACL plugin can be re-written
+# to not be full of such crazy shit.
+
+use strict;
+use warnings;
+use FindBin qw/$Bin/;
+use lib "$Bin/lib";
+use Catalyst::Test 'ACLTestApp';
+use Test::More tests => 1;
+
+request('http://localhost/gorch/wozzle');
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_response.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_response.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_response.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_response.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use Test::More tests => 6;
+
+use_ok('Catalyst::Response');
+
+my $res = Catalyst::Response->new;
+
+# test aliasing of res->code for res->status
+$res->code(500);
+is($res->code, 500, 'code sets itself');
+is($res->status, 500, 'code sets status');
+$res->status(501);
+is($res->code, 501, 'status sets code');
+is($res->body, '', "default response body ''");
+$res->body(undef);
+is($res->body, '', "response body '' after assigned undef");
+
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_utils_env_value.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_env_value.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_utils_env_value.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_utils_env_value.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,44 @@
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+use Catalyst::Utils;
+
+##############################################################################
+### No env vars defined
+##############################################################################
+{
+ ok( !Catalyst::Utils::env_value( 'MyApp', 'Key' ),
+ 'No env values defined returns false'
+ );
+}
+
+##############################################################################
+### App env var defined
+##############################################################################
+{
+ $ENV{'MYAPP2_KEY'} = 'Env value 2';
+ is( Catalyst::Utils::env_value( 'MyApp2', 'Key' ),
+ 'Env value 2', 'Got the right value from the application var' );
+}
+
+##############################################################################
+### Catalyst env var defined
+##############################################################################
+{
+ $ENV{'CATALYST_KEY'} = 'Env value 3';
+ is( Catalyst::Utils::env_value( 'MyApp3', 'Key' ),
+ 'Env value 3', 'Got the right value from the catalyst var' );
+}
+
+##############################################################################
+### Catalyst and Application env vars defined
+##############################################################################
+{
+ $ENV{'CATALYST_KEY'} = 'Env value bad';
+ $ENV{'MYAPP4_KEY'} = 'Env value 4';
+ is( Catalyst::Utils::env_value( 'MyApp4', 'Key' ),
+ 'Env value 4', 'Got the right value from the application var' );
+}
+
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_utils_prefix.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_prefix.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_utils_prefix.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_utils_prefix.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+
+use lib "t/lib";
+
+use Catalyst::Utils;
+
+is( Catalyst::Utils::class2prefix('MyApp::V::Foo::Bar'), 'foo/bar', 'class2prefix works with M/V/C' );
+
+is( Catalyst::Utils::class2prefix('MyApp::Controller::Foo::Bar'), 'foo/bar', 'class2prefix works with Model/View/Controller' );
+
+is( Catalyst::Utils::class2prefix('MyApp::Controller::Foo::View::Bar'), 'foo/view/bar', 'class2prefix works with tricky components' );
+
+is( Catalyst::Utils::appprefix('MyApp::Foo'), 'myapp_foo', 'appprefix works' );
+
+is( Catalyst::Utils::class2appclass('MyApp::Foo::Controller::Bar::View::Baz'), 'MyApp::Foo', 'class2appclass works' );
+
+is( Catalyst::Utils::class2classprefix('MyApp::Foo::Controller::Bar::View::Baz'), 'MyApp::Foo::Controller', 'class2classprefix works' );
+
+is( Catalyst::Utils::class2classsuffix('MyApp::Foo::Controller::Bar::View::Baz'), 'Controller::Bar::View::Baz', 'class2classsuffix works' );
+
+is( Catalyst::Utils::class2env('MyApp::Foo'), 'MYAPP_FOO', 'class2env works' );
Copied: Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_utils_request.t (from rev 11431, Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_request.t)
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_utils_request.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/aggregate/unit_utils_request.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -0,0 +1,27 @@
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+use Catalyst::Utils;
+
+{
+ my $url = "/dump";
+ ok(
+ my $request = Catalyst::Utils::request($url),
+ "Request: simple get without protocol nor host"
+ );
+ like( $request->uri, qr|^http://localhost/|,
+ " has default protocol and host" );
+}
+
+{
+ my $url = "/dump?url=http://www.somewhere.com/";
+ ok(
+ my $request = Catalyst::Utils::request($url),
+ "Same with param containing a url"
+ );
+ like( $request->uri, qr|^http://localhost/|,
+ " has default protocol and host" );
+}
+
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_actions.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_actions.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_actions.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,26 +0,0 @@
-use strict;
-use warnings;
-use Test::More tests => 4;
-
-use Catalyst ();
-{
- package TestController;
- use Moose;
- BEGIN { extends 'Catalyst::Controller' }
-
- sub action : Local {}
-
- sub foo : Path {}
-
- no Moose;
-}
-
-my $mock_app = Class::MOP::Class->create_anon_class( superclasses => ['Catalyst'] );
-my $app = $mock_app->name->new;
-my $controller = TestController->new($app, {actions => { foo => { Path => '/some/path' }}});
-
-ok $controller->can('_controller_actions');
-is_deeply $controller->_controller_actions => { foo => { Path => '/some/path' }};
-is_deeply $controller->{actions} => { foo => { Path => '/some/path' }}; # Back compat.
-is_deeply [ sort grep { ! /^_/ } map { $_->name } $controller->get_action_methods ], [sort qw/action foo/];
-
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_config.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_config.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_config.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,91 +0,0 @@
-## ============================================================================
-## Test to make sure that subclassed controllers (catalyst controllers
-## that inherit from a custom base catalyst controller) don't experienc
-## any namespace collision in the values under config.
-## ============================================================================
-
-use Test::More tests => 9;
-
-use strict;
-use warnings;
-
-use_ok('Catalyst');
-
-## ----------------------------------------------------------------------------
-## First We define a base controller that inherits from Catalyst::Controller
-## We add something to the config that we expect all children classes to
-## be able to find.
-## ----------------------------------------------------------------------------
-
-{
- package base_controller;
-
- use base 'Catalyst::Controller';
-
- __PACKAGE__->config( base_key => 'base_value' );
-}
-
-## ----------------------------------------------------------------------------
-## Next we instantiate two classes that inherit from the base controller. We
-## Add some local config information to these.
-## ----------------------------------------------------------------------------
-
-{
- package controller_a;
-
- use base 'base_controller';
-
- __PACKAGE__->config( key_a => 'value_a' );
-}
-
-
-{
- package controller_b;
-
- use base 'base_controller';
-
- __PACKAGE__->config->{key_b} = 'value_b';
-}
-
-## Okay, we expect that the base controller has a config with one key
-## and that the two children controllers inherit that config key and then
-## add one more. So the base controller has one config value and the two
-## children each have two.
-
-## ----------------------------------------------------------------------------
-## THE TESTS. Basically we first check to make sure that all the children of
-## the base_controller properly inherit the {base_key => 'base_value'} info
-## and that each of the children also has its local config data and that none
-## of the classes have data that is unexpected.
-## ----------------------------------------------------------------------------
-
-
-# First round, does everything have what we expect to find? If these tests fail there is something
-# wrong with the way config is storing its information.
-
-ok( base_controller->config->{base_key} eq 'base_value', 'base_controller has expected config value for "base_key"') or
- diag('"base_key" defined as "'.base_controller->config->{base_key}.'" and not "base_value" in config');
-
-ok( controller_a->config->{base_key} eq 'base_value', 'controller_a has expected config value for "base_key"') or
- diag('"base_key" defined as "'.controller_a->config->{base_key}.'" and not "base_value" in config');
-
-ok( controller_a->config->{key_a} eq 'value_a', 'controller_a has expected config value for "key_a"') or
- diag('"key_a" defined as "'.controller_a->config->{key_a}.'" and not "value_a" in config');
-
-ok( controller_b->config->{base_key} eq 'base_value', 'controller_b has expected config value for "base_key"') or
- diag('"base_key" defined as "'.controller_b->config->{base_key}.'" and not "base_value" in config');
-
-ok( controller_b->config->{key_b} eq 'value_b', 'controller_b has expected config value for "key_b"') or
- diag('"key_b" defined as "'.controller_b->config->{key_b}.'" and not "value_b" in config');
-
-# second round, does each controller have the expected number of config values? If this test fails there is
-# probably some data collision between the controllers.
-
-ok( scalar(keys %{base_controller->config}) == 1, 'base_controller has the expected number of config values') or
- diag("base_controller should have 1 config value, but it has ".scalar(keys %{base_controller->config}));
-
-ok( scalar(keys %{controller_a->config}) == 2, 'controller_a has the expected number of config values') or
- diag("controller_a should have 2 config value, but it has ".scalar(keys %{base_controller->config}));
-
-ok( scalar(keys %{controller_b->config}) == 2, 'controller_b has the expected number of config values') or
- diag("controller_a should have 2 config value, but it has ".scalar(keys %{base_controller->config}));
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_namespace.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_namespace.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_controller_namespace.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,24 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More tests => 2;
-
-BEGIN {
- package MyApp::Controller::Foo;
-
- use base qw/Catalyst::Controller/;
-
- package MyApp::Controller::Root;
-
- use base qw/Catalyst::Controller/;
-
- __PACKAGE__->config(namespace => '');
-
- package Stub;
-
- sub config { {} };
-}
-
-is(MyApp::Controller::Foo->action_namespace('Stub'), 'foo');
-
-is(MyApp::Controller::Root->action_namespace('Stub'), '');
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_action.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_action.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_action.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,54 +0,0 @@
-use Test::More tests => 6;
-use strict;
-use warnings;
-use Moose::Meta::Class;
-#use Moose::Meta::Attribute;
-use Catalyst::Request;
-
-use_ok('Catalyst::Action');
-
-my $action_1 = Catalyst::Action->new(
- name => 'foo',
- code => sub { "DUMMY" },
- reverse => 'bar/foo',
- namespace => 'bar',
- attributes => {
- Args => [ 1 ],
- attr2 => [ 2 ],
- },
-);
-
-my $action_2 = Catalyst::Action->new(
- name => 'foo',
- code => sub { "DUMMY" },
- reverse => 'bar/foo',
- namespace => 'bar',
- attributes => {
- Args => [ 2 ],
- attr2 => [ 2 ],
- },
-);
-
-is("${action_1}", $action_1->reverse, 'overload string');
-is($action_1->(), 'DUMMY', 'overload code');
-
-my $anon_meta = Moose::Meta::Class->create_anon_class(
- attributes => [
- Moose::Meta::Attribute->new(
- request => (
- reader => 'request',
- required => 1,
- default => sub { Catalyst::Request->new(arguments => [qw/one two/]) },
- ),
- ),
- ],
- methods => { req => sub { shift->request(@_) } }
-);
-
-my $mock_c = $anon_meta->new_object();
-$mock_c->request;
-
-ok(!$action_1->match($mock_c), 'bad match fails');
-ok($action_2->match($mock_c), 'good match works');
-
-ok($action_2->compare( $action_1 ), 'compare works');
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_classdata.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_classdata.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_classdata.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,106 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Scalar::Util qw/refaddr blessed/;
-use Test::More tests => 37;
-
-{
- package ClassDataTest;
- use Moose;
- with 'Catalyst::ClassData';
-
- package ClassDataTest2;
- use Moose;
- extends 'ClassDataTest';
-
-}
-
- my $scalar = '100';
- my $arrayref = [];
- my $hashref = {};
- my $scalarref = \$scalar;
- my $coderef = sub { "beep" };
-
- my $scalar2 = '200';
- my $arrayref2 = [];
- my $hashref2 = {};
- my $scalarref2 = \$scalar2;
- my $coderef2 = sub { "beep" };
-
- my $scalar3 = '300';
- my $arrayref3 = [];
- my $hashref3 = {};
- my $scalarref3 = \$scalar3;
- my $coderef3 = sub { "beep" };
-
-
-my @accessors = qw/_arrayref _hashref _scalarref _coderef _scalar/;
-ClassDataTest->mk_classdata($_) for @accessors;
-can_ok('ClassDataTest', @accessors);
-
-ClassDataTest2->mk_classdata("beep", "meep");
-is(ClassDataTest2->beep, "meep");
-
-ClassDataTest->_arrayref($arrayref);
-ClassDataTest->_hashref($hashref);
-ClassDataTest->_scalarref($scalarref);
-ClassDataTest->_coderef($coderef);
-ClassDataTest->_scalar($scalar);
-
-is(ref(ClassDataTest->_arrayref), 'ARRAY');
-is(ref(ClassDataTest->_hashref), 'HASH');
-is(ref(ClassDataTest->_scalarref), 'SCALAR');
-is(ref(ClassDataTest->_coderef), 'CODE');
-ok( !ref(ClassDataTest->_scalar) );
-is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref));
-is(refaddr(ClassDataTest->_hashref), refaddr($hashref));
-is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref));
-is(refaddr(ClassDataTest->_coderef), refaddr($coderef));
-is(ClassDataTest->_scalar, $scalar);
-
-
-is(ref(ClassDataTest2->_arrayref), 'ARRAY');
-is(ref(ClassDataTest2->_hashref), 'HASH');
-is(ref(ClassDataTest2->_scalarref), 'SCALAR');
-is(ref(ClassDataTest2->_coderef), 'CODE');
-ok( !ref(ClassDataTest2->_scalar) );
-is(refaddr(ClassDataTest2->_arrayref), refaddr($arrayref));
-is(refaddr(ClassDataTest2->_hashref), refaddr($hashref));
-is(refaddr(ClassDataTest2->_scalarref), refaddr($scalarref));
-is(refaddr(ClassDataTest2->_coderef), refaddr($coderef));
-is(ClassDataTest2->_scalar, $scalar);
-
-ClassDataTest2->_arrayref($arrayref2);
-ClassDataTest2->_hashref($hashref2);
-ClassDataTest2->_scalarref($scalarref2);
-ClassDataTest2->_coderef($coderef2);
-ClassDataTest2->_scalar($scalar2);
-
-is(refaddr(ClassDataTest2->_arrayref), refaddr($arrayref2));
-is(refaddr(ClassDataTest2->_hashref), refaddr($hashref2));
-is(refaddr(ClassDataTest2->_scalarref), refaddr($scalarref2));
-is(refaddr(ClassDataTest2->_coderef), refaddr($coderef2));
-is(ClassDataTest2->_scalar, $scalar2);
-
-is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref));
-is(refaddr(ClassDataTest->_hashref), refaddr($hashref));
-is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref));
-is(refaddr(ClassDataTest->_coderef), refaddr($coderef));
-is(ClassDataTest->_scalar, $scalar);
-
-ClassDataTest->_arrayref($arrayref3);
-ClassDataTest->_hashref($hashref3);
-ClassDataTest->_scalarref($scalarref3);
-ClassDataTest->_coderef($coderef3);
-ClassDataTest->_scalar($scalar3);
-
-is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref3));
-is(refaddr(ClassDataTest->_hashref), refaddr($hashref3));
-is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref3));
-is(refaddr(ClassDataTest->_coderef), refaddr($coderef3));
-is(ClassDataTest->_scalar, $scalar3);
-
-my $i = bless {}, 'ClassDataTest';
-$i->_scalar('foo');
-
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,93 +0,0 @@
-use Test::More tests => 22;
-use strict;
-use warnings;
-
-use_ok('Catalyst');
-
-my @complist = map { "MyApp::$_"; } qw/C::Controller M::Model V::View/;
-
-{
- package MyApp;
-
- use base qw/Catalyst/;
-
- __PACKAGE__->components({ map { ($_, $_) } @complist });
-
- # this is so $c->log->warn will work
- __PACKAGE__->setup_log;
-}
-
-is(MyApp->comp('MyApp::V::View'), 'MyApp::V::View', 'Explicit return ok');
-
-is(MyApp->comp('C::Controller'), 'MyApp::C::Controller', 'Two-part return ok');
-
-is(MyApp->comp('Model'), 'MyApp::M::Model', 'Single part return ok');
-
-is_deeply([ MyApp->comp() ], \@complist, 'Empty return ok');
-
-# Is this desired behaviour?
-is_deeply([ MyApp->comp('Foo') ], \@complist, 'Fallthrough return ok');
-
-# regexp behavior
-{
- is_deeply( [ MyApp->comp( qr{Model} ) ], [ 'MyApp::M::Model'], 'regexp ok' );
- is_deeply( [ MyApp->comp('MyApp::V::View$') ], [ 'MyApp::V::View' ], 'Explicit return ok');
- is_deeply( [ MyApp->comp('MyApp::C::Controller$') ], [ 'MyApp::C::Controller' ], 'Explicit return ok');
- is_deeply( [ MyApp->comp('MyApp::M::Model$') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
-
- # a couple other varieties for regexp fallback
- is_deeply( [ MyApp->comp('M::Model') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
-
- {
- my $warnings = 0;
- no warnings 'redefine';
- local *Catalyst::Log::warn = sub { $warnings++ };
-
- is_deeply( [ MyApp->comp('::M::Model') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
- ok( $warnings, 'regexp fallback warnings' );
-
- $warnings = 0;
- is_deeply( [ MyApp->comp('Mode') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
- ok( $warnings, 'regexp fallback warnings' );
-
- $warnings = 0;
- is(MyApp->comp('::M::'), 'MyApp::M::Model', 'Regex return ok');
- ok( $warnings, 'regexp fallback for comp() warns' );
- }
-
-}
-
-# multiple returns
-{
- my @expected = sort qw( MyApp::C::Controller MyApp::M::Model );
- my @got = sort MyApp->comp( qr{::[MC]::} );
- is_deeply( \@got, \@expected, 'multiple results from regexp ok' );
-}
-
-# failed search
-{
- is_deeply( scalar MyApp->comp( qr{DNE} ), 0, 'no results for failed search' );
-}
-
-
-#checking @args passed to ACCEPT_CONTEXT
-{
- my $args;
-
- {
- no warnings 'once';
- *MyApp::M::Model::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
- }
-
- my $c = bless {}, 'MyApp';
-
- $c->component('MyApp::M::Model', qw/foo bar/);
- is_deeply($args, [qw/foo bar/], 'args passed to ACCEPT_CONTEXT ok');
-
- $c->component('M::Model', qw/foo2 bar2/);
- is_deeply($args, [qw/foo2 bar2/], 'args passed to ACCEPT_CONTEXT ok');
-
- $c->component('Mode', qw/foo3 bar3/);
- is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok');
-}
-
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component_loading.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component_loading.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component_loading.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,226 +0,0 @@
-# 2 initial tests, and 6 per component in the loop below
-# (do not forget to update the number of components in test 3 as well)
-# 5 extra tests for the loading options
-# One test for components in inner packages
-use Test::More tests => 2 + 6 * 24 + 8 + 1;
-
-use strict;
-use warnings;
-
-use File::Spec;
-use File::Path;
-
-my $libdir = 'test_trash';
-unshift(@INC, $libdir);
-
-my $appclass = 'TestComponents';
-my @components = (
- { type => 'Controller', prefix => 'C', name => 'Bar' },
- { type => 'Controller', prefix => 'C', name => 'Foo::Bar' },
- { type => 'Controller', prefix => 'C', name => 'Foo::Foo::Bar' },
- { type => 'Controller', prefix => 'C', name => 'Foo::Foo::Foo::Bar' },
- { type => 'Controller', prefix => 'Controller', name => 'Bar::Bar::Bar::Foo' },
- { type => 'Controller', prefix => 'Controller', name => 'Bar::Bar::Foo' },
- { type => 'Controller', prefix => 'Controller', name => 'Bar::Foo' },
- { type => 'Controller', prefix => 'Controller', name => 'Foo' },
- { type => 'Model', prefix => 'M', name => 'Bar' },
- { type => 'Model', prefix => 'M', name => 'Foo::Bar' },
- { type => 'Model', prefix => 'M', name => 'Foo::Foo::Bar' },
- { type => 'Model', prefix => 'M', name => 'Foo::Foo::Foo::Bar' },
- { type => 'Model', prefix => 'Model', name => 'Bar::Bar::Bar::Foo' },
- { type => 'Model', prefix => 'Model', name => 'Bar::Bar::Foo' },
- { type => 'Model', prefix => 'Model', name => 'Bar::Foo' },
- { type => 'Model', prefix => 'Model', name => 'Foo' },
- { type => 'View', prefix => 'V', name => 'Bar' },
- { type => 'View', prefix => 'V', name => 'Foo::Bar' },
- { type => 'View', prefix => 'V', name => 'Foo::Foo::Bar' },
- { type => 'View', prefix => 'V', name => 'Foo::Foo::Foo::Bar' },
- { type => 'View', prefix => 'View', name => 'Bar::Bar::Bar::Foo' },
- { type => 'View', prefix => 'View', name => 'Bar::Bar::Foo' },
- { type => 'View', prefix => 'View', name => 'Bar::Foo' },
- { type => 'View', prefix => 'View', name => 'Foo' },
-);
-
-sub write_component_file {
- my ($dir_list, $module_name, $content) = @_;
-
- my $dir = File::Spec->catdir(@$dir_list);
- my $file = File::Spec->catfile($dir, $module_name . '.pm');
-
- mkpath(join(q{/}, @$dir_list) );
- open(my $fh, '>', $file) or die "Could not open file $file for writing: $!";
- print $fh $content;
- close $fh;
-}
-
-sub make_component_file {
- my ($type, $prefix, $name) = @_;
-
- my $compbase = "Catalyst::${type}";
- my $fullname = "${appclass}::${prefix}::${name}";
- my @namedirs = split(/::/, $name);
- my $name_final = pop(@namedirs);
- my @dir_list = ($libdir, $appclass, $prefix, @namedirs);
-
- write_component_file(\@dir_list, $name_final, <<EOF);
-package $fullname;
-use MRO::Compat;
-use base '$compbase';
-sub COMPONENT {
- my \$self = shift->next::method(\@_);
- no strict 'refs';
- *{\__PACKAGE__ . "::whoami"} = sub { return \__PACKAGE__; };
- \$self;
-}
-1;
-
-EOF
-}
-
-foreach my $component (@components) {
- make_component_file($component->{type},
- $component->{prefix},
- $component->{name});
-}
-
-my $shut_up_deprecated_warnings = q{
- __PACKAGE__->log(Catalyst::Log->new('fatal'));
-};
-
-eval "package $appclass; use Catalyst; $shut_up_deprecated_warnings __PACKAGE__->setup";
-
-can_ok( $appclass, 'components');
-
-my $complist = $appclass->components;
-
-# the +1 below is for the app class itself
-is(scalar keys %$complist, 24+1, "Correct number of components loaded");
-
-foreach (keys %$complist) {
-
- # Skip the component which happens to be the app itself
- next if $_ eq $appclass;
-
- my $instance = $appclass->component($_);
- isa_ok($instance, $_);
- can_ok($instance, 'whoami');
- is($instance->whoami, $_);
-
- if($_ =~ /^${appclass}::(?:V|View)::(.*)/) {
- my $moniker = $1;
- isa_ok($instance, 'Catalyst::View');
- can_ok($appclass->view($moniker), 'whoami');
- is($appclass->view($moniker)->whoami, $_);
- }
- elsif($_ =~ /^${appclass}::(?:M|Model)::(.*)/) {
- my $moniker = $1;
- isa_ok($instance, 'Catalyst::Model');
- can_ok($appclass->model($moniker), 'whoami');
- is($appclass->model($moniker)->whoami, $_);
- }
- elsif($_ =~ /^${appclass}::(?:C|Controller)::(.*)/) {
- my $moniker = $1;
- isa_ok($instance, 'Catalyst::Controller');
- can_ok($appclass->controller($moniker), 'whoami');
- is($appclass->controller($moniker)->whoami, $_);
- }
- else {
- die "Something is wrong with this test, this should"
- . " have been unreachable";
- }
-}
-
-rmtree($libdir);
-
-# test extra component loading options
-
-$appclass = 'ExtraOptions';
-push @components, { type => 'View', prefix => 'Extra', name => 'Foo' };
-
-foreach my $component (@components) {
- make_component_file($component->{type},
- $component->{prefix},
- $component->{name});
-}
-
-eval qq(
-package $appclass;
-use Catalyst;
-$shut_up_deprecated_warnings
-__PACKAGE__->config->{ setup_components } = {
- search_extra => [ '::Extra' ],
- except => [ "${appclass}::Controller::Foo" ]
-};
-__PACKAGE__->setup;
-);
-
-can_ok( $appclass, 'components');
-
-$complist = $appclass->components;
-
-is(scalar keys %$complist, 24+1, "Correct number of components loaded");
-
-ok( !exists $complist->{ "${appclass}::Controller::Foo" }, 'Controller::Foo was skipped' );
-ok( exists $complist->{ "${appclass}::Extra::Foo" }, 'Extra::Foo was loaded' );
-
-rmtree($libdir);
-
-$appclass = "ComponentOnce";
-
-write_component_file([$libdir, $appclass, 'Model'], 'TopLevel', <<EOF);
-package ${appclass}::Model::TopLevel;
-use base 'Catalyst::Model';
-sub COMPONENT {
-
- my \$self = shift->next::method(\@_);
- no strict 'refs';
- *{\__PACKAGE__ . "::whoami"} = sub { return \__PACKAGE__; };
- *${appclass}::Model::TopLevel::GENERATED::ACCEPT_CONTEXT = sub {
- return bless {}, 'FooBarBazQuux';
- };
- \$self;
-}
-
-package ${appclass}::Model::TopLevel::Nested;
-
-sub COMPONENT { die "COMPONENT called in the wrong order!"; }
-
-1;
-
-EOF
-
-write_component_file([$libdir, $appclass, 'Model', 'TopLevel'], 'Nested', <<EOF);
-package ${appclass}::Model::TopLevel::Nested;
-use base 'Catalyst::Model';
-
-my \$called=0;
-no warnings 'redefine';
-sub COMPONENT { \$called++;return shift->next::method(\@_); }
-sub called { return \$called };
-1;
-
-EOF
-
-eval "package $appclass; use Catalyst; __PACKAGE__->setup";
-
-is($@, '', "Didn't load component twice");
-is($appclass->model('TopLevel::Nested')->called,1, 'COMPONENT called once');
-
-ok($appclass->model('TopLevel::Generated'), 'Have generated model');
-is(ref($appclass->model('TopLevel::Generated')), 'FooBarBazQuux',
- 'ACCEPT_CONTEXT in generated inner package fired as expected');
-
-$appclass = "InnerComponent";
-
-{
- package InnerComponent::Controller::Test;
- use base 'Catalyst::Controller';
-}
-
-$INC{'InnerComponent/Controller/Test.pm'} = 1;
-
-eval "package $appclass; use Catalyst; __PACKAGE__->setup";
-
-isa_ok($appclass->controller('Test'), 'Catalyst::Controller');
-
-rmtree($libdir);
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component_mro.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component_mro.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_component_mro.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,29 +0,0 @@
-use Test::More tests => 1;
-use strict;
-use warnings;
-
-{
- package MyApp::Component;
- use Test::More;
-
- sub COMPONENT {
- fail 'This no longer gets dispatched to';
- }
-
- package MyApp::MyComponent;
-
- use base 'Catalyst::Component', 'MyApp::Component';
-
-}
-
-my $warn = '';
-{
- local $SIG{__WARN__} = sub {
- $warn .= $_[0];
- };
- MyApp::MyComponent->COMPONENT('MyApp');
-}
-
-like($warn, qr/after Catalyst::Component in MyApp::Component/,
- 'correct warning thrown');
-
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_engine_fixenv-iis6.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_engine_fixenv-iis6.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_engine_fixenv-iis6.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,62 +0,0 @@
-#!perl
-
-use strict;
-use warnings;
-
-use Test::More;
-
-eval "use FCGI";
-plan skip_all => 'FCGI required' if $@;
-
-plan tests => 2;
-
-require Catalyst::Engine::FastCGI;
-
-my %env = (
- 'SCRIPT_NAME' => '/koo/blurb',
- 'PATH_INFO' => '/koo/blurb',
- 'HTTP_ACCEPT' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
- 'REQUEST_METHOD' => 'GET',
- 'SCRIPT_FILENAME' => 'C:\\Foo\\script\\blurb',
- 'INSTANCE_META_PATH' => '/LM/W3SVC/793536',
- 'SERVER_SOFTWARE' => 'Microsoft-IIS/6.0',
- 'AUTH_PASSWORD' => '',
- 'AUTH_TYPE' => '',
- 'HTTP_USER_AGENT' => 'Mozilla/5.0 (Windows; U; Windows NT 5.2; de; rv:1.9.0.4) Gecko/2008102920 Firefox/3.0.4 (.NET CLR 3.5.30729)',
- 'REMOTE_PORT' => '1281',
- 'QUERY_STRING' => '',
- 'URL' => '/koo/blurb',
- 'HTTP_ACCEPT_LANGUAGE' => 'de-de,de;q=0.8,en-us;q=0.5,en;q=0.3',
- 'FCGI_ROLE' => 'RESPONDER',
- 'HTTP_KEEP_ALIVE' => '300',
- 'CONTENT_TYPE' => '',
- 'LOCAL_ADDR' => '127.0.0.1',
- 'GATEWAY_INTERFACE' => 'CGI/1.1',
- 'HTTPS' => 'off',
- 'DOCUMENT_ROOT' => 'C:\\Foo\\script',
- 'REMOTE_HOST' => '127.0.0.1',
- 'PATH_TRANSLATED' => 'C:\\Foo\\script\\blurb',
- 'APPL_PHYSICAL_PATH' => 'C:\\Foo\\script\\',
- 'SERVER_NAME' => '127.0.0.1',
- 'HTTP_ACCEPT_ENCODING' => 'gzip,deflate',
- 'HTTP_CONNECTION' => 'keep-alive',
- 'INSTANCE_ID' => '793536',
- 'CONTENT_LENGTH' => '0',
- 'AUTH_USER' => '',
- 'APPL_MD_PATH' => '/LM/W3SVC/793536/Root/koo',
- 'HTTP_ACCEPT_CHARSET' => 'ISO-8859-1,utf-8;q=0.7,*;q=0.7',
- 'REMOTE_USER' => '',
- 'SERVER_PORT_SECURE' => '0',
- 'SERVER_PORT' => 83,
- 'REMOTE_ADDR' => '127.0.0.1',
- 'SERVER_PROTOCOL' => 'HTTP/1.1',
- 'REQUEST_URI' => '/koo/blurb',
- 'APP_POOL_ID' => 'DefaultAppPool',
- 'HTTP_HOST' => '127.0.0.1:83'
-);
-
-Catalyst::Engine::FastCGI->_fix_env(\%env);
-
-is($env{PATH_INFO}, '//blurb', 'check PATH_INFO');
-is($env{SCRIPT_NAME}, '/koo', 'check SCRIPT_NAME');
-
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_engine_fixenv-lighttpd.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_engine_fixenv-lighttpd.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_engine_fixenv-lighttpd.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,46 +0,0 @@
-#!perl
-
-use strict;
-use warnings;
-
-use Test::More;
-
-eval "use FCGI";
-plan skip_all => 'FCGI required' if $@;
-
-plan tests => 2;
-
-require Catalyst::Engine::FastCGI;
-
-my %env = (
- 'SCRIPT_NAME' => '/bar',
- 'SERVER_NAME' => 'localhost:8000',
- 'HTTP_ACCEPT_ENCODING' => 'gzip,deflate',
- 'HTTP_CONNECTION' => 'keep-alive',
- 'PATH_INFO' => '',
- 'HTTP_ACCEPT' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
- 'REQUEST_METHOD' => 'GET',
- 'SCRIPT_FILENAME' => '/tmp/Foo/root/bar',
- 'HTTP_ACCEPT_CHARSET' => 'ISO-8859-1,utf-8;q=0.7,*;q=0.7',
- 'SERVER_SOFTWARE' => 'lighttpd/1.4.15',
- 'QUERY_STRING' => '',
- 'REMOTE_PORT' => '22207',
- 'SERVER_PORT' => 8000,
- 'REDIRECT_STATUS' => '200',
- 'HTTP_ACCEPT_LANGUAGE' => 'en-us,en;q=0.5',
- 'REMOTE_ADDR' => '127.0.0.1',
- 'FCGI_ROLE' => 'RESPONDER',
- 'HTTP_KEEP_ALIVE' => '300',
- 'SERVER_PROTOCOL' => 'HTTP/1.1',
- 'REQUEST_URI' => '/bar',
- 'GATEWAY_INTERFACE' => 'CGI/1.1',
- 'SERVER_ADDR' => '127.0.0.1',
- 'DOCUMENT_ROOT' => '/tmp/Foo/root',
- 'HTTP_HOST' => 'localhost:8000',
-);
-
-Catalyst::Engine::FastCGI->_fix_env(\%env);
-
-is($env{PATH_INFO}, '/bar', 'check PATH_INFO');
-ok(!exists($env{SCRIPT_NAME}), 'check SCRIPT_NAME');
-
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_log.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_log.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_log.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,72 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More tests => 23;
-
-my $LOG;
-
-BEGIN {
- chdir 't' if -d 't';
- use lib '../lib';
- $LOG = 'Catalyst::Log';
- use_ok $LOG or die;
-}
-my @MESSAGES;
-{
- no warnings 'redefine';
- *Catalyst::Log::_send_to_log = sub {
- my $self = shift;
- push @MESSAGES, @_;
- };
-}
-
-can_ok $LOG, 'new';
-ok my $log = $LOG->new, '... and creating a new log object should succeed';
-isa_ok $log, $LOG, '... and the object it returns';
-
-can_ok $log, 'is_info';
-ok $log->is_info, '... and the default behavior is to allow info messages';
-
-can_ok $log, 'info';
-ok $log->info('hello there!'),
- '... passing it an info message should succeed';
-
-can_ok $log, "_flush";
-$log->_flush;
-ok @MESSAGES, '... and flushing the log should succeed';
-is scalar @MESSAGES, 1, '... with one log message';
-like $MESSAGES[0], qr/^\[info\] hello there!$/,
- '... which should match the format we expect';
-
-{
-
- package Catalyst::Log::Subclass;
- use base qw/Catalyst::Log/;
-
- sub _send_to_log {
- my $self = shift;
- push @MESSAGES, '---';
- push @MESSAGES, @_;
- }
-}
-
-my $SUBCLASS = 'Catalyst::Log::Subclass';
-can_ok $SUBCLASS, 'new';
-ok $log = Catalyst::Log::Subclass->new,
- '... and the log subclass constructor shoudl return a new object';
-isa_ok $log, $SUBCLASS, '... and the object it returns';
-isa_ok $log, $LOG, '... and it also';
-
-can_ok $log, 'info';
-ok $log->info('hi there!'),
- '... passing it an info message should succeed';
-
-can_ok $log, "_flush";
- at MESSAGES = (); # clear the message log
-$log->_flush;
-ok @MESSAGES, '... and flushing the log should succeed';
-is scalar @MESSAGES, 2, '... with two log messages';
-is $MESSAGES[0], '---', '... with the first one being our new data';
-like $MESSAGES[1], qr/^\[info\] hi there!$/,
- '... which should match the format we expect';
-
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_merge_config_hashes.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_merge_config_hashes.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_merge_config_hashes.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,43 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-
-my @tests = (
- {
- given => [ { a => 1 }, { b => 1 } ],
- expects => { a => 1, b => 1 }
- },
- {
- given => [ { a => 1 }, { a => { b => 1 } } ],
- expects => { a => { b => 1 } }
- },
- {
- given => [ { a => { b => 1 } }, { a => 1 } ],
- expects => { a => 1 }
- },
- {
- given => [ { a => 1 }, { a => [ 1 ] } ],
- expects => { a => [ 1 ] }
- },
- {
- given => [ { a => [ 1 ] }, { a => 1 } ],
- expects => { a => 1 }
- },
- {
- given => [ { a => { b => 1 } }, { a => { b => 2 } } ],
- expects => { a => { b => 2 } }
- },
- {
- given => [ { a => { b => 1 } }, { a => { c => 1 } } ],
- expects => { a => { b => 1, c => 1 } }
- },
-);
-
-plan tests => scalar @tests + 1;
-
-use_ok('Catalyst');
-
-for my $test ( @ tests ) {
- is_deeply( Catalyst->merge_config_hashes( @{ $test->{ given } } ), $test->{ expects } );
-}
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_mvc.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_mvc.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_mvc.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,183 +0,0 @@
-use Test::More tests => 46;
-use strict;
-use warnings;
-
-use_ok('Catalyst');
-
-my @complist =
- map { "MyApp::$_"; }
- qw/C::Controller M::Model V::View Controller::C Model::M View::V Controller::Model::Dummy::Model Model::Dummy::Model/;
-
-{
-
- package MyApp;
-
- use base qw/Catalyst/;
-
- __PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } @complist } );
-
- my $thingie={};
- bless $thingie, 'Some::Test::Object';
- __PACKAGE__->components->{'MyApp::Model::Test::Object'} = $thingie;
-
- # allow $c->log->warn to work
- __PACKAGE__->setup_log;
-}
-
-is( MyApp->view('View'), 'MyApp::V::View', 'V::View ok' );
-
-is( MyApp->controller('Controller'),
- 'MyApp::C::Controller', 'C::Controller ok' );
-
-is( MyApp->model('Model'), 'MyApp::M::Model', 'M::Model ok' );
-
-is( MyApp->model('Dummy::Model'), 'MyApp::Model::Dummy::Model', 'Model::Dummy::Model ok' );
-
-isa_ok( MyApp->model('Test::Object'), 'Some::Test::Object', 'Test::Object ok' );
-
-is( MyApp->controller('Model::Dummy::Model'), 'MyApp::Controller::Model::Dummy::Model', 'Controller::Model::Dummy::Model ok' );
-
-is( MyApp->view('V'), 'MyApp::View::V', 'View::V ok' );
-
-is( MyApp->controller('C'), 'MyApp::Controller::C', 'Controller::C ok' );
-
-is( MyApp->model('M'), 'MyApp::Model::M', 'Model::M ok' );
-
-# failed search
-{
- is( MyApp->model('DNE'), undef, 'undef for invalid search' );
-}
-
-is_deeply( [ sort MyApp->views ],
- [ qw/V View/ ],
- 'views ok' );
-
-is_deeply( [ sort MyApp->controllers ],
- [ qw/C Controller Model::Dummy::Model/ ],
- 'controllers ok');
-
-is_deeply( [ sort MyApp->models ],
- [ qw/Dummy::Model M Model Test::Object/ ],
- 'models ok');
-
-{
- my $warnings = 0;
- no warnings 'redefine';
- local *Catalyst::Log::warn = sub { $warnings++ };
-
- like (MyApp->view , qr/^MyApp\::(V|View)\::/ , 'view() with no defaults returns *something*');
- ok( $warnings, 'view() w/o a default is random, warnings thrown' );
-}
-
-is ( bless ({stash=>{current_view=>'V'}}, 'MyApp')->view , 'MyApp::View::V', 'current_view ok');
-
-my $view = bless {} , 'MyApp::View::V';
-is ( bless ({stash=>{current_view_instance=> $view }}, 'MyApp')->view , $view, 'current_view_instance ok');
-
-is ( bless ({stash=>{current_view_instance=> $view, current_view=>'MyApp::V::View' }}, 'MyApp')->view , $view,
- 'current_view_instance precedes current_view ok');
-
-{
- my $warnings = 0;
- no warnings 'redefine';
- local *Catalyst::Log::warn = sub { $warnings++ };
-
- ok( my $model = MyApp->model );
-
- ok( (($model =~ /^MyApp\::(M|Model)\::/) ||
- $model->isa('Some::Test::Object')),
- 'model() with no defaults returns *something*' );
-
- ok( $warnings, 'model() w/o a default is random, warnings thrown' );
-}
-
-is ( bless ({stash=>{current_model=>'M'}}, 'MyApp')->model , 'MyApp::Model::M', 'current_model ok');
-
-my $model = bless {} , 'MyApp::Model::M';
-is ( bless ({stash=>{current_model_instance=> $model }}, 'MyApp')->model , $model, 'current_model_instance ok');
-
-is ( bless ({stash=>{current_model_instance=> $model, current_model=>'MyApp::M::Model' }}, 'MyApp')->model , $model,
- 'current_model_instance precedes current_model ok');
-
-MyApp->config->{default_view} = 'V';
-is ( bless ({stash=>{}}, 'MyApp')->view , 'MyApp::View::V', 'default_view ok');
-is ( MyApp->view , 'MyApp::View::V', 'default_view in class method ok');
-
-MyApp->config->{default_model} = 'M';
-is ( bless ({stash=>{}}, 'MyApp')->model , 'MyApp::Model::M', 'default_model ok');
-is ( MyApp->model , 'MyApp::Model::M', 'default_model in class method ok');
-
-# regexp behavior tests
-{
- # is_deeply is used because regexp behavior means list context
- is_deeply( [ MyApp->view( qr{^V[ie]+w$} ) ], [ 'MyApp::V::View' ], 'regexp view ok' );
- is_deeply( [ MyApp->controller( qr{Dummy\::Model$} ) ], [ 'MyApp::Controller::Model::Dummy::Model' ], 'regexp controller ok' );
- is_deeply( [ MyApp->model( qr{Dum{2}y} ) ], [ 'MyApp::Model::Dummy::Model' ], 'regexp model ok' );
-
- # object w/ qr{}
- is_deeply( [ MyApp->model( qr{Test} ) ], [ MyApp->components->{'MyApp::Model::Test::Object'} ], 'Object returned' );
-
- {
- my $warnings = 0;
- no warnings 'redefine';
- local *Catalyst::Log::warn = sub { $warnings++ };
-
- # object w/ regexp fallback
- is_deeply( [ MyApp->model( 'Test' ) ], [ MyApp->components->{'MyApp::Model::Test::Object'} ], 'Object returned' );
- ok( $warnings, 'regexp fallback warnings' );
- }
-
- is_deeply( [ MyApp->view('MyApp::V::View$') ], [ 'MyApp::V::View' ], 'Explicit return ok');
- is_deeply( [ MyApp->controller('MyApp::C::Controller$') ], [ 'MyApp::C::Controller' ], 'Explicit return ok');
- is_deeply( [ MyApp->model('MyApp::M::Model$') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
-}
-
-{
- my @expected = qw( MyApp::C::Controller MyApp::Controller::C );
- is_deeply( [ sort MyApp->controller( qr{^C} ) ], \@expected, 'multiple controller returns from regexp search' );
-}
-
-{
- my @expected = qw( MyApp::V::View MyApp::View::V );
- is_deeply( [ sort MyApp->view( qr{^V} ) ], \@expected, 'multiple view returns from regexp search' );
-}
-
-{
- my @expected = qw( MyApp::M::Model MyApp::Model::M );
- is_deeply( [ sort MyApp->model( qr{^M} ) ], \@expected, 'multiple model returns from regexp search' );
-}
-
-# failed search
-{
- is( scalar MyApp->controller( qr{DNE} ), 0, '0 results for failed search' );
-}
-
-#checking @args passed to ACCEPT_CONTEXT
-{
- my $args;
-
- {
- no warnings 'once';
- *MyApp::Model::M::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
- *MyApp::View::V::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
- }
-
- my $c = bless {}, 'MyApp';
-
- # test accept-context with class rather than instance
- MyApp->model('M', qw/foo bar/);
- is_deeply($args, [qw/foo bar/], 'MyApp->model args passed to ACCEPT_CONTEXT ok');
-
-
- $c->model('M', qw/foo bar/);
- is_deeply($args, [qw/foo bar/], '$c->model args passed to ACCEPT_CONTEXT ok');
-
- my $x = $c->view('V', qw/foo2 bar2/);
- is_deeply($args, [qw/foo2 bar2/], '$c->view args passed to ACCEPT_CONTEXT ok');
-
- # regexp fallback
- $c->view('::View::V', qw/foo3 bar3/);
- is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok');
-
-
-}
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_path_to.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_path_to.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_path_to.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,39 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-
-my %non_unix = (
- MacOS => 1,
- MSWin32 => 1,
- os2 => 1,
- VMS => 1,
- epoc => 1,
- NetWare => 1,
- dos => 1,
- cygwin => 1
-);
-
-my $os = $non_unix{$^O} ? $^O : 'Unix';
-
-if( $os ne 'Unix' ) {
- plan skip_all => 'tests require Unix';
-}
-else {
- plan tests => 3;
-}
-
-use_ok('Catalyst');
-
-my $context = 'Catalyst';
-
-my $config = Catalyst->config;
-
-$config->{home} = '/home/sri/my-app/';
-
-is( Catalyst::path_to( $context, 'foo' ), '/home/sri/my-app/foo', 'Unix path' );
-
-$config->{home} = '/Users/sri/myapp/';
-
-is( Catalyst::path_to( $context, 'foo', 'bar' ),
- '/Users/sri/myapp/foo/bar', 'deep Unix path' );
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_plugin.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_plugin.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_plugin.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,64 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 24;
-
-use lib 't/lib';
-
-{
-
- package Faux::Plugin;
-
- sub new { bless {}, shift }
- my $count = 1;
- sub count { $count++ }
-}
-
-my $warnings = 0;
-
-use PluginTestApp;
-my $logger = Class::MOP::Class->create_anon_class(
- methods => {
- error => sub {0},
- debug => sub {0},
- info => sub {0},
- warn => sub {
- if ($_[1] =~ /plugin method is deprecated/) {
- $warnings++;
- return;
- }
- die "Caught unexpected warning: " . $_[1];
- },
- },
-)->new_object;
-PluginTestApp->log($logger);
-
-use Catalyst::Test qw/PluginTestApp/;
-
-ok( get("/compile_time_plugins"), "get ok" );
-is( $warnings, 0, 'no warnings' );
-# FIXME - Run time plugin support is insane, and should be removed
-# for Catalyst 5.9
-ok( get("/run_time_plugins"), "get ok" );
-
-local $ENV{CATALYST_DEBUG} = 0;
-
-is( $warnings, 1, '1 warning' );
-
-use_ok 'TestApp';
-my @expected = qw(
- Catalyst::Plugin::Test::Errors
- Catalyst::Plugin::Test::Headers
- Catalyst::Plugin::Test::Inline
- Catalyst::Plugin::Test::MangleDollarUnderScore
- Catalyst::Plugin::Test::Plugin
- TestApp::Plugin::AddDispatchTypes
- TestApp::Plugin::FullyQualified
-);
-
-# Faux::Plugin is no longer reported
-is_deeply [ TestApp->registered_plugins ], \@expected,
- 'registered_plugins() should only report the plugins for the current class';
-
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,88 +0,0 @@
-use strict;
-use warnings;
-use Class::MOP::Class;
-use Catalyst::Runtime;
-
-use Test::More tests => 29;
-
-{
- # Silence the log.
- my $meta = Catalyst::Log->meta;
- $meta->make_mutable;
- $meta->remove_method('_send_to_log');
- $meta->add_method('_send_to_log', sub {});
-}
-
-sub build_test_app_with_setup {
- my ($name, @flags) = @_;
- my $flags = '(' . join(', ', map { "'".$_."'" } @flags) . ')';
- $flags = '' if $flags eq '()';
- eval qq{
- package $name;
- use Catalyst $flags;
- $name->setup;
- };
- die $@ if $@;
- return $name;
-}
-
-local %ENV = %ENV;
-
-# Remove all relevant env variables to avoid accidental fail
-foreach my $name (grep { /^(CATALYST|TESTAPP)/ } keys %ENV) {
- delete $ENV{$name};
-}
-
-{
- my $app = build_test_app_with_setup('TestAppMyTestDebug', '-Debug');
-
- ok my $c = $app->new, 'Get debug app object';
- ok my $log = $c->log, 'Get log object';
- isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object';
- ok $log->is_warn, 'Warnings should be enabled';
- ok $log->is_error, 'Errors should be enabled';
- ok $log->is_fatal, 'Fatal errors should be enabled';
- ok $log->is_info, 'Info should be enabled';
- ok $log->is_debug, 'Debugging should be enabled';
- ok $app->debug, 'debug method should return true';
-}
-
-{
- my $app = build_test_app_with_setup('TestAppMyTestLogParam', '-Log=warn,error,fatal');
-
- ok my $c = $app->new, 'Get log app object';
- ok my $log = $c->log, 'Get log object';
- isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object';
- ok $log->is_warn, 'Warnings should be enabled';
- ok $log->is_error, 'Errors should be enabled';
- ok $log->is_fatal, 'Fatal errors should be enabled';
- ok !$log->is_info, 'Info should be disabled';
- ok !$log->is_debug, 'Debugging should be disabled';
- ok !$c->debug, 'Catalyst debugging is off';
-}
-{
- my $app = build_test_app_with_setup('TestAppMyTestNoParams');
-
- ok my $c = $app->new, 'Get log app object';
- ok my $log = $c->log, 'Get log object';
- isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object';
- ok $log->is_warn, 'Warnings should be enabled';
- ok $log->is_error, 'Errors should be enabled';
- ok $log->is_fatal, 'Fatal errors should be enabled';
- ok $log->is_info, 'Info should be enabled';
- ok $log->is_debug, 'Debugging should be enabled';
- ok !$c->debug, 'Catalyst debugging turned off';
-}
-my $log_meta = Class::MOP::Class->create_anon_class(
- methods => { map { $_ => sub { 0 } } qw/debug error fatal info warn/ },
-);
-{
- package TestAppWithOwnLogger;
- use base qw/Catalyst/;
- __PACKAGE__->log($log_meta->new_object);
- __PACKAGE__->setup('-Debug');
-}
-
-ok my $c = TestAppWithOwnLogger->new, 'Get with own logger app object';
-ok $c->debug, '$c->debug is true';
-
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup_log.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup_log.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup_log.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,101 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More tests => 30;
-use Test::Exception;
-
-use Catalyst ();
-
-sub mock_app {
- my $name = shift;
- print "Setting up mock application: $name\n";
- my $meta = Moose->init_meta( for_class => $name );
- $meta->superclasses('Catalyst');
- return $meta->name;
-}
-
-sub test_log_object {
- my ($log, %expected) = @_;
- foreach my $level (keys %expected) {
- my $method_name = "is_$level";
- if ($expected{$level}) {
- ok( $log->$method_name(), "Level $level on" );
- }
- else {
- ok( !$log->$method_name(), "Level $level off" );
- }
- }
-}
-
-local %ENV = %ENV;
-
-# Remove all relevant env variables to avoid accidental fail
-foreach my $name (grep { /^(CATALYST|TESTAPP)/ } keys %ENV) {
- delete $ENV{$name};
-}
-
-{
- my $app = mock_app('TestAppParseLogLevels');
- $app->setup_log('error,warn');
- ok !$app->debug, 'Not in debug mode';
- test_log_object($app->log,
- fatal => 1,
- error => 1,
- warn => 1,
- info => 0,
- debug => 0,
- );
-}
-{
- local %ENV = %ENV;
- $ENV{CATALYST_DEBUG} = 1;
- my $app = mock_app('TestAppLogDebugEnvSet');
- $app->setup_log('');
- ok $app->debug, 'In debug mode';
- test_log_object($app->log,
- fatal => 1,
- error => 1,
- warn => 1,
- info => 1,
- debug => 1,
- );
-}
-{
- local %ENV = %ENV;
- $ENV{CATALYST_DEBUG} = 0;
- my $app = mock_app('TestAppLogDebugEnvUnset');
- $app->setup_log('warn');
- ok !$app->debug, 'Not In debug mode';
- test_log_object($app->log,
- fatal => 1,
- error => 1,
- warn => 1,
- info => 0,
- debug => 0,
- );
-}
-{
- my $app = mock_app('TestAppLogEmptyString');
- $app->setup_log('');
- ok !$app->debug, 'Not In debug mode';
- # Note that by default, you get _all_ the log levels turned on
- test_log_object($app->log,
- fatal => 1,
- error => 1,
- warn => 1,
- info => 1,
- debug => 1,
- );
-}
-{
- my $app = mock_app('TestAppLogDebugOnly');
- $app->setup_log('debug');
- ok $app->debug, 'In debug mode';
- test_log_object($app->log,
- fatal => 1,
- error => 1,
- warn => 1,
- info => 1,
- debug => 1,
- );
-}
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup_stats.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup_stats.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_setup_stats.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,69 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More tests => 5;
-use Class::MOP::Class;
-
-use Catalyst ();
-
-my %log_messages; # TODO - Test log messages as expected.
-my $mock_log = Class::MOP::Class->create_anon_class(
- methods => {
- map { my $level = $_;
- $level => sub {
- $log_messages{$level} ||= [];
- push(@{ $log_messages{$level} }, $_[1]);
- },
- }
- qw/debug info warn error fatal/,
- },
-)->new_object;
-
-sub mock_app {
- my $name = shift;
- %log_messages = (); # Flatten log messages.
- my $meta = Moose->init_meta( for_class => $name );
- $meta->superclasses('Catalyst');
- $meta->add_method('log', sub { $mock_log });
- return $meta->name;
-}
-
-local %ENV = %ENV;
-
-# Remove all relevant env variables to avoid accidental fail
-foreach my $name (grep { /^(CATALYST|TESTAPP)/ } keys %ENV) {
- delete $ENV{$name};
-}
-
-{
- my $app = mock_app('TestAppNoStats');
- $app->setup_stats();
- ok !$app->use_stats, 'stats off by default';
-}
-{
- my $app = mock_app('TestAppStats');
- $app->setup_stats(1);
- ok $app->use_stats, 'stats on if you say >setup_stats(1)';
-}
-{
- my $app = mock_app('TestAppStatsDebugTurnsStatsOn');
- $app->meta->add_method('debug' => sub { 1 });
- $app->setup_stats();
- ok $app->use_stats, 'debug on turns stats on';
-}
-{
- local %ENV = %ENV;
- $ENV{CATALYST_STATS} = 1;
- my $app = mock_app('TestAppStatsEnvSet');
- $app->setup_stats();
- ok $app->use_stats, 'ENV turns stats on';
-}
-{
- local %ENV = %ENV;
- $ENV{CATALYST_STATS} = 0;
- my $app = mock_app('TestAppStatsEnvUnset');
- $app->meta->add_method('debug' => sub { 1 });
- $app->setup_stats(1);
- ok !$app->use_stats, 'ENV turns stats off, even when debug on and ->setup_stats(1)';
-}
-
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_uri_for.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_uri_for.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_uri_for.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,145 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More tests => 20;
-use URI;
-
-use_ok('Catalyst');
-
-my $request = Catalyst::Request->new( {
- base => URI->new('http://127.0.0.1/foo')
- } );
-
-my $context = Catalyst->new( {
- request => $request,
- namespace => 'yada',
- } );
-
-is(
- Catalyst::uri_for( $context, '/bar/baz' )->as_string,
- 'http://127.0.0.1/foo/bar/baz',
- 'URI for absolute path'
-);
-
-is(
- Catalyst::uri_for( $context, 'bar/baz' )->as_string,
- 'http://127.0.0.1/foo/yada/bar/baz',
- 'URI for relative path'
-);
-
-is(
- Catalyst::uri_for( $context, '', 'arg1', 'arg2' )->as_string,
- 'http://127.0.0.1/foo/yada/arg1/arg2',
- 'URI for undef action with args'
-);
-
-
-is( Catalyst::uri_for( $context, '../quux' )->as_string,
- 'http://127.0.0.1/foo/quux', 'URI for relative dot path' );
-
-is(
- Catalyst::uri_for( $context, 'quux', { param1 => 'value1' } )->as_string,
- 'http://127.0.0.1/foo/yada/quux?param1=value1',
- 'URI for undef action with query params'
-);
-
-is (Catalyst::uri_for( $context, '/bar/wibble?' )->as_string,
- 'http://127.0.0.1/foo/bar/wibble%3F', 'Question Mark gets encoded'
-);
-
-is( Catalyst::uri_for( $context, qw/bar wibble?/, 'with space' )->as_string,
- 'http://127.0.0.1/foo/yada/bar/wibble%3F/with%20space', 'Space gets encoded'
-);
-
-is(
- Catalyst::uri_for( $context, '/bar', 'with+plus', { 'also' => 'with+plus' })->as_string,
- 'http://127.0.0.1/foo/bar/with+plus?also=with%2Bplus',
- 'Plus is not encoded'
-);
-
-# test with utf-8
-is(
- Catalyst::uri_for( $context, 'quux', { param1 => "\x{2620}" } )->as_string,
- 'http://127.0.0.1/foo/yada/quux?param1=%E2%98%A0',
- 'URI for undef action with query params in unicode'
-);
-is(
- Catalyst::uri_for( $context, 'quux', { 'param:1' => "foo" } )->as_string,
- 'http://127.0.0.1/foo/yada/quux?param%3A1=foo',
- 'URI for undef action with query params in unicode'
-);
-
-# test with object
-is(
- Catalyst::uri_for( $context, 'quux', { param1 => $request->base } )->as_string,
- 'http://127.0.0.1/foo/yada/quux?param1=http%3A%2F%2F127.0.0.1%2Ffoo',
- 'URI for undef action with query param as object'
-);
-
-$request->base( URI->new('http://localhost:3000/') );
-$request->match( 'orderentry/contract' );
-is(
- Catalyst::uri_for( $context, '/Orderentry/saveContract' )->as_string,
- 'http://localhost:3000/Orderentry/saveContract',
- 'URI for absolute path'
-);
-
-{
- $request->base( URI->new('http://127.0.0.1/') );
-
- $context->namespace('');
-
- is( Catalyst::uri_for( $context, '/bar/baz' )->as_string,
- 'http://127.0.0.1/bar/baz', 'URI with no base or match' );
-
- # test "0" as the path
- is( Catalyst::uri_for( $context, qw/0 foo/ )->as_string,
- 'http://127.0.0.1/0/foo', '0 as path is ok'
- );
-
-}
-
-# test with undef -- no warnings should be thrown
-{
- my $warnings = 0;
- local $SIG{__WARN__} = sub { $warnings++ };
-
- Catalyst::uri_for( $context, '/bar/baz', { foo => undef } )->as_string,
- is( $warnings, 0, "no warnings emitted" );
-}
-
-# Test with parameters '/', 'foo', 'bar' - should not generate a //
-is( Catalyst::uri_for( $context, qw| / foo bar | )->as_string,
- 'http://127.0.0.1/foo/bar', 'uri is /foo/bar, not //foo/bar'
-);
-
-TODO: {
- local $TODO = 'RFCs are for people who, erm - fix this test..';
- # Test rfc3986 reserved characters. These characters should all be escaped
- # according to the RFC, but it is a very big feature change so I've removed it
- no warnings; # Yes, everything in qw is sane
- is(
- Catalyst::uri_for( $context, qw|! * ' ( ) ; : @ & = $ / ? % # [ ] ,|, )->as_string,
- 'http://127.0.0.1/%21/%2A/%27/%2B/%29/%3B/%3A/%40/%26/%3D/%24/%2C/%2F/%3F/%25/%23/%5B/%5D',
- 'rfc 3986 reserved characters'
- );
-
- # jshirley bug - why the hell does only one of these get encoded
- # has been like this forever however.
- is(
- Catalyst::uri_for( $context, qw|{1} {2}| )->as_string,
- 'http://127.0.0.1/{1}/{2}',
- 'not-escaping unreserved characters'
- );
-}
-
-# make sure caller's query parameter hash isn't messed up
-{
- my $query_params_base = {test => "one two",
- bar => ["foo baz", "bar"]};
- my $query_params_test = {test => "one two",
- bar => ["foo baz", "bar"]};
- Catalyst::uri_for($context, '/bar/baz', $query_params_test);
- is_deeply($query_params_base, $query_params_test,
- "uri_for() doesn't mess up query parameter hash in the caller");
-}
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_uri_with.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_uri_with.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_core_uri_with.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,69 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More tests => 10;
-use URI;
-
-use_ok('Catalyst::Request');
-
-my $request = Catalyst::Request->new( {
- uri => URI->new('http://127.0.0.1/foo/bar/baz')
- } );
-
-is(
- $request->uri_with({}),
- 'http://127.0.0.1/foo/bar/baz',
- 'URI for absolute path'
-);
-
-is(
- $request->uri_with({ foo => 'bar' }),
- 'http://127.0.0.1/foo/bar/baz?foo=bar',
- 'URI adds param'
-);
-
-my $request2 = Catalyst::Request->new( {
- uri => URI->new('http://127.0.0.1/foo/bar/baz?bar=gorch')
- } );
-is(
- $request2->uri_with({}),
- 'http://127.0.0.1/foo/bar/baz?bar=gorch',
- 'URI retains param'
-);
-
-is(
- $request2->uri_with({ me => 'awesome' }),
- 'http://127.0.0.1/foo/bar/baz?bar=gorch&me=awesome',
- 'URI retains param and adds new'
-);
-
-is(
- $request2->uri_with({ bar => undef }),
- 'http://127.0.0.1/foo/bar/baz',
- 'URI loses param when explicitly undef'
-);
-
-is(
- $request2->uri_with({ bar => 'snort' }),
- 'http://127.0.0.1/foo/bar/baz?bar=snort',
- 'URI changes param'
-);
-
-is(
- $request2->uri_with({ bar => [ 'snort', 'ewok' ] }),
- 'http://127.0.0.1/foo/bar/baz?bar=snort&bar=ewok',
- 'overwrite mode URI appends arrayref param'
-);
-
-is(
- $request2->uri_with({ bar => 'snort' }, { mode => 'append' }),
- 'http://127.0.0.1/foo/bar/baz?bar=gorch&bar=snort',
- 'append mode URI appends param'
-);
-
-is(
- $request2->uri_with({ bar => [ 'snort', 'ewok' ] }, { mode => 'append' }),
- 'http://127.0.0.1/foo/bar/baz?bar=gorch&bar=snort&bar=ewok',
- 'append mode URI appends arrayref param'
-);
-
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_dispatcher_requestargs_restore.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_dispatcher_requestargs_restore.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_dispatcher_requestargs_restore.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,21 +0,0 @@
-# Insane test case for the behavior needed by Plugin::Auhorization::ACL
-
-# We have to localise $c->request->{arguments} in
-# Catalyst::Dispatcher::_do_forward, rather than using save and restore,
-# as otherwise, the calling $c->detach on an action which says
-# die $Catalyst:DETACH causes the request arguments to not get restored,
-# and therefore sub gorch gets the wrong string $frozjob parameter.
-
-# Please feel free to break this behavior once a sane hook for safely
-# executing another action from the dispatcher (i.e. wrapping actions)
-# is present, so that the Authorization::ACL plugin can be re-written
-# to not be full of such crazy shit.
-
-use strict;
-use warnings;
-use FindBin qw/$Bin/;
-use lib "$Bin/lib";
-use Catalyst::Test 'ACLTestApp';
-use Test::More tests => 1;
-
-request('http://localhost/gorch/wozzle');
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_response.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_response.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_response.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,18 +0,0 @@
-use strict;
-use warnings;
-use Test::More tests => 6;
-
-use_ok('Catalyst::Response');
-
-my $res = Catalyst::Response->new;
-
-# test aliasing of res->code for res->status
-$res->code(500);
-is($res->code, 500, 'code sets itself');
-is($res->status, 500, 'code sets status');
-$res->status(501);
-is($res->code, 501, 'status sets code');
-is($res->body, '', "default response body ''");
-$res->body(undef);
-is($res->body, '', "response body '' after assigned undef");
-
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_env_value.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_env_value.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_env_value.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,44 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More tests => 5;
-
-BEGIN { use_ok("Catalyst::Utils") }
-
-##############################################################################
-### No env vars defined
-##############################################################################
-{
- ok( !Catalyst::Utils::env_value( 'MyApp', 'Key' ),
- 'No env values defined returns false'
- );
-}
-
-##############################################################################
-### App env var defined
-##############################################################################
-{
- $ENV{'MYAPP2_KEY'} = 'Env value 2';
- is( Catalyst::Utils::env_value( 'MyApp2', 'Key' ),
- 'Env value 2', 'Got the right value from the application var' );
-}
-
-##############################################################################
-### Catalyst env var defined
-##############################################################################
-{
- $ENV{'CATALYST_KEY'} = 'Env value 3';
- is( Catalyst::Utils::env_value( 'MyApp3', 'Key' ),
- 'Env value 3', 'Got the right value from the catalyst var' );
-}
-
-##############################################################################
-### Catalyst and Application env vars defined
-##############################################################################
-{
- $ENV{'CATALYST_KEY'} = 'Env value bad';
- $ENV{'MYAPP4_KEY'} = 'Env value 4';
- is( Catalyst::Utils::env_value( 'MyApp4', 'Key' ),
- 'Env value 4', 'Got the right value from the application var' );
-}
-
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_prefix.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_prefix.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_prefix.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,26 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 9;
-
-use lib "t/lib";
-
-BEGIN { use_ok("Catalyst::Utils") };
-
-is( Catalyst::Utils::class2prefix('MyApp::V::Foo::Bar'), 'foo/bar', 'class2prefix works with M/V/C' );
-
-is( Catalyst::Utils::class2prefix('MyApp::Controller::Foo::Bar'), 'foo/bar', 'class2prefix works with Model/View/Controller' );
-
-is( Catalyst::Utils::class2prefix('MyApp::Controller::Foo::View::Bar'), 'foo/view/bar', 'class2prefix works with tricky components' );
-
-is( Catalyst::Utils::appprefix('MyApp::Foo'), 'myapp_foo', 'appprefix works' );
-
-is( Catalyst::Utils::class2appclass('MyApp::Foo::Controller::Bar::View::Baz'), 'MyApp::Foo', 'class2appclass works' );
-
-is( Catalyst::Utils::class2classprefix('MyApp::Foo::Controller::Bar::View::Baz'), 'MyApp::Foo::Controller', 'class2classprefix works' );
-
-is( Catalyst::Utils::class2classsuffix('MyApp::Foo::Controller::Bar::View::Baz'), 'Controller::Bar::View::Baz', 'class2classsuffix works' );
-
-is( Catalyst::Utils::class2env('MyApp::Foo'), 'MYAPP_FOO', 'class2env works' );
Deleted: Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_request.t
===================================================================
--- Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_request.t 2009-09-27 15:05:18 UTC (rev 11431)
+++ Catalyst-Runtime/5.80/branches/aggregate_more/t/unit_utils_request.t 2009-09-27 15:06:26 UTC (rev 11432)
@@ -1,27 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More tests => 5;
-
-use_ok('Catalyst::Utils');
-
-{
- my $url = "/dump";
- ok(
- my $request = Catalyst::Utils::request($url),
- "Request: simple get without protocol nor host"
- );
- like( $request->uri, qr|^http://localhost/|,
- " has default protocol and host" );
-}
-
-{
- my $url = "/dump?url=http://www.somewhere.com/";
- ok(
- my $request = Catalyst::Utils::request($url),
- "Same with param containing a url"
- );
- like( $request->uri, qr|^http://localhost/|,
- " has default protocol and host" );
-}
-
More information about the Catalyst-commits
mailing list