package tests::UIListWidgetTest; use strict; use base qw/ Lire::Test::TestCase /; use Lire::Config::TypeSpec; use Lire::UI::ListWidget; use Lire::Test::CursesUIDriver; use Lire::Test::Mock; use Curses::UI; #our @TESTS = qw//; sub set_up { my $self = $_[0]; $self->SUPER::set_up(); $self->{'driver'} = new Lire::Test::CursesUIDriver(); $self->{'driver'}->setup_curses_ui(); $self->{'ui'} = new Curses::UI(); $self->{'driver'}->set_curses_ui( $self->{'ui'} ); $self->{'window'} = $self->{'ui'}->add( 'window', 'Window' ); my $spec = new Lire::Config::ConfigSpec(); my $list_param = new Lire::Config::ListSpec( 'name' => 'list_param' ); my $poly_list = new Lire::Config::ListSpec( 'name' => 'poly_list' ); my $comp_list = new Lire::Config::ListSpec( 'name' => 'comp_list' ); $spec->add( $list_param ); $spec->add( $poly_list ); $spec->add( $comp_list ); my $string_param = new Lire::Config::StringSpec( 'name' => 'string' ); $list_param->add( $string_param ); $poly_list->add( new Lire::Config::StringSpec( 'name' => 'string', 'summary' => 'String' ) ); $poly_list->add( new Lire::Config::BooleanSpec( 'name' => 'boolean', 'summary' => 'Bool' ) ); my $compound = new Lire::Config::RecordSpec( 'name' => 'compound', 'label' => 'label' ); my $label_spec = new Lire::Config::StringSpec( 'name' => 'label' ); my $string1_spec = new Lire::Config::StringSpec( 'name' => 'string1' ); my $string2_spec = new Lire::Config::StringSpec( 'name' => 'attribute2' ); $compound->add( $label_spec ); $compound->add( $string1_spec ); $compound->add( $string2_spec ); $comp_list->add( $compound ); $self->{'spec'} = $spec; my $list_value = $self->{'list_value'} = $list_param->instance(); $list_value->append( $string_param->instance( 'value' => 'string1' ) ); $list_value->append( $string_param->instance( 'value' => 'string2' ) ); $list_value->append( $string_param->instance( 'value' => 'string3' ) ); $self->{'poly_value'} = $poly_list->instance(); my $comp_value = $self->{'comp_value'} = $comp_list->instance(); my $comp_inst = $compound->instance(); $comp_inst->set( $label_spec->instance( 'value' => 'compvalue1' ) ); $comp_inst->set( $string1_spec->instance( 'value' => 'wawa string' ) ); $comp_inst->set( $string2_spec->instance( 'value' => 'wawa attr' ) ); $comp_value->append( $comp_inst ); $comp_inst = $compound->instance(); $comp_inst->set( $label_spec->instance( 'value' => 'compvalue2' ) ); $comp_inst->set( $string1_spec->instance( 'value' => 'test string' ) ); $comp_inst->set( $string2_spec->instance( 'value' => 'wawatest attr' ) ); $comp_value->append( $comp_inst ); return; } sub tear_down { my $self = $_[0]; $self->SUPER::tear_down(); $self->{'driver'}->teardown_curses_ui(); return; } sub test_new { my $self = $_[0]; my $win = $self->{'window'}; $self->assert_dies( qr/missing \'value\' parameter/, sub { my $widget = $win->add( 'list_widget', 'Lire::UI::ListWidget' ) } ); $self->assert_dies( qr/\'value\' parameter should be a 'Lire::Config::List' instance, not \'HASH/, sub { my $widget = $win->add( 'list_widget', 'Lire::UI::ListWidget', 'Value' => {} ) } ); $self->assert_dies( qr/\'spec\' should contain at least one component/, sub { my $widget = $win->add( 'list_widget', 'Lire::UI::ListWidget', 'Value' => new Lire::Config::ListSpec( 'name' => 'spec' )->instance() ) } ); foreach my $value ( ( $self->{'list_value'}, $self->{'comp_value'}, $self->{'poly_value'} ) ) { $self->annotate( 'Testing' . $value->name() . "\n" ); my $widget = $win->add( 'widget', 'Lire::UI::ListWidget', 'value' => $value ); $self->assert_isa( 'Lire::UI::ListWidget', $widget ); $self->assert_str_equals( ($value->spec()->components())[0], $widget->{'component'} ); my $values_list = $widget->getobj( 'list' ); $self->assert_isa( 'Curses::UI::Listbox', $values_list ); my $buttons = $widget->getobj( 'buttons' ); $self->assert_isa( 'Curses::UI::Buttonbox', $buttons ); $self->assert_str_equals( '[Add]', $buttons->{'-buttons'}[0]{'-label'} ); $self->assert_isa( 'CODE', $buttons->{'-buttons'}[0]{'-onpress'} ); $self->assert_str_equals( '[Copy]', $buttons->{'-buttons'}[2]{'-label'}); $self->assert_isa( 'CODE', $buttons->{'-buttons'}[2]{'-onpress'} ); $self->assert_str_equals( '[Delete]', $buttons->{'-buttons'}[3]{'-label'}); $self->assert_isa( 'CODE', $buttons->{'-buttons'}[3]{'-onpress'} ); $self->assert_str_equals( '[Up]', $buttons->{'-buttons'}[4]{'-label'}); $self->assert_isa( 'CODE', $buttons->{'-buttons'}[4]{'-onpress'} ); $self->assert_str_equals( '[Down]', $buttons->{'-buttons'}[5]{'-label'}); $self->assert_isa( 'CODE', $buttons->{'-buttons'}[5]{'-onpress'} ); $win->delete( 'widget' ); } return; } sub test_title { my $self = $_[0]; my $win = $self->{'window'}; my $widget = $win->add( 'list_widget', 'Lire::UI::ListWidget', '-title' => 'My title', '-titlefullwidth' => 1, '-titlereverse' => 0, 'value' => $self->{'list_value'} ); my $values_list = $widget->getobj( 'list' ); $self->assert_isa( 'Curses::UI::Listbox', $values_list ); $self->assert_str_equals( 'My title', $values_list->{'-title'} ); $self->assert_num_equals( 1, $values_list->{'-titlefullwidth'} ); $self->assert_num_equals( 0, $values_list->{'-titlereverse'} ); $self->assert_str_equals( 'My title', $widget->title() ); $widget->title( 'New title' ); $self->assert_str_equals( 'New title', $values_list->{'-title'} ); } sub test_refresh_view { my $self = $_[0]; my $widget = $self->{'window'}->add( 'list_widget', 'Lire::UI::ListWidget', 'value' => $self->{'list_value'} ); # Add an empty value $self->{'list_value'}->append( $self->{'list_value'}->spec()->get( 'string' )->instance() ); my $values_list = $widget->getobj( 'list' ); $values_list->{'-values'} = []; $values_list->{'-labels'} = {}; $widget->refresh_view(); $self->assert_deep_equals( [ $self->{'list_value'}->get(0), $self->{'list_value'}->get(1), $self->{'list_value'}->get(2), $self->{'list_value'}->get(3) ], $values_list->{'-values'} ); $self->assert_deep_equals( { $self->{'list_value'}->get(0) => 'string1', $self->{'list_value'}->get(1) => 'string2', $self->{'list_value'}->get(2) => 'string3', $self->{'list_value'}->get(3) => '' }, $values_list->{'-labels'} ); } sub test_add_element { my $self = $_[0]; my $list = $self->{'list_value'}->spec()->instance(); my $called = 'onvaluechanged not called'; my $widget = $self->{'window'}->add( 'list_widget', 'Lire::UI::ListWidget', 'value' => $list, 'onvaluechanged' => sub { $called = 'called' } ); my $proxy = new_proxy Lire::Test::Mock( $widget ); $proxy->set_result( 'new_value', '' ); $proxy->do_routine( 'add-element' ); $self->assert_str_equals( 'onvaluechanged not called', $called ); $self->assert_num_equals( 0, scalar $list->elements() ); my $value_widget = $widget->getobj( 'value_widget' ); $value_widget->{'value'}->set( 'A string' ); my $values_list = $widget->getobj( 'list' ); my $new_value = $list->spec()->get( 'string' )->instance( 'value' => 'A string' ); $proxy->set_result( 'new_value', $new_value ); $widget->do_routine( 'add-element' ); $self->assert_num_equals( 1, scalar $list->elements() ); $self->assert_num_equals( 1, scalar @{$values_list->{'-values'}} ); $self->assert_num_equals( 0, $values_list->{'-selected'} ); $self->assert_str_equals( $new_value, $list->get( 0 ) ); $self->assert_str_equals( $new_value, $values_list->{'-values'}[0] ); $self->assert_str_equals( 'called', $called ); $new_value = $new_value->clone(); $proxy->set_result( 'new_value', $new_value ); $widget->do_routine( 'add-element' ); $self->assert_num_equals( 2, scalar @{$values_list->{'-values'}} ); $self->assert_num_equals( 1, $values_list->{'-selected'} ); $self->assert_str_equals( $new_value, $values_list->{'-values'}[1] ); $new_value = $new_value->clone(); $proxy->set_result( 'new_value', $new_value ); $values_list->{'-selected'} = 0; $widget->do_routine( 'add-element' ); $self->assert_num_equals( 3, scalar @{$values_list->{'-values'}} ); $self->assert_num_equals( 1, $values_list->{'-selected'} ); $self->assert_str_equals( $new_value, $values_list->{'-values'}[1] ); } sub test_move { my $self = $_[0]; my $called = 'onvaluechanged not called'; my $widget = $self->{'window'}->add( 'list_widget', 'Lire::UI::ListWidget', 'value' => $self->{'list_value'}, 'onvaluechanged' => sub { $called = 'called' } ); my $values_list = $widget->getobj( 'list' ); $widget->do_routine( 'move-element-up' ); $self->assert_str_not_equals( 'called', $called ); $widget->do_routine( 'move-element', 0 ); $self->assert_str_not_equals( 'called', $called ); $values_list->{'-selected'} = 2; $widget->do_routine( 'move-element-down' ); $self->assert_str_not_equals( 'called', $called ); $values_list->{'-selected'} = 0; $widget->do_routine( 'move-element-down' ); $self->assert_str_equals( 'string1', $self->{'list_value'}->get(1)->get()); $self->assert_num_equals( 1, $values_list->{'-selected'} ); $self->assert_str_equals( $self->{'list_value'}->get(1), $values_list->{'-values'}[1] ); $self->assert_str_equals( 'called', $called ); $widget->do_routine( 'move-element-up' ); $self->assert_num_equals( 0, $values_list->{'-selected'} ); $self->assert_str_equals( 'string1', $self->{'list_value'}->get(0)->get()); $widget->do_routine( 'move-element', 2 ); $self->assert_num_equals( 2, $values_list->{'-selected'} ); $self->assert_str_equals( 'string1', $self->{'list_value'}->get(2)->get()); $widget->do_routine( 'move-element', -4 ); $self->assert_num_equals( 0, $values_list->{'-selected'} ); $self->assert_str_equals( 'string1', $self->{'list_value'}->get(0)->get()); $widget->do_routine( 'move-element', 4 ); $self->assert_num_equals( 2, $values_list->{'-selected'} ); $self->assert_str_equals( 'string1', $self->{'list_value'}->get(2)->get()); } sub test_del_element { my $self = $_[0]; my $called = 'onvaluechanged not called'; my $widget = $self->{'window'}->add( 'list_widget', 'Lire::UI::ListWidget', 'value' => $self->{'list_value'}, 'onvaluechanged' => sub { $called = 'called' } ); my $values_list = $widget->getobj( 'list' ); $self->assert_num_equals( 3, scalar @{$values_list->{'-values'}} ); $values_list->{'-focusable'} = 0; $widget->do_routine( 'del-element' ); $self->assert_num_equals( 3, scalar @{$values_list->{'-values'}} ); $self->assert_str_equals( 'onvaluechanged not called', $called ); my $new_elements = [ $self->{'list_value'}->get( 0 ), $self->{'list_value'}->get( 2 ) ]; $values_list->{'-focusable'} = 1; $values_list->{'-ypos'} = 1; $widget->do_routine( 'del-element' ); $self->assert_deep_equals( $new_elements, [ $self->{'list_value'}->elements() ] ); $self->assert_deep_equals( $new_elements, $values_list->{'-values'} ); $self->assert_str_equals( 'called', $called ); } sub test_copy_element { my $self = $_[0]; my $called = 'onvaluechanged not called'; my $widget = $self->{'window'}->add( 'list_widget', 'Lire::UI::ListWidget', 'value' => $self->{'list_value'}, 'onvaluechanged' => sub { $called = 'called' } ); my $values_list = $widget->getobj( 'list' ); $values_list->{'-selected'} = undef; $widget->do_routine( 'copy-element' ); $self->assert_num_equals( 3, scalar @{$values_list->{'-values'}} ); $values_list->{'-selected'} = 0; $widget->do_routine( 'copy-element' ); $self->assert_num_equals( 4, scalar $self->{'list_value'}->elements() ); $self->assert_num_equals( 4, scalar @{$values_list->{'-values'}} ); $self->assert_num_equals( 1, $values_list->{'-selected'} ); $self->assert_deep_equals( @{$values_list->{'-values'}}[0], @{$values_list->{'-values'}}[1] ); $self->assert_str_equals( $self->{'list_value'}->get( 1 ), @{$values_list->{'-values'}}[1] ); $self->assert_str_not_equals( $self->{'list_value'}->get( 0 ), $self->{'list_value'}->get( 1 ) ); $self->assert_str_equals( 'called', $called ); } sub test__sel_change_cb { my $self = $_[0]; my $widget = $self->{'window'}->add( 'widget', 'Lire::UI::ListWidget', 'value' => $self->{'list_value'} ); my $called = '-onchange not called'; my $list = $widget->getobj( 'list' ); $self->assert_isa( 'CODE', $list->{'-onselchange'} ); $list->{'-selected'} = 0; $list->{'-ypos'} = 1; $list->onChange( sub { $called = '-onchange called' } ); $list->run_event( '-onselchange' ); $self->assert_num_equals( 1, $list->{'-selected'} ); $self->assert_str_equals( '-onchange called', $called ); } 1;