From 7adfd53f17f66ffe93763e944ed1d3fc52a369dc Mon Sep 17 00:00:00 2001 From: matthewt Date: Wed, 12 Sep 2007 18:11:34 +0000 Subject: moved shit to trunk --- t/01app.t | 7 + t/02pod.t | 9 + t/03podcoverage.t | 30 +++ t/04load_all.t | 15 ++ t/05reflect_attr_from.t | 34 +++ t/im_dbic.t | 15 ++ t/lib/RTest/InterfaceModel/DBIC.pm | 140 ++++++++++++ t/lib/RTest/InterfaceModel/Reflector/DBIC.pm | 317 +++++++++++++++++++++++++++ t/lib/RTest/TestDB.pm | 29 +++ t/lib/RTest/TestDB/Bar.pm | 34 +++ t/lib/RTest/TestDB/Baz.pm | 29 +++ t/lib/RTest/TestDB/Foo.pm | 42 ++++ t/lib/RTest/TestDB/FooBaz.pm | 22 ++ t/lib/RTest/UI/FocusStack.pm | 56 +++++ t/lib/RTest/UI/ViewPort/ListView.pm | 102 +++++++++ t/lib/RTest/UI/Window.pm | 110 ++++++++++ t/simple.pl | 11 + t/ui_focus_stack.t | 11 + t/ui_viewport.t | 10 + t/ui_widget_listview.show | 43 ++++ t/ui_window.t | 10 + 21 files changed, 1076 insertions(+) create mode 100644 t/01app.t create mode 100644 t/02pod.t create mode 100644 t/03podcoverage.t create mode 100644 t/04load_all.t create mode 100644 t/05reflect_attr_from.t create mode 100644 t/im_dbic.t create mode 100644 t/lib/RTest/InterfaceModel/DBIC.pm create mode 100644 t/lib/RTest/InterfaceModel/Reflector/DBIC.pm create mode 100644 t/lib/RTest/TestDB.pm create mode 100644 t/lib/RTest/TestDB/Bar.pm create mode 100644 t/lib/RTest/TestDB/Baz.pm create mode 100644 t/lib/RTest/TestDB/Foo.pm create mode 100644 t/lib/RTest/TestDB/FooBaz.pm create mode 100644 t/lib/RTest/UI/FocusStack.pm create mode 100644 t/lib/RTest/UI/ViewPort/ListView.pm create mode 100644 t/lib/RTest/UI/Window.pm create mode 100644 t/simple.pl create mode 100644 t/ui_focus_stack.t create mode 100644 t/ui_viewport.t create mode 100644 t/ui_widget_listview.show create mode 100644 t/ui_window.t (limited to 't') diff --git a/t/01app.t b/t/01app.t new file mode 100644 index 0000000..c72e2c7 --- /dev/null +++ b/t/01app.t @@ -0,0 +1,7 @@ +use strict; +use warnings; +use Test::More tests => 2; + +BEGIN { use_ok 'Catalyst::Test', 'ComponentUI' } + +ok( request('/')->is_success, 'Request should succeed' ); diff --git a/t/02pod.t b/t/02pod.t new file mode 100644 index 0000000..251640d --- /dev/null +++ b/t/02pod.t @@ -0,0 +1,9 @@ +use strict; +use warnings; +use Test::More; + +eval "use Test::Pod 1.14"; +plan skip_all => 'Test::Pod 1.14 required' if $@; +plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD}; + +all_pod_files_ok(); diff --git a/t/03podcoverage.t b/t/03podcoverage.t new file mode 100644 index 0000000..d8b1422 --- /dev/null +++ b/t/03podcoverage.t @@ -0,0 +1,30 @@ +use strict; +use warnings; +use Test::More; + +eval "use Test::Pod::Coverage 1.04"; +plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@; +plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD}; + +my @modules = sort { $a cmp $b } (Test::Pod::Coverage::all_modules()); +@modules = grep {!/^ComponentUI::/} @modules; +plan tests => scalar(@modules); + +# methods to ignore on all modules +my $exceptions = { + ignore => [ + qw/ BUILD build_ can_ clear_ has_ do_ adopt_ accept_ + apply_ layout value meta / + ] +}; + +foreach my $module (@modules) { + # build parms up from ignore list + my $parms = {}; + $parms->{trustme} = + [ map { qr/^$_/ } @{ $exceptions->{ignore} } ] + if exists($exceptions->{ignore}); + + # run the test with the potentially modified parm set + pod_coverage_ok($module, $parms, "$module POD coverage"); +} diff --git a/t/04load_all.t b/t/04load_all.t new file mode 100644 index 0000000..a7923fc --- /dev/null +++ b/t/04load_all.t @@ -0,0 +1,15 @@ +use strict; +use warnings; +use Test::More (); + +Test::More::plan('no_plan'); + +use Module::Pluggable::Object; + +my $finder = Module::Pluggable::Object->new( + search_path => [ 'Reaction' ], + ); + +foreach my $class (sort $finder->plugins) { + Test::More::use_ok($class); +} diff --git a/t/05reflect_attr_from.t b/t/05reflect_attr_from.t new file mode 100644 index 0000000..67974ba --- /dev/null +++ b/t/05reflect_attr_from.t @@ -0,0 +1,34 @@ +package TestMe2; +use strict; +use warnings; +use Reaction::Class; +use Reaction::Types::DateTime; + +has id => (is => 'ro', required => 1, isa => 'Int'); +has username => (is => 'rw', required => 1, isa => 'NonEmptySimpleStr'); +has created_d => (is => 'rw', required => 1, isa => 'DateTime'); + +1; + +package TestMe; +use strict; +use warnings; +use Reaction::Class; + +reflect_attributes_from('TestMe2' => qw(id username created_d)); + +1; + +package main; +use strict; +use warnings; +use Data::Dumper; +use Test::More; + +plan tests => 1; + +my @test_list = TestMe->meta->get_attribute_list; +my @test2_list = TestMe2->meta->get_attribute_list; +is_deeply(\@test_list, \@test2_list, "Attribute lists match"); + +1; diff --git a/t/im_dbic.t b/t/im_dbic.t new file mode 100644 index 0000000..db4f772 --- /dev/null +++ b/t/im_dbic.t @@ -0,0 +1,15 @@ +use lib 't/lib'; +use strict; +use warnings; + +use Test::Class; +use RTest::InterfaceModel::DBIC; +use RTest::InterfaceModel::Reflector::DBIC; + +Test::Class->runtests( + RTest::InterfaceModel::DBIC->new(), +); + +Test::Class->runtests( + RTest::InterfaceModel::Reflector::DBIC->new(), +); diff --git a/t/lib/RTest/InterfaceModel/DBIC.pm b/t/lib/RTest/InterfaceModel/DBIC.pm new file mode 100644 index 0000000..3a2bf57 --- /dev/null +++ b/t/lib/RTest/InterfaceModel/DBIC.pm @@ -0,0 +1,140 @@ +package RTest::InterfaceModel::DBIC; + +use base qw/Reaction::Test::WithDB Reaction::Object/; +use Reaction::Class; +use ComponentUI::TestModel; +use Test::More (); + +has '+schema_class' => (default => sub { 'RTest::TestDB' }); + +has im_schema => (is =>'ro', isa => 'ComponentUI::TestModel', lazy_build => 1); +sub build_im_schema{ + my $self = shift; + + my (@dm) = ComponentUI::TestModel->domain_models; + Test::More::ok(@dm == 1, 'Correct number of Domain Models'); + my $dm = shift @dm; + Test::More::ok($dm->name eq '_testdb_schema', 'Domain Model created correctly'); + + ComponentUI::TestModel->new($dm->name => $self->schema); +} + +sub test_SchemaClass :Tests { + my $self = shift; + my $s = $self->im_schema; + + #just make sure here... + Test::More::isa_ok( $s, 'Reaction::InterfaceModel::Object', + 'Correctly override default base object' ); + + my %pa = map{$_->name => $_ } $s->parameter_attributes; + Test::More::ok(keys %pa == 3, 'Correct number of Parameter Attributes'); + + Test::More::ok($pa{Foo} && $pa{'Bar'} && $pa{'Baz'}, + 'Parameter Attributes named correctly'); + + #for now since we have no generic collection object + Test::More::ok + ( $pa{Foo}->_isa_metadata eq 'Reaction::InterfaceModel::DBIC::Collection', + 'Parameter Attributes typed correctly' ); + + Test::More::is($pa{Baz}->reader, 'bazes', 'Correct Baz reader created'); + Test::More::is($pa{Foo}->reader, 'foo_collection', 'Correct Foo reader created'); + Test::More::is($pa{Bar}->reader, 'bar_collection', 'Correct Bar reader created'); + + #is this check good enough? Moose will take care of checking the type constraints, + # so i dont need tocheck that Moose++ !! + my $foo1 = $s->foo_collection; + my $foo2 = $s->foo_collection; + Test::More::ok + (Scalar::Util::refaddr($foo1) ne Scalar::Util::refaddr($foo2), + 'Fresh Collections work'); +} + +sub test_ObjectClass :Tests { + my $self = shift; + + my $collection = $self->im_schema->foo_collection; + Test::More::ok( my $im = $collection->find({ id => 1}), 'Find call successful'); + + Test::More::isa_ok( $im, 'ComponentUI::TestModel::Foo', + 'Correct result class set' ); + + my %pa = map{$_->name => $_ } $im->parameter_attributes; + Test::More::ok(keys %pa == 4, 'Correct number of Parameter Attributes'); + + Test::More::is( $pa{first_name}->_isa_metadata, 'NonEmptySimpleStr' + ,'Column ParameterAttribute typed correctly'); + + Test::More::is + ($pa{baz_list}->_isa_metadata, 'Reaction::InterfaceModel::DBIC::Collection', + "Relationship detected successfully"); + + my (@dm) = $im->domain_models; + Test::More::ok(@dm == 1, 'Correct number of Domain Models'); + my $dm = shift @dm; + Test::More::is($dm->name, '_foo_store', 'Domain Model created correctly'); + + my $rs = $collection->_override_action_args_for->{target_model}; + Test::More::isa_ok( $rs, 'DBIx::Class::ResultSet', + 'Collection target_type ISA ResultSet' ); + + my $row = $im->_default_action_args_for->{target_model}; + Test::More::isa_ok( $row, 'DBIx::Class::Row', 'Collection target_type ISA Row' ); + + my $ctx = $self->simple_mock_context; + + my $create = $collection->action_for('Create', ctx => $ctx); + Test::More::isa_ok( $create, 'Reaction::InterfaceModel::Action', + 'Create action isa Action' ); + + Test::More::isa_ok( $create, 'ComponentUI::TestModel::Foo::Action::Create', + 'Create action has correct name' ); + + Test::More::isa_ok + ( $create, 'Reaction::InterfaceModel::Action::DBIC::ResultSet::Create', + 'Create action isa Action::DBIC::ResultSet::Create' ); + + + my $update = $im->action_for('Update', ctx => $ctx); + Test::More::isa_ok( $update, 'Reaction::InterfaceModel::Action', + 'Update action isa Action' ); + + Test::More::isa_ok( $update, 'ComponentUI::TestModel::Foo::Action::Update', + 'Update action has correct name' ); + + Test::More::isa_ok + ( $update, 'Reaction::InterfaceModel::Action::DBIC::Result::Update', + 'Update action isa Action::DBIC::ResultSet::Update' ); + + my $delete = $im->action_for('Delete', ctx => $ctx); + Test::More::isa_ok( $delete, 'Reaction::InterfaceModel::Action', + 'Delete action isa Action' ); + + Test::More::isa_ok( $delete, 'ComponentUI::TestModel::Foo::Action::Delete', + 'Delete action has correct name' ); + + Test::More::isa_ok + ( $delete, 'Reaction::InterfaceModel::Action::DBIC::Result::Delete', + 'Delete action isa Action::DBIC::ResultSet::Delete' ); + + + my $custom = $im->action_for('CustomAction', ctx => $ctx); + Test::More::isa_ok( $custom, 'Reaction::InterfaceModel::Action', + 'CustomAction isa Action' ); + + Test::More::isa_ok( $custom, 'ComponentUI::TestModel::Foo::Action::CustomAction', + 'CustomAction has correct name' ); + + my %params = map {$_->name => $_ } $custom->parameter_attributes; + Test::More::ok(exists $params{$_}, "Field ${_} reflected") + for qw(first_name last_name baz_list); + + #TODO -- will I need a mock $c object or what? I dont really know much about + # testingcat apps, who wants to volunteer? + # main things needing testing is attribute reflection + # and correct action class creation (superclasses) +} + + +1; diff --git a/t/lib/RTest/InterfaceModel/Reflector/DBIC.pm b/t/lib/RTest/InterfaceModel/Reflector/DBIC.pm new file mode 100644 index 0000000..1215788 --- /dev/null +++ b/t/lib/RTest/InterfaceModel/Reflector/DBIC.pm @@ -0,0 +1,317 @@ +package RTest::InterfaceModel::Reflector::DBIC; + +use base qw/Reaction::Test::WithDB Reaction::Object/; +use Reaction::Class; +use Class::MOP (); +use ComponentUI::TestModel; +use Test::More (); +use Reaction::InterfaceModel::Reflector::DBIC; + +has '+schema_class' => (default => sub { 'RTest::TestDB' }); + +has im_schema => (is =>'ro', isa => 'RTest::TestIM', lazy_build => 1); + +#at the moment I am only testing with the "reflect all" functionality +#when I have time I will write test cases that cover all the other bases +#it's just kind of a pain in the ass right now and I am behind on a lot of other shit. + +sub build_im_schema{ + my $self = shift; + + my $reflector = Reaction::InterfaceModel::Reflector::DBIC + ->new(model_class => 'RTest::TestIM'); + + $reflector->reflect_model( + domain_model_class => 'RTest::TestDB', + #exclude_submodels => ['FooBaz'], + reflect_submodels => [qw/Foo Bar Baz/] + ); + my (@dm) = RTest::TestIM->domain_models; + Test::More::ok(@dm == 1, 'Correct number of Domain Models'); + my $dm = shift @dm; + + print STDERR "instantiating with domain name of " . $dm->name . "\n"; + RTest::TestIM->new($dm->name => $self->schema); +} + +sub test_classnames : Tests{ + my $self = shift; + + my $reflector = Reaction::InterfaceModel::Reflector::DBIC + ->new(model_class => 'RTest::__TestIM'); + + Test::More::ok( + Class::MOP::is_class_loaded( 'RTest::__TestIM'), + "Successfully created IM class" + ); + + Test::More::is( + $reflector->submodel_classname_from_source_name('Foo'), + 'RTest::__TestIM::Foo', + 'Correct naming scheme for submodels' + ); + + Test::More::is( + $reflector->classname_for_collection_of('RTest::__TestIM::Foo'), + 'RTest::__TestIM::Foo::Collection', + 'Correct naming scheme for submodel collections' + ); +} + +sub test_reflect_model :Tests { + my $self = shift; + my $s = $self->im_schema; + + Test::More::isa_ok( $s, 'Reaction::InterfaceModel::Object', + 'Correct base' ); + + my %pa = map{$_->name => $_ } $s->parameter_attributes; + Test::More::ok(keys %pa == 3, 'Correct number of Parameter Attributes'); + + Test::More::ok($pa{Foo} && $pa{'Bar'} && $pa{'Baz'}, + 'Parameter Attributes named correctly'); + + for my $submodel (values %pa){ + Test::More::ok( + $submodel->_isa_metadata->isa('Reaction::InterfaceModel::Collection::Virtual::ResultSet'), + 'Parameter Attribute typed correctly' + ); + } + + Test::More::can_ok($s, qw/foo_collection bar_collection baz_collection/); + + for ( qw/Foo Bar Baz/ ){ + Test::More::ok( + Class::MOP::is_class_loaded("RTest::TestIM::${_}"), + "Successfully created ${_} IM class" + ); + Test::More::ok( + Class::MOP::is_class_loaded("RTest::TestIM::${_}::Collection"), + "Successfully created ${_} IM class Collection" + ); + } +} + + +sub test_add_submodel_to_model :Tests { + my $self = shift; + my $s = $self->im_schema; + + for (qw/Foo Bar Baz /) { + my $attr = $s->meta->find_attribute_by_name($_); + my $reader = $_; + $reader =~ s/([a-z0-9])([A-Z])/${1}_${2}/g ; + $reader = lc($reader) . "_collection"; + + Test::More::ok( $attr->is_required, "${_} is required"); + Test::More::ok( $attr->has_reader, "${_} has a reader"); + Test::More::ok( $attr->has_predicate, "${_} has a predicate"); + Test::More::ok( $attr->has_domain_model, "${_} has a domain_model"); + Test::More::ok( $attr->has_default, "${_} has a default"); + Test::More::ok( $attr->is_default_a_coderef, "${_}'s defaultis a coderef"); + Test::More::is( $attr->reader, $reader, "Correct ${_} reader"); + Test::More::is( $attr->domain_model, "_RTest_TestDB", "Correct ${_} domain_model"); + + Test::More::isa_ok( + $s->$reader, + "RTest::TestIM::${_}::Collection", + "${_} default method works" + ); + + } +} + +sub test_reflect_collection_for :Tests{ + my $self = shift; + my $s = $self->im_schema; + + for ( qw/Foo Bar Baz/ ){ + my $reader = $s->meta->find_attribute_by_name($_)->reader; + my $collection = $s->$reader; + + Test::More::is( + $collection->meta->name, + "RTest::TestIM::${_}::Collection", + "Correct Classname" + ); + Test::More::isa_ok( + $collection, + 'Reaction::InterfaceModel::Collection', + "Collection ISA Collection" + ); + Test::More::isa_ok( + $collection, + 'Reaction::InterfaceModel::Collection::Virtual', + "Collection ISA virtual collection" + ); + Test::More::isa_ok( + $collection, + 'Reaction::InterfaceModel::Collection::Virtual::ResultSet', + "Collection ISA virtual resultset" + ); + Test::More::can_ok($collection, '_build_im_class'); + Test::More::is( + $collection->_build_im_class, + "RTest::TestIM::${_}", + "Collection has correct _im_class" + ); + } +} + +sub test_reflect_submodel :Tests{ + my $self = shift; + my $s = $self->im_schema; + + for my $sm ( qw/Foo Bar Baz/ ){ + my $reader = $s->meta->find_attribute_by_name($sm)->reader; + my $collection = $s->$reader; + my ($member) = $collection->members; + Test::More::ok($member, "Successfully retrieved member"); + Test::More::isa_ok( + $member, + "Reaction::InterfaceModel::Object", + "Member isa IM::Object" + ); + Test::More::isa_ok($member, $collection->_im_class); + + my (@dm) = $member->domain_models; + Test::More::ok(@dm == 1, 'Correct number of Domain Models'); + my $dm = shift @dm; + + my $dm_name = $sm; + $dm_name =~ s/([a-z0-9])([A-Z])/${1}_${2}/g ; + $dm_name = "_" . lc($dm_name) . "_store"; + + Test::More::is($dm->_is_metadata, "rw", "Correct is metadata"); + Test::More::ok($dm->is_required, "DM is_required"); + Test::More::is($dm->name, $dm_name, "Correct DM name"); + Test::More::can_ok($member, "inflate_result"); + Test::More::is( + $dm->_isa_metadata, + "RTest::TestDB::${sm}", + "Correct isa metadata" + ); + + my %attrs = map { $_->name => $_ } $member->parameter_attributes; + my $target; + if( $sm eq "Bar"){$target = 4; } + elsif($sm eq "Baz"){$target = 3; } + elsif($sm eq "Foo"){$target = 4; } + Test::More::is( scalar keys %attrs, $target, "Correct # of attributes"); + + for my $attr_name (keys %attrs){ + my $attr = $attrs{$attr_name}; + Test::More::ok($attr->is_lazy, "is lazy"); + Test::More::ok($attr->is_required, "is required"); + Test::More::ok($attr->has_clearer, "has clearer"); + Test::More::ok($attr->has_default, "has defau;t"); + Test::More::ok($attr->has_predicate, "has predicate"); + Test::More::ok($attr->has_domain_model, "has domain model"); + Test::More::ok($attr->has_orig_attr_name, "has orig attr name"); + Test::More::ok($attr->is_default_a_coderef, "default is coderef"); + Test::More::is($attr->_is_metadata, "ro", "Correct is metadata"); + Test::More::is($attr->domain_model, $dm_name, "Correct domain model"); + Test::More::is($attr->orig_attr_name, $attr_name, "Correct orig attr name"); + } + + if($sm eq "Foo"){ + Test::More::is($attrs{id}->_isa_metadata, "Int", "Correct id isa metadata"); + Test::More::is($attrs{first_name}->_isa_metadata, "NonEmptySimpleStr", "Correct first_name isa metadata"); + Test::More::is($attrs{last_name}->_isa_metadata, "NonEmptySimpleStr", "Correct last_name isa metadata"); + Test::More::is( + $attrs{baz_list}->_isa_metadata, + "RTest::TestIM::Baz::Collection", + "Correct baz_list isa metadata" + ); + } elsif($sm eq 'Bar'){ + Test::More::is($attrs{name}->_isa_metadata, "NonEmptySimpleStr", "Correct name isa metadata"); + Test::More::is($attrs{foo}->_isa_metadata, "RTest::TestIM::Foo", "Correct foo isa metadata"); + Test::More::is($attrs{published_at}->_isa_metadata, "DateTime", "Correct published_at isa metadata"); + Test::More::is($attrs{avatar}->_isa_metadata, "File", "Correct avatar isa metadata"); + } elsif($sm eq "Baz"){ + Test::More::is($attrs{id}->_isa_metadata, "Int", "Correct id isa metadata"); + Test::More::is($attrs{name}->_isa_metadata, "NonEmptySimpleStr", "Correct name isa metadata"); + Test::More::is( + $attrs{foo_list}->_isa_metadata, + "RTest::TestIM::Foo::Collection", + "Correct foo_list isa metadata" + ); + } + + } +} + +sub test_reflect_submodel_action :Tests{ + my $self = shift; + my $s = $self->im_schema; + + for my $sm ( qw/Foo Bar Baz/ ){ + my $reader = $s->meta->find_attribute_by_name($sm)->reader; + my $collection = $s->$reader; + my ($member) = $collection->members; + Test::More::ok($member, "Successfully retrieved member"); + Test::More::isa_ok( + $member, + "Reaction::InterfaceModel::Object", + "Member isa IM::Object" + ); + Test::More::isa_ok($member, $collection->_im_class); + + my $ctx = $self->simple_mock_context; + foreach my $action_name (qw/Update Delete Create/){ + + my $target_im = $action_name eq 'Create' ? $collection : $member; + my $action = $target_im->action_for($action_name, ctx => $ctx); + + Test::More::isa_ok( $action, "Reaction::InterfaceModel::Action", + "Create action isa Action" ); + Test::More::is( + $action->meta->name, + "RTest::TestIM::${sm}::Action::${action_name}", + "${action_name} action has correct name" + ); + + my $base = 'Reaction::InterfaceModel::Action::DBIC' . + ($action_name eq 'Create' ? '::ResultSet::Create' : "::Result::${action_name}"); + Test::More::isa_ok($action, $base, 'Create action has correct base'); + + + my %attrs = map { $_->name => $_ } $action->parameter_attributes; + my $attr_num; + if($action_name eq 'Delete'){next; } + elsif($sm eq "Bar"){$attr_num = 4; } + elsif($sm eq "Baz"){$attr_num = 1; } + elsif($sm eq "Foo"){$attr_num = 3; } + Test::More::is( scalar keys %attrs, $attr_num, "Correct # of attributes"); + if($attr_num != keys %attrs ){ + print STDERR "\t..." . join ", ", keys %attrs, "\n"; + } + + for my $attr_name (keys %attrs){ + my $attr = $attrs{$attr_name}; + Test::More::ok($attr->has_predicate, "has predicate"); + Test::More::is($attr->_is_metadata, "rw", "Correct is metadata"); + if ($attr->is_required){ + Test::More::ok($attr->is_lazy, "is lazy"); + Test::More::ok($attr->has_default, "has default"); + Test::More::ok($attr->is_default_a_coderef, "default is coderef"); + } + } + + if($sm eq "Foo"){ + Test::More::is($attrs{first_name}->_isa_metadata, "NonEmptySimpleStr", "Correct first_name isa metadata"); + Test::More::is($attrs{last_name}->_isa_metadata, "NonEmptySimpleStr", "Correct last_name isa metadata"); + Test::More::is($attrs{baz_list}->_isa_metadata, "ArrayRef", "Correct baz_list isa metadata"); + } elsif($sm eq 'Bar'){ + Test::More::is($attrs{name}->_isa_metadata, "NonEmptySimpleStr", "Correct name isa metadata"); + Test::More::is($attrs{foo}->_isa_metadata, "RTest::TestDB::Foo", "Correct foo isa metadata"); + Test::More::is($attrs{published_at}->_isa_metadata, "DateTime", "Correct published_at isa metadata"); + Test::More::is($attrs{avatar}->_isa_metadata, "File", "Correct avatar isa metadata"); + } elsif($sm eq "Baz"){ + Test::More::is($attrs{name}->_isa_metadata, "NonEmptySimpleStr", "Correct name isa metadata"); + } + } + } +} + +1; diff --git a/t/lib/RTest/TestDB.pm b/t/lib/RTest/TestDB.pm new file mode 100644 index 0000000..25012d2 --- /dev/null +++ b/t/lib/RTest/TestDB.pm @@ -0,0 +1,29 @@ +package # hide from PAUSE + RTest::TestDB; + +use base qw/DBIx::Class::Schema/; + +use DateTime; + +__PACKAGE__->load_classes; + +sub setup_test_data { + my $self = shift; + $self->populate('Foo' => [ + [ qw/ first_name last_name / ], + map { ( + [ "Joe", "Bloggs $_" ], + [ "John", "Smith $_" ], + ) } (1 .. 50) + ]); + $self->populate('Baz' => [ + [ qw/ name / ], + map { [ "Baz $_" ] } (1 .. 4) + ]); + $self->populate('Bar' => [ + [ qw/ name foo_id / ], + map { [ "Bar $_", $_ ] } (1 .. 4) + ]); +} + +1; diff --git a/t/lib/RTest/TestDB/Bar.pm b/t/lib/RTest/TestDB/Bar.pm new file mode 100644 index 0000000..4e22d06 --- /dev/null +++ b/t/lib/RTest/TestDB/Bar.pm @@ -0,0 +1,34 @@ +package # hide from PAUSE + RTest::TestDB::Bar; + +use DBIx::Class 0.07; + +use base qw/DBIx::Class Reaction::Object/; +use Reaction::Class; +use Reaction::Types::DateTime; +use Reaction::Types::File; + +has 'name' => (isa => 'NonEmptySimpleStr', is => 'rw', required => 1); +has 'foo' => (isa => 'RTest::TestDB::Foo', is => 'rw', required => 1); +has 'published_at' => (isa => 'DateTime', is => 'rw'); +has 'avatar' => (isa => 'File', is => 'rw'); + +__PACKAGE__->load_components(qw/InflateColumn::DateTime Core/); + +__PACKAGE__->table('bar'); + +__PACKAGE__->add_columns( + name => { data_type => 'varchar', size => 255 }, + foo_id => { data_type => 'integer', size => 16 }, + published_at => { data_type => 'datetime', is_nullable => 1 }, + avatar => { data_type => 'blob', is_nullable => 1 }, +); + +__PACKAGE__->set_primary_key('name'); + +__PACKAGE__->belongs_to( + 'foo' => 'RTest::TestDB::Foo', + { 'foreign.id' => 'self.foo_id' } +); + +1; diff --git a/t/lib/RTest/TestDB/Baz.pm b/t/lib/RTest/TestDB/Baz.pm new file mode 100644 index 0000000..848cb4f --- /dev/null +++ b/t/lib/RTest/TestDB/Baz.pm @@ -0,0 +1,29 @@ +package # hide from PAUSE + RTest::TestDB::Baz; + +use DBIx::Class 0.07; + +use base qw/DBIx::Class Reaction::Object/; +use Reaction::Class; + +has 'id' => (isa => 'Int', is => 'ro', required => 1); +has 'name' => (isa => 'NonEmptySimpleStr', is => 'rw', required => 1); +has 'foo_list' => (isa => 'ArrayRef', is => 'ro', required => 1); + +__PACKAGE__->load_components(qw/InflateColumn::DateTime Core/); + +__PACKAGE__->table('baz'); + +__PACKAGE__->add_columns( + id => { data_type => 'integer', size => 16, is_auto_increment => 1 }, + name => { data_type => 'varchar', size => 255 }, +); + +sub display_name { shift->name; } + +__PACKAGE__->set_primary_key('id'); + +__PACKAGE__->has_many('links_to_foo_list' => 'RTest::TestDB::FooBaz', 'baz'); +__PACKAGE__->many_to_many('foo_list' => 'links_to_foo_list' => 'foo'); + +1; diff --git a/t/lib/RTest/TestDB/Foo.pm b/t/lib/RTest/TestDB/Foo.pm new file mode 100644 index 0000000..5733054 --- /dev/null +++ b/t/lib/RTest/TestDB/Foo.pm @@ -0,0 +1,42 @@ +package # hide from PAUSE + RTest::TestDB::Foo; + +use DBIx::Class 0.07; + +use base qw/DBIx::Class Reaction::Object/; +use Reaction::Class; + +has 'id' => (isa => 'Int', is => 'ro', required => 1); +has 'first_name' => (isa => 'NonEmptySimpleStr', is => 'rw', required => 1); +has 'last_name' => (isa => 'NonEmptySimpleStr', is => 'rw', required => 1); +has 'baz_list' => ( + isa => 'ArrayRef', is => 'rw', required => 1, + reader => 'get_baz_list', writer => 'set_baz_list' +); + +__PACKAGE__->load_components(qw/InflateColumn::DateTime Core/); + +__PACKAGE__->table('foo'); + +__PACKAGE__->add_columns( + id => { data_type => 'integer', size => 16, is_auto_increment => 1 }, + first_name => { data_type => 'varchar', size => 255 }, + last_name => { data_type => 'varchar', size => 255 }, +); + +sub display_name { + my $self = shift; + return join(' ', $self->first_name, $self->last_name); +} + +__PACKAGE__->set_primary_key('id'); + +__PACKAGE__->has_many('links_to_baz_list' => 'RTest::TestDB::FooBaz', 'foo'); +__PACKAGE__->many_to_many('baz_list' => 'links_to_baz_list' => 'baz'); + +{ + no warnings 'redefine'; + *get_baz_list = sub { [ shift->baz_list->all ] }; +} + +1; diff --git a/t/lib/RTest/TestDB/FooBaz.pm b/t/lib/RTest/TestDB/FooBaz.pm new file mode 100644 index 0000000..695b141 --- /dev/null +++ b/t/lib/RTest/TestDB/FooBaz.pm @@ -0,0 +1,22 @@ +package # hide from PAUSE + RTest::TestDB::FooBaz; + +use DBIx::Class 0.07; + +use base qw/DBIx::Class/; + +__PACKAGE__->load_components(qw/InflateColumn::DateTime Core/); + +__PACKAGE__->table('foo_baz'); + +__PACKAGE__->add_columns( + foo => { data_type => 'integer', size => 16 }, + baz => { data_type => 'integer', size => 16 }, +); + +__PACKAGE__->set_primary_key(qw/foo baz/); + +__PACKAGE__->belongs_to('foo' => 'RTest::TestDB::Foo'); +__PACKAGE__->belongs_to('baz' => 'RTest::TestDB::Baz'); + +1; diff --git a/t/lib/RTest/UI/FocusStack.pm b/t/lib/RTest/UI/FocusStack.pm new file mode 100644 index 0000000..b30f060 --- /dev/null +++ b/t/lib/RTest/UI/FocusStack.pm @@ -0,0 +1,56 @@ +package RTest::UI::FocusStack; + +use base qw/Test::Class/; +use Reaction::Class; +use Reaction::UI::FocusStack; +use aliased "Reaction::UI::ViewPort"; +use Test::More (); +use Test::Memory::Cycle; + +has 'stack' => (isa => 'Reaction::UI::FocusStack', is => 'rw', set_or_lazy_build('stack')); + +sub build_stack { + return Reaction::UI::FocusStack->new; +} + +sub test_stack :Tests { + my $self = shift; + my $stack = $self->build_stack; + my $ctx = bless({}, 'Catalyst'); + Test::More::ok(!$stack->has_loc_prefix, 'No location prefix'); + Test::More::cmp_ok($stack->vp_count, '==', 0, 'Empty viewport stack'); + my $vp = $stack->push_viewport(ViewPort, ctx => $ctx); + Test::More::is($vp->location, '0', 'New vp has location 0'); + Test::More::cmp_ok($stack->vp_count, '==', 1, 'Viewport count 1'); + Test::More::is($stack->vp_head, $vp, 'Head set ok'); + Test::More::is($stack->vp_tail, $vp, 'Tail set ok'); + my $vp2 = $stack->push_viewport(ViewPort, ctx => $ctx); + Test::More::is($vp2->location, '1', 'New vp has location 1'); + Test::More::cmp_ok($stack->vp_count, '==', 2, 'Viewport count 2'); + Test::More::is($stack->vp_head, $vp, 'Head set ok'); + Test::More::is($stack->vp_tail, $vp2, 'Tail set ok'); + Test::More::is($vp->inner, $vp2, 'Inner ok on head'); + Test::More::is($vp2->outer, $vp, 'Outer ok on tail'); + Test::More::is($vp->focus_stack, $stack, 'Head focus_stack ok'); + Test::More::is($vp2->focus_stack, $stack, 'Tail focus_stack ok'); + memory_cycle_ok($stack, 'No cycles in the stack'); + my $vp3 = $stack->push_viewport(ViewPort, ctx => $ctx); + my $vp4 = $stack->push_viewport(ViewPort, ctx => $ctx); + Test::More::is($stack->vp_tail, $vp4, 'Tail still ok'); + Test::More::cmp_ok($stack->vp_count, '==', 4, 'Count still ok'); + $stack->pop_viewports_to($vp3); + Test::More::is($stack->vp_tail, $vp2, 'Correct pop to'); + Test::More::cmp_ok($stack->vp_count, '==', 2, 'Count after pop to'); + Test::More::is($stack->vp_head, $vp, 'Head unchanged'); + Test::More::is($stack->vp_tail, $vp2, 'Tail back to vp2'); + my $pop_ret = $stack->pop_viewport; + Test::More::is($vp2, $pop_ret, 'Correct viewport popped'); + Test::More::is($stack->vp_head, $vp, 'Head unchanged'); + Test::More::is($stack->vp_tail, $vp, 'Tail now head'); + $stack->pop_viewport; + Test::More::ok(!defined($stack->vp_head), 'Head cleared'); + Test::More::ok(!defined($stack->vp_tail), 'Tail cleared'); + Test::More::cmp_ok($stack->vp_count, '==', 0, 'Count Zero'); +} + +1; diff --git a/t/lib/RTest/UI/ViewPort/ListView.pm b/t/lib/RTest/UI/ViewPort/ListView.pm new file mode 100644 index 0000000..02d00ba --- /dev/null +++ b/t/lib/RTest/UI/ViewPort/ListView.pm @@ -0,0 +1,102 @@ +package RTest::UI::ViewPort::ListView; + +use base qw/Reaction::Test::WithDB/; +use Reaction::Class; + +use Reaction::UI::ViewPort::ListView; +use RTest::TestDB; +use Test::More (); + +has '+schema_class' => (default => sub { 'RTest::TestDB' }); + +has 'viewport' => ( + isa => 'Reaction::UI::ViewPort::ListView', + is => 'rw', set_or_lazy_build('viewport'), + clearer => 'clear_viewport', +); + +has 'collection' => ( + isa => 'DBIx::Class::ResultSet', + is => 'rw', set_or_lazy_build('collection'), + clearer => 'clear_collection', +); + +sub build_collection { + shift->schema->resultset('Foo'); +} + +sub build_viewport { + my ($self) = @_; + my $vp = Reaction::UI::ViewPort::ListView->new( + location => 0, + collection => $self->collection, + ctx => $self->simple_mock_context, + column_order => [qw(id first_name last_name)], + ); + return $vp; +} + +sub init_viewport :Tests { + my ($self) = @_; + + $self->clear_viewport; + + Test::More::cmp_ok($self->viewport->page, '==', 1, "Default page"); + Test::More::cmp_ok($self->viewport->per_page, '==', 10, "Default per page"); + + my @columns = qw(id first_name last_name); + Test::More::is_deeply($self->viewport->field_names, \@columns, "Field names"); + Test::More::is($self->viewport->field_label('first_name'), 'First Name', 'Field label'); + + my @rows = $self->viewport->current_rows; + Test::More::cmp_ok(@rows, '==', 10, 'Row count'); + Test::More::isa_ok($rows[0], 'RTest::TestDB::Foo', 'First row class'); + Test::More::cmp_ok($rows[0]->id, '==', 1, 'First row id'); + + my $pager = $self->viewport->pager; + Test::More::cmp_ok($pager->current_page, '==', 1, 'Pager current page'); + Test::More::cmp_ok($pager->next_page, '==', 2, 'Pager next page'); + Test::More::ok(!defined($pager->previous_page), 'Pager previous page'); + Test::More::cmp_ok($pager->entries_per_page, '==', 10, 'Pager entries per page'); +} + +sub modify_viewport :Tests { + my ($self) = @_; + + $self->clear_viewport; + + $self->viewport->per_page(20); + $self->viewport->page(2); + + my $pager = $self->viewport->pager; + + Test::More::cmp_ok($pager->current_page, '==', 2, 'Pager current page'); + Test::More::cmp_ok($pager->last_page, '==', 5, 'Pager last page'); +} + +sub viewport_to_csv :Tests { + my ($self) = @_; + + $self->clear_viewport; + + $self->viewport->export_to_csv; + + Test::More::like($self->viewport->ctx->res->body, + qr/^Id,"First Name","Last Name"\r +1,Joe,"Bloggs 1"\r +2,John,"Smith 1"\r +3,Joe,"Bloggs 2"\r +4,John,"Smith 2"\r +5,Joe,"Bloggs 3"\r +6,John,"Smith 3"\r +7,Joe,"Bloggs 4"\r +8,John,"Smith 4"\r +9,Joe,"Bloggs 5"\r +10,John,"Smith 5"\r +/, "CSV export head ok"); + Test::More::like($self->viewport->ctx->res->body, + qr/100,John,"Smith 50"\r\n$/, "CSV export tail ok"); + +} + +1; diff --git a/t/lib/RTest/UI/Window.pm b/t/lib/RTest/UI/Window.pm new file mode 100644 index 0000000..2528f03 --- /dev/null +++ b/t/lib/RTest/UI/Window.pm @@ -0,0 +1,110 @@ +package RTest::UI::Window; + +use aliased 'Reaction::UI::ViewPort'; + +use base qw/Reaction::Test/; +use Reaction::Class; + +BEGIN { + + package RTest::UI::Window::_::view; + + use base qw/Reaction::UI::Renderer::XHTML/; + + sub render { + return $_[0]->{render}->(@_); + } + + package RTest::UI::Window::_::TestViewPort; + + use Reaction::Class; + + extends 'Reaction::UI::ViewPort'; + + register_inc_entry; + + sub handle_events { + $_[0]->{handle_events}->(@_); + } + +}; + +use Test::More (); +use Reaction::UI::Window; +use aliased 'RTest::UI::Window::_::TestViewPort'; + +has 'window' => ( + isa => 'Reaction::UI::Window', is => 'rw', + set_or_lazy_build('window') +); + +sub build_window { + my $self = shift; + return Reaction::UI::Window->new( + ctx => bless({}, 'Reaction::Test::Mock::Context'), + view_name => 'Test', + content_type => 'text/html', + ); +} + +sub test_window :Tests { + my $self = shift; + my $window = $self->build_window; + my $view = bless({}, 'RTest::UI::Window::_::view'); + $window->ctx->{view} = sub { + Test::More::is($_[1], 'Test', 'View name ok'); + return $view; + }; + Test::More::is($window->view, $view, 'View retrieved from context'); + my %param; + $window->ctx->{req} = sub { + return bless({ + query_parameters => sub { \%param }, + body_parameters => sub { {} }, + }, 'Reaction::Test::Mock::Request'); + }; + $window->ctx->{res} = sub { + return bless({ + status => sub { 200 }, + body => sub { '' }, + }, 'Reaction::Test::Mock::Response'); + }; + eval { $window->flush }; + Test::More::like($@, qr/empty focus stack/, 'Error thrown without viewports'); + my @vp; + push(@vp, $window->focus_stack + ->push_viewport(ViewPort, ctx => $window->ctx)); + push(@vp, $window->focus_stack + ->push_viewport(ViewPort, ctx => $window->ctx)); + my $i; + $view->{render} = sub { + my $expect_vp = $vp[$i++]; + Test::More::is($_[1], $window->ctx, 'Context ok'); + Test::More::is($_[2], 'component', 'Component template'); + Test::More::is($_[3]->{self}, $expect_vp, 'Viewport'); + $_[3]->{window}->render_viewport($expect_vp->inner); + return "foo"; + }; + my $body; + $window->ctx->{res} = sub { + return bless({ + body => sub { shift; return '' unless @_; $body = shift; }, + content_type => sub { }, + status => sub { 200 }, + }, 'Reaction::Test::Mock::Response'); + }; + $window->flush; + Test::More::is($body, 'foo', 'body set ok'); + my $test_vp = $vp[1]->create_tangent('foo') + ->push_viewport(TestViewPort, + ctx => bless({}, 'Catalyst')); + my $param_name = '1.foo.0:name'; + Test::More::is($test_vp->event_id_for('name'), $param_name, 'Event id ok'); + $param{$param_name} = 'blah'; + $test_vp->{handle_events} = sub { + Test::More::is($_[1]->{name}, 'blah', 'Event delivered ok'); + }; + $window->flush_events; +} + +1; diff --git a/t/simple.pl b/t/simple.pl new file mode 100644 index 0000000..0244f7c --- /dev/null +++ b/t/simple.pl @@ -0,0 +1,11 @@ +use strict; +use warnings; + +use lib 'lib'; +use ComponentUI; + +my $ctx = bless({ stash => {} }, 'ComponentUI'); + +my $view = ComponentUI->view('TT'); + +print $view->render($ctx, 'textfield', { self => { label => 'Label', message => 'Status message.' }, blocks => {} }); diff --git a/t/ui_focus_stack.t b/t/ui_focus_stack.t new file mode 100644 index 0000000..15bf439 --- /dev/null +++ b/t/ui_focus_stack.t @@ -0,0 +1,11 @@ +use lib 't/lib'; +use strict; +use warnings; + +use Test::Class; +use RTest::UI::FocusStack; + +Test::Class->runtests( + RTest::UI::FocusStack->new, +); + diff --git a/t/ui_viewport.t b/t/ui_viewport.t new file mode 100644 index 0000000..0cff6d8 --- /dev/null +++ b/t/ui_viewport.t @@ -0,0 +1,10 @@ +use lib 't/lib'; +use strict; +use warnings; + +use Test::Class; +use RTest::UI::ViewPort::ListView; + +Test::Class->runtests( + RTest::UI::ViewPort::ListView->new, +); diff --git a/t/ui_widget_listview.show b/t/ui_widget_listview.show new file mode 100644 index 0000000..05e3ab8 --- /dev/null +++ b/t/ui_widget_listview.show @@ -0,0 +1,43 @@ +use strict; +use warnings; +use Reaction::UI::Widget::ListView; +use Data::Dump::Streamer qw(Dump); + +my ($name, $data); + +sub FakeRCTX::render { + shift; + ($name, $data) = @_; +} + +sub FakeVP::field_names { [ qw(foo bar baz) ] } + +sub FakeVP::field_label_map { ({ foo => 'Foo', bar => 'Bar', baz => 'Baz' }); } + +my $w = bless({ viewport => 'VIEWPORT' }, 'Reaction::UI::Widget::ListView'); + +my $rctx = bless({}, 'FakeRCTX'); + +$w->render_header($rctx, { self => $w, viewport => bless({}, 'FakeVP') }); + +print "Name: ${name}\n"; +print "Data: "; +print Dump($data); + +my $first = $data->{_}->(); + +print "First: "; +print Dump($first); + +$first->($rctx); + +print "Name: ${name}\n"; +print "Data: "; +print Dump($data); + +my $inner = $data->{_}->(); + +print "Inner: "; +print Dump($inner); + +print $inner->(); diff --git a/t/ui_window.t b/t/ui_window.t new file mode 100644 index 0000000..0fcd1e8 --- /dev/null +++ b/t/ui_window.t @@ -0,0 +1,10 @@ +use lib 't/lib'; +use strict; +use warnings; + +use Test::Class; +use RTest::UI::Window; + +Test::Class->runtests( + RTest::UI::Window->new, +); -- cgit v1.2.3-54-g00ecf