X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=t%2Flib%2FTestApp.pm;h=20d12f787dd370956c4a3507f830ccc94b8d4523;hp=25203e1f82752ad96f7ccd736ea238cdb3bca801;hb=fa2d8e3857cd3960f868d393e913377bd13f57a2;hpb=bf7c9c87ac809f8370ee21db7effef130ea6e058 diff --git a/t/lib/TestApp.pm b/t/lib/TestApp.pm index 25203e1..20d12f7 100644 --- a/t/lib/TestApp.pm +++ b/t/lib/TestApp.pm @@ -2,8 +2,8 @@ package TestApp; use strict; use Catalyst qw/ Test::MangleDollarUnderScore - Test::Errors - Test::Headers + Test::Errors + Test::Headers Test::Plugin Test::Inline +TestApp::Plugin::FullyQualified @@ -11,9 +11,10 @@ use Catalyst qw/ +TestApp::Role /; use Catalyst::Utils; +use Class::Load 'try_load_class'; use Moose; -use namespace::autoclean; +use namespace::clean -except => [ 'meta' ]; # ----------- # t/aggregate/unit_core_ctx_attr.t pukes until lazy is true @@ -41,15 +42,17 @@ has 'my_greeting_obj_lazy' => ( our $VERSION = '0.01'; -TestApp->config( - name => 'TestApp', - root => '/some/dir', - use_request_uri_for_path => 1, +TestApp->config( + name => 'TestApp', + root => '/some/dir', + use_request_uri_for_path => 1, 'Controller::Action::Action' => { action_args => { action_action_nine => { another_extra_arg => 13 } } - } + }, + encoding => 'UTF-8', + abort_chain_on_error_fix => 1, ); # Test bug found when re-adjusting the metaclass compat code in Moose @@ -57,23 +60,35 @@ TestApp->config( # above ->setup so we have some generated methods to be double sure. has an_attribute_before_we_change_base_classes => ( is => 'ro'); -if ($::setup_leakchecker && eval { Class::MOP::load_class('CatalystX::LeakChecker'); 1 }) { - with 'CatalystX::LeakChecker'; +if ($::setup_leakchecker) { + require Scalar::Util; + require Devel::Cycle; has leaks => ( is => 'ro', default => sub { [] }, ); -} -sub found_leaks { - my ($ctx, @leaks) = @_; - push @{ $ctx->leaks }, @leaks; -} + sub count_leaks { + my ($ctx) = @_; + return scalar @{ $ctx->leaks }; + } + + after finalize => sub { + my ($ctx) = @_; + my @leaks; -sub count_leaks { - my ($ctx) = @_; - return scalar @{ $ctx->leaks }; + my $weak_ctx = $ctx; + Scalar::Util::weaken $weak_ctx; + + Devel::Cycle::find_cycle($ctx, sub { + my ($path) = @_; + push @leaks, $path + if $path->[0]->[2] == $weak_ctx; + }); + + push @{ $ctx->leaks }, @leaks; + }; } TestApp->setup; @@ -112,9 +127,9 @@ sub execute { # useful info if something crashes during a test sub finalize_error { my $c = shift; - + $c->next::method(@_); - + $c->res->status(500); $c->res->body( 'FATAL ERROR: ' . join( ', ', @{ $c->error } ) ); } @@ -124,12 +139,24 @@ sub finalize_error { sub Catalyst::Log::error { } } -# Make sure we can load Inline plugins. +# Pretend to be Plugin::Session and hook finalize_headers to send a header -package Catalyst::Plugin::Test::Inline; +sub finalize_headers { + my $c = shift; -use strict; + $c->res->header('X-Test-Header', 'valid'); -use base qw/Class::Data::Inheritable/; + my $call_count = $c->stash->{finalize_headers_call_count} || 0; + $call_count++; + $c->stash(finalize_headers_call_count => $call_count); + $c->res->header('X-Test-Header-Call-Count' => $call_count); + + return $c->maybe::next::method(@_); +} + +# Make sure we can load Inline plugins. + +package Catalyst::Plugin::Test::Inline; +use Moose; 1;