From b65ee86d592a4038c2bd7f354a29894145758893 Mon Sep 17 00:00:00 2001 From: Simon Cozens Date: Mon, 6 Dec 2004 01:15:47 +0000 Subject: [PATCH] first pass at unit tests git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@296 48953598-375a-da11-a14b-00016c27c3ee --- t/apache_mvc.t | 33 +++++ t/cgi_maypole.t | 93 ++++++++++++++ t/constants.t | 13 ++ t/maypole.t | 332 ++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 471 insertions(+) create mode 100644 t/apache_mvc.t create mode 100644 t/cgi_maypole.t create mode 100755 t/constants.t create mode 100755 t/maypole.t diff --git a/t/apache_mvc.t b/t/apache_mvc.t new file mode 100644 index 0000000..4bb7185 --- /dev/null +++ b/t/apache_mvc.t @@ -0,0 +1,33 @@ +#!/usr/bin/perl -w +use strict; +use Test::More tests => 10; +use Test::MockObject; + +require_ok('Apache::MVC'); +ok($Apache::MVC::VERSION, 'defines $VERSION'); +# defines $VERSION +# uses mod_perl +# @ISA = 'Maypole' +# sets APACHE2 constant +# loads Apache::Request +# loads mod_perl2 modules if APACHE2 +# otherwise, loads Apache +# get_request() +# ... sets 'ar' to new Apache::Request object +# parse_location() +# ... sets path() to request URI - base URI +# ... calls parse_path +# ... calls parse_args +# parse_args() +# ... calls _mod_perl_args(), to set params +# ... calls _mod_perl_args(), to set query +# send_output() +# ... sets get_request->content_type to r->content_type +# ... appends document_encoding() if content_type is text +# ... sets Content-Length header +# ... calls get_request->send_http_header unless APACHE2 +# ... prints the request output +# get_template_root() +# ... catdir(document_root, location) +# _mod_perl_args() +# ... returns a hash of args from get_request->param diff --git a/t/cgi_maypole.t b/t/cgi_maypole.t new file mode 100644 index 0000000..f4d4e82 --- /dev/null +++ b/t/cgi_maypole.t @@ -0,0 +1,93 @@ +#!/usr/bin/perl -w +use strict; +use Test::More tests => 26; +use Test::MockModule; + +require_ok('CGI::Maypole'); +ok($CGI::Maypole::VERSION, 'defines $VERSION'); +ok($INC{'CGI/Simple.pm'}, 'requires CGI::Simple'); +ok(CGI::Maypole->isa('Maypole'), '@ISA = Maypole'); + +my %calls; +my $mock_maypole = new Test::MockModule('CGI::Maypole'); +my $mock_cgi = new Test::MockModule('CGI::Simple'); +$mock_cgi->mock(path_info => sub { + delete $_[0]->{'.path_info'}; + goto $mock_cgi->original('path_info') +}); + +# run() +can_ok('CGI::Maypole' => 'run'); +$mock_maypole->mock(handler => sub {$calls{handler} = \@_; 'X'}); +my $status = CGI::Maypole->run('TEST'); +ok($calls{handler}, '... calls handler()'); +is_deeply($calls{handler}, ['CGI::Maypole'], + '... as a method, passing 0 arguments'); +is($status, 'X', '... and returns its status'); + +my $r = bless {}, 'CGI::Maypole'; +$ENV{HTTP_HOST} = 'localhost'; +$ENV{SCRIPT_NAME} = '/maypole/index.cgi'; +$ENV{PATH_INFO} = '/'; +$ENV{REQUEST_METHOD} = 'GET'; +$ENV{QUERY_STRING} = 'beer=1;beer=2;pub=red+lion;handpump'; +$ENV{DOCUMENT_ROOT} = '/var/tmp/maypole'; + +# get_request() +can_ok($r => 'get_request'); +my $cgi = $r->get_request; +isa_ok($cgi, 'CGI::Simple', '... returns a CGI::Simple object'); +is($cgi, $r->{cgi}, '... and stores it in the "cgi" slot'); + +# parse_location() +can_ok($r => 'parse_location'); +$r->parse_location; +is($r->path, 'frontpage', '... sets "path" to frontpage if undefined'); + +#delete $r->{cgi}{'.path_info'}; +$ENV{PATH_INFO} = '/brewery/view/1/2/3'; +$r->parse_location; +is($r->path, 'brewery/view/1/2/3', '... path is PATH_INFO without leading /'); +is($r->table, 'brewery', '... sets "table" to first part of PATH_INFO'); +is($r->action, 'view', '... sets "action" to second part of PATH_INFO'); +is_deeply($r->args, [1,2,3], + '... sets "args" to a list of remaining path segments'); + +$mock_maypole->mock( + parse_path => sub {$calls{parse_path} = \@_}, + parse_args => sub {$calls{parse_args} = \@_}, +); +$r->parse_location; +is_deeply($calls{parse_path}, [$r], '... calls parse_path'); +is_deeply($calls{parse_args}, [$r], '... calls parse_args'); + + +# parse_args() +$mock_maypole->unmock('parse_args'); +can_ok($r => 'parse_args'); +$cgi->parse_query_string; +$r->parse_args; +is_deeply($r->params, { beer => [1,2], pub => 'red lion', handpump => undef }, + '... parsed params'); +is_deeply($r->params, $r->query, '... query and params are identical'); + +# send_output() +can_ok($r => 'send_output'); +SKIP: { + eval "require IO::CaptureOutput"; + skip "IO::CaptureOutput not installed", 3 if $@; + $r->content_type('text/plain'); + $r->document_encoding('iso8859-1'); + $r->output('Hello World!'); + my $stdout; + IO::CaptureOutput::capture(sub {$r->send_output}, \$stdout); + + my $compare = join "\cM\cJ", 'Content-length: 12', + 'Content-Type: text/plain; charset=iso8859-1', '', 'Hello World!'; + is($stdout, $compare, '... prints output, including content-type header'); +} + +# get_template_root() +can_ok($r => 'get_template_root'); +is($r->get_template_root(), '/var/tmp/maypole/index.cgi', + '... catdir(document_root, [relative_url])'); diff --git a/t/constants.t b/t/constants.t new file mode 100755 index 0000000..89759c7 --- /dev/null +++ b/t/constants.t @@ -0,0 +1,13 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Test::More tests => 8; + +use_ok('Maypole::Constants'); +ok($Maypole::Constants::VERSION, 'defines $VERSION'); +is(\&OK, \&Maypole::Constants::OK, 'exports OK'); +is(OK(), 0, 'OK correctly defined'); +is(\&ERROR, \&Maypole::Constants::ERROR, 'exports ERROR'); +is(ERROR(), -1, 'ERROR correctly defined'); +is(\&DECLINED, \&Maypole::Constants::DECLINED, 'exports DECLINED'); +is(DECLINED(), -1, 'DECLINED correctly defined'); diff --git a/t/maypole.t b/t/maypole.t new file mode 100755 index 0000000..a537732 --- /dev/null +++ b/t/maypole.t @@ -0,0 +1,332 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Test::More tests => 103; +use Test::MockModule; + +# module compilation +require_ok('Maypole'); +my $OK = Maypole::Constants::OK(); +my $DECLINED = Maypole::Constants::DECLINED(); +my $ERROR = Maypole::Constants::ERROR(); + +ok($Maypole::VERSION, 'defines $VERSION'); +ok($INC{'Maypole/Config.pm'}, 'loads Maypole::Config'); +ok($INC{'UNIVERSAL/require.pm'}, 'loads UNIVERSAL::require'); +ok($INC{'Maypole/Constants.pm'}, 'loads Maypole::Constants'); +ok($INC{'Class/Accessor/Fast.pm'}, 'loads Class::Accessor::Fast'); +ok($INC{'Class/Data/Inheritable.pm'}, 'loads Class::Data::Inheritable'); +ok(Maypole->can('config'), 'defines a config attribute'); +ok(Maypole->config->isa('Maypole::Config'), 'config is a Maypole::Config object'); +ok(Maypole->can('init_done'), 'defines an init_done attribute'); +ok(! Maypole->init_done, '... which is false by default'); +ok(Maypole->can('view_object'), 'defines a view_object attribute'); +is(Maypole->view_object, undef, '... which is undefined'); +ok(Maypole->can('ar'), 'defines an "ar" accessor'); +ok(Maypole->can('params'), 'defines a "params" accessor'); +ok(Maypole->can('query'), 'defines a "query" accessor'); +ok(Maypole->can('objects'), 'defines an "objects" accessor'); +ok(Maypole->can('model_class'), 'defines a "model_class" accessor'); +ok(Maypole->can('template_args'), 'defines a "template_args" accessor'); +ok(Maypole->can('output'), 'defines an "output" accessor'); +ok(Maypole->can('path'), 'defines a "path" accessor'); +ok(Maypole->can('args'), 'defines an "args" accessor'); +ok(Maypole->can('action'), 'defines an "action" accessor'); +ok(Maypole->can('template'), 'defines a "template" accessor'); +ok(Maypole->can('error'), 'defines an "error" accessor'); +ok(Maypole->can('document_encoding'), 'defines a "document_encoding" accessor'); +ok(Maypole->can('content_type'), 'defines a "content_type" accessor'); +ok(Maypole->can('table'), 'defines a "table" accessor'); + +# simple test class that inherits from Maypole +package MyDriver; +@MyDriver::ISA = 'Maypole'; +@MyDriver::VERSION = 1; +package main; +my $driver_class = 'MyDriver'; + +# Mock the model class +my (%required, @db_args, @adopted); +my $model_class = 'Maypole::Model::CDBI'; +my $table_class = $driver_class . '::One'; +my $mock_model = Test::MockModule->new($model_class); +$mock_model->mock( + require => sub {$required{+shift} = 1}, + setup_database => sub { + push @db_args, \@_; + $_[1]->{classes} = ["$model_class\::One", "$model_class\::Two"]; + $_[1]->{tables} = [qw(one two)]; + }, + adopt => sub {push @adopted, \@_}, +); + +# setup() +can_ok($driver_class => 'setup'); +my $handler = $driver_class->can('handler'); +is($handler, Maypole->can('handler'), 'calling package inherits handler()'); +$driver_class->setup('dbi:foo'); # call setup() +isnt($handler, $driver_class->can('handler'), 'setup() installs new handler()'); +ok($required{$model_class}, '... requires model class'); +is($driver_class->config->model(), + 'Maypole::Model::CDBI', '... default model is CDBI'); +is(@db_args, 1, '... calls model->setup_database'); +like(join (' ', @{$db_args[0]}), + qr/$model_class Maypole::Config=\S* $driver_class dbi:foo/, + '... setup_database passed setup() args'); +is(@adopted, 2, '... calls model->adopt foreach class in the model'); +ok($adopted[0][0]->isa($model_class), + '... sets up model subclasses to inherit from model'); +$driver_class->config->model('NonExistant::Model'); +eval {$driver_class->setup}; +like($@, qr/Couldn't load the model class/, + '... dies if unable to load model class'); +$@ = undef; $driver_class->config->model($model_class); + +# Mock the view class +my $view_class = 'Maypole::View::TT'; +my $mock_view = Test::MockModule->new($view_class); +$mock_view->mock( + new => sub {bless{}, shift}, + require => sub {$required{+shift} = 1}, +); + +# init() +can_ok($driver_class => 'init'); +$driver_class->init(); +ok($required{$view_class}, '... requires the view class'); +is($driver_class->config->view, $view_class, '... the default view class is TT'); +is(join(' ', @{$driver_class->config->display_tables}), 'one two', + '... config->display_tables defaults to all tables'); +ok($driver_class->view_object->isa($view_class), + '... creates an instance of the view object'); +ok($driver_class->init_done, '... sets init_done'); +$driver_class->config->view('NonExistant::View'); +eval {$driver_class->init}; +like($@, qr/Couldn't load the view class/, + '... dies if unable to load view class'); +$@ = undef; $driver_class->config->view($view_class); + + +my ($r, $req); # request objects +{ + no strict 'refs'; + my $init = 0; + my $status = 0; + my %called; + my $mock_driver = Test::MockModule->new($driver_class, no_auto => 1); + $mock_driver->mock( + init => sub {$init++; shift->init_done(1)}, + get_request => sub {($r, $req) = @_; $called{get_request}++}, + parse_location => sub {$called{parse_location}++}, + handler_guts => sub {$called{handler_guts}++; $status}, + send_output => sub {$called{send_output}++}, + ); + + # handler() + can_ok($driver_class => 'handler'); + my $rv = $driver_class->handler(); + ok($r && $r->isa($driver_class), '... created $r'); + ok($called{get_request}, '... calls get_request()'); + ok($called{get_request}, '... calls parse_location'); + ok($called{get_request}, '... calls handler_guts()'); + ok($called{get_request}, '... call send_output'); + is($rv, 0, '... return status (should be ok?)'); + ok(!$init, "... doesn't call init() if init_done()"); + # call again, testing other branches + $driver_class->init_done(0); + $status = -1; + $rv = $driver_class->handler(); + ok($called{handler_guts} == 2 && $called{send_output} == 1, + '... returns early if handler_guts failed'); + is($rv, -1, '... returning the error code from handler_guts'); + $driver_class->handler(); + ok($init && $driver_class->init_done, "... init() called if !init_done()"); +} + +{ + # handler_guts() + { + no strict 'refs'; + @{$table_class . "::ISA"} = $model_class; + } + + my ($applicable, %called, $status); + my $mock_driver = new Test::MockModule($driver_class, no_auto => 1); + my $mock_table = new Test::MockModule($table_class, no_auto => 1); + $mock_driver->mock( + is_applicable => sub {push @{$called{applicable}},\@_; $applicable}, + get_request => sub {($r, $req) = @_}, + additional_data => sub {$called{additional_data}++}, + ); + $mock_table->mock( + table_process => sub {push @{$called{process}},\@_}, + ); + $mock_model->mock( + class_of => sub {push @{$called{class_of}},\@_; $table_class}, + process => sub {push @{$called{model_process}}, \@_}, + ); + $mock_view->mock( + process => sub {push @{$called{view_process}}, \@_; $OK} + ); + can_ok(Maypole => 'handler_guts'); + + $applicable = $OK; + $r->{path} = '/table/action'; $r->parse_path; + $status = $r->handler_guts(); + + is($r->model_class, $table_class, '... sets model_class from table()'); + ok($called{additional_data}, '... call additional_data()'); + is($status, $OK, '... return status = OK'); + ok($called{model_process}, + '... if_applicable, call model_class->process'); + + %called = (); + $applicable = $DECLINED; + $r->{path} = '/table/action'; + $r->parse_path; + $status = $r->handler_guts(); + is($r->template, $r->path, + '... if ! is_applicable set template() to path()'); + ok(!$called{model_process}, + '... !if_applicable, call model_class->process'); + is_deeply($called{view_process}[0][1], $r, + ' ... view_object->process called'); + is($status, $OK, '... return status = OK'); + + %called = (); + $r->parse_path; + $r->{output} = 'test'; + $status = $r->handler_guts(); + ok(!$called{view_process}, + '... unless output, call view_object->process to get output'); + + $mock_driver->mock(call_authenticate => sub {$DECLINED}); + $status = $r->handler_guts(); + is($status, $DECLINED, + '... return DECLINED unless call_authenticate == OK'); + + # ... TODO authentication error handling + # ... TODO model error handling + # ... TODO view processing error handling +} + +# is_applicable() +can_ok(Maypole => 'is_applicable'); +$r->config->display_tables([qw(one two)]); +$r->config->ok_tables(undef); +$r->model_class($table_class); +$r->table('one'); +$r->action('unittest'); +my $is_public; +$mock_model->mock('is_public', sub {0}); +my $status = $r->is_applicable; +is($status, $DECLINED, + '... return DECLINED unless model_class->is_public(action)'); +$mock_model->mock('is_public', sub {$is_public = \@_; 1}); +$status = $r->is_applicable; +is($status, $OK, '... returns OK if table is in ok_tables'); +is_deeply($is_public, [$r->model_class, 'unittest'], + '... calls model_class->is_public with request action'); +is_deeply($r->config->ok_tables, {one => 1, two => 1}, + '... config->ok_tables defaults to config->display_tables'); +delete $r->config->ok_tables->{one}; +$status = $r->is_applicable; +is($status, $DECLINED, '... return DECLINED unless $r->table is in ok_tables'); + +# call_authenticate() +can_ok(Maypole => 'call_authenticate'); +my $mock_driver = new Test::MockModule($driver_class, no_auto => 1); +my $mock_table = new Test::MockModule($table_class, no_auto => 1); +my %auth_calls; +$mock_table->mock( + authenticate => sub {$auth_calls{model_auth} = \@_; $OK} +); +$status = $r->call_authenticate; +is_deeply($auth_calls{model_auth}, [$table_class, $r], + '... calls model_class->authenticate if it exists'); +is($status, $OK, '... and returns its status (OK)'); +$mock_table->mock(authenticate => sub {$DECLINED}); +$status = $r->call_authenticate; +is($status, $DECLINED, '... or DECLINED, as appropriate'); + +$mock_table->unmock('authenticate'); +$mock_driver->mock(authenticate => sub {return $DECLINED}); +$status = $r->call_authenticate; +is($status, $DECLINED, '... otherwise it calls authenticte()'); +$mock_driver->unmock('authenticate'); +$status = $r->call_authenticate; +is($status, $OK, '... the default authenticate is OK'); + +# call_exception() +can_ok(Maypole => 'call_exception'); +my %ex_calls; +$mock_table->mock( + exception => sub {$ex_calls{model_exception} = \@_; $OK} +); +$mock_driver->mock( + exception => sub {$ex_calls{driver_exception} = \@_; 'X'} +); +$status = $r->call_exception('ERR'); +is_deeply($ex_calls{model_exception}, [$table_class, $r, 'ERR'], + '... calls model_class->exception if it exists'); +is($status, $OK, '... and returns its status (OK)'); +$mock_table->mock(exception => sub {$DECLINED}); +$status = $r->call_exception('ERR'); +is_deeply($ex_calls{driver_exception}, [$r, 'ERR'], + '... or calls driver->exception if model returns !OK'); +is($status, 'X', '... and returns the drivers status'); + +$mock_table->unmock('exception'); +$mock_driver->unmock('exception'); +$status = $r->call_exception('ERR'); +is($status, $ERROR, '... the default exception is ERROR'); + +# additional_data() +can_ok(Maypole => 'additional_data'); + +# authenticate() +can_ok(Maypole => 'authenticate'); +is(Maypole->authenticate(), $OK, '... returns OK'); + +# exception() +can_ok(Maypole => 'exception'); +is(Maypole->exception(), $ERROR, '... returns ERROR'); + +# parse_path() +can_ok(Maypole => 'parse_path'); +$r->path(undef); +$r->parse_path; +is($r->path, 'frontpage', '... path() defaults to "frontpage"'); + +$r->path('/table'); +$r->parse_path; +is($r->table, 'table', '... parses "table" from the first part of path'); +ok(!defined $r->action && @{$r->args} == 0, + '... leaving "action" undefined, and "args" as empty list, if not present'); + +$r->path('/table/action'); +$r->parse_path; +ok($r->table eq 'table' && $r->action eq 'action', + '... action is parsed from second part of path'); + +$r->path('/table/action/arg1/arg2'); +$r->parse_path; +is_deeply($r->args, [qw(arg1 arg2)], + '... "args" are populated from remaning components'); + +# get_template_root() +can_ok(Maypole => 'get_template_root'); +is(Maypole->get_template_root(), '.', '... returns "."'); + +# get_request() +can_ok(Maypole => 'get_request'); + +# parse_location() +can_ok(Maypole => 'parse_location'); +eval {Maypole->parse_location()}; +like($@, qr/Do not use Maypole directly/, '... croaks - must be overriden'); + +# send_output() +can_ok(Maypole=> 'send_output'); +eval {Maypole->send_output}; +like($@, qr/Do not use Maypole directly/, '... croaks - must be overriden'); -- 2.39.2