[Catalyst-commits] r9175 - in trunk/Catalyst-Log-Log4perl/t: . lib lib/MockApp/Controller

omega at dev.catalyst.perl.org omega at dev.catalyst.perl.org
Tue Feb 3 08:16:46 GMT 2009


Author: omega
Date: 2009-02-03 08:16:46 +0000 (Tue, 03 Feb 2009)
New Revision: 9175

Modified:
   trunk/Catalyst-Log-Log4perl/t/10-basic.t
   trunk/Catalyst-Log-Log4perl/t/lib/MockApp.pm
   trunk/Catalyst-Log-Log4perl/t/lib/MockApp/Controller/Root.pm
Log:
Rewrite tests to work with 5.80-trunk. Also seems to work with 5.7015

Modified: trunk/Catalyst-Log-Log4perl/t/10-basic.t
===================================================================
--- trunk/Catalyst-Log-Log4perl/t/10-basic.t	2009-02-03 00:26:51 UTC (rev 9174)
+++ trunk/Catalyst-Log-Log4perl/t/10-basic.t	2009-02-03 08:16:46 UTC (rev 9175)
@@ -3,22 +3,15 @@
 use strict;
 use warnings;
 
-use Test::More tests => 14;
 use FindBin;
 
 use lib ( "$FindBin::Bin/lib", "$FindBin::Bin/../lib" );
 
-BEGIN {
-    use_ok "Catalyst::Log::Log4perl";
-    use_ok "MockApp";
-}
 
-MockApp->setup;
+use Catalyst::Test 'MockApp';
 
-my $app = MockApp->new();
-my $c   = undef;
+use Test::More tests => 11;
 
-isa_ok( $app, 'MockApp' );
 
 # fetch the single appender so we can access log messages
 my ($appender) = values %{ Log::Log4perl->appenders };
@@ -37,13 +30,13 @@
 }
 
 ## test capturing of log messages
-
-$c = $app->GET('/foo');
-is( $c->response->body, 'foo', 'Foo response body' );
+my $c;
+$c = get('/foo');
+is( $c, 'foo', 'Foo response body' );
 log_ok( '[MockApp.Controller.Root] root/foo', 'Foo log message' );
 
-$c = $app->GET( '/bar', 'say=hello' );
-is( $c->response->body, 'hello', 'Bar response body' );
+$c = get( '/bar?say=hello' );
+is( $c, 'hello', 'Bar response body' );
 log_ok( '[MockApp.Controller.Root] root/bar', 'Bar log message' );
 
 ## test different cseps
@@ -51,17 +44,17 @@
 # %F File where the logging event occurred
 
 $appender->layout( Log::Log4perl::Layout::PatternLayout->new('%F') );
-$c = $app->GET('/foo');
+$c = get('/foo');
 log_like( qr|lib/MockApp/Controller/Root.pm$|, 'Loggin filepath' );
 
 $appender->layout( Log::Log4perl::Layout::PatternLayout->new('%L') );
-$c = $app->GET('/foo');
-log_ok( '18', 'Loggin line number' );
+$c = get('/foo');
+log_ok( '16', 'Loggin line number' );
 
 # %C Fully qualified package (or class) name of the caller
 
 $appender->layout( Log::Log4perl::Layout::PatternLayout->new('%C') );
-$c = $app->GET('/foo');
+$c = get('/foo');
 log_ok( 'MockApp::Controller::Root', 'Loggin class name' );
 
 # %l Fully qualified name of the calling method followed by the
@@ -69,15 +62,15 @@
 #    parentheses.
 
 $appender->layout( Log::Log4perl::Layout::PatternLayout->new('%l') );
-$c = $app->GET('/foo');
+$c = get('/foo');
 log_like
-qr|^MockApp::Controller::Root::foo .*lib/MockApp/Controller/Root.pm \(18\)$|,
+qr|^MockApp::Controller::Root::foo .*lib/MockApp/Controller/Root.pm \(16\)$|,
   'Loggin location';
 
 # %M Method or function where the logging request was issued
 
 $appender->layout( Log::Log4perl::Layout::PatternLayout->new('%M') );
-$c = $app->GET('/foo');
+$c = get('/foo');
 log_ok( 'MockApp::Controller::Root::foo', 'Loggin method' );
 
 # %T A stack trace of functions called
@@ -87,5 +80,5 @@
 ## check another log message to ensure the closures work correctly
 
 $appender->layout( Log::Log4perl::Layout::PatternLayout->new('%L') );
-$c = $app->GET('/bar');
-log_ok( '24', 'Loggin another line number' );
+$c = get('/bar');
+log_ok( '22', 'Loggin another line number' );

Modified: trunk/Catalyst-Log-Log4perl/t/lib/MockApp/Controller/Root.pm
===================================================================
--- trunk/Catalyst-Log-Log4perl/t/lib/MockApp/Controller/Root.pm	2009-02-03 00:26:51 UTC (rev 9174)
+++ trunk/Catalyst-Log-Log4perl/t/lib/MockApp/Controller/Root.pm	2009-02-03 08:16:46 UTC (rev 9175)
@@ -3,14 +3,12 @@
 use strict;
 use warnings;
 
-use base qw/Catalyst::Controller Class::Data::Inheritable/;
+use base qw/Catalyst::Controller/;
 
-__PACKAGE__->mk_classdata('context');
 __PACKAGE__->config->{namespace} = '';
 
 sub auto : Private {
     my ( $self, $c ) = @_;
-    $self->context($c);
 }
 
 sub foo : Local {

Modified: trunk/Catalyst-Log-Log4perl/t/lib/MockApp.pm
===================================================================
--- trunk/Catalyst-Log-Log4perl/t/lib/MockApp.pm	2009-02-03 00:26:51 UTC (rev 9174)
+++ trunk/Catalyst-Log-Log4perl/t/lib/MockApp.pm	2009-02-03 08:16:46 UTC (rev 9175)
@@ -1,19 +1,11 @@
 package MockApp;
 
-BEGIN { $ENV{CATALYST_ENGINE} = 'HTTP' }
-
 use strict;
 use warnings;
 
-use base qw/Class::Accessor::Fast/;
-__PACKAGE__->mk_ro_accessors('context');
+use parent qw/Catalyst/;
 
-use MRO::Compat;
-use Catalyst;
 use Catalyst::Log::Log4perl;
-use Catalyst::Runtime;
-use Sub::Install;
-use NEXT;
 
 our %config = ( name => 'MockApp', home => './t/' );
 sub config { \%config }
@@ -26,55 +18,7 @@
 log4perl.appender.LOG.layout.ConversionPattern=[%c] %m
 CONF
 
-sub finalize {
-    my $c = shift;
-    $c->next::method(@_);
-    return $c;
-};
 
-sub setup {
-    my $class = shift;
-    my $res   = $class->NEXT::setup(@_);
+__PACKAGE__->setup();
 
-    Sub::Install::reinstall_sub(
-        {
-            code => sub {
-
-                #unneded
-            },
-            into => qw/Catalyst::Engine::HTTP/,
-            as   => 'write',
-        }
-    );
-    Sub::Install::reinstall_sub(
-        {
-            code => sub {
-
-                #unneded
-            },
-            into => qw/Catalyst::Engine::HTTP/,
-            as   => 'finalize_headers',
-        }
-    );
-
-    return $res;
-}
-
-sub GET {
-    my $self  = shift;
-    my $path  = shift || '/';
-    my $query = join( '&', @_ ) || '';
-    local %ENV = (
-        PATH_INFO       => $path,
-        QUERY_STRING    => $query,
-        REMOTE_ADDR     => '127.0.0.1',
-        REMOTE_HOST     => 'cll4p.test.loc',
-        REQUEST_METHOD  => 'GET',
-        SERVER_NAME     => 'MockApp',
-        SERVER_PORT     => 3000,
-        SERVER_PROTOCOL => "HTTP/1.0",
-    );
-    return $self->handle_request;
-}
-
 1;




More information about the Catalyst-commits mailing list