diff options
-rw-r--r-- | testing/MANIFEST | 2 | ||||
-rw-r--r-- | testing/lib/Test/Irssi.pm | 40 | ||||
-rw-r--r-- | testing/lib/Test/Irssi/API.pm | 80 | ||||
-rw-r--r-- | testing/lib/Test/Irssi/Callbacks.pm | 2 | ||||
-rw-r--r-- | testing/lib/Test/Irssi/Driver.pm | 17 | ||||
-rw-r--r-- | testing/lib/Test/Irssi/Test.pm | 168 | ||||
-rwxr-xr-x | testing/test.pl | 30 |
7 files changed, 231 insertions, 108 deletions
diff --git a/testing/MANIFEST b/testing/MANIFEST index 4d67b37..1810c3e 100644 --- a/testing/MANIFEST +++ b/testing/MANIFEST @@ -10,4 +10,4 @@ t/002-init.t lib/Test/Irssi.pm lib/Test/Irssi/Callbacks.pm lib/Test/Irssi/Driver.pm -lib/Test/Irssi/API.pm
\ No newline at end of file +lib/Test/Irssi/Test.pm
\ No newline at end of file diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm index dbb2505..a8ee49e 100644 --- a/testing/lib/Test/Irssi.pm +++ b/testing/lib/Test/Irssi.pm @@ -19,9 +19,7 @@ class Test::Irssi { use Test::Irssi::Driver; use Test::Irssi::Callbacks; - use Test::Irssi::API; - - + use Test::Irssi::Test; has 'irssi_binary' @@ -98,17 +96,28 @@ class Test::Irssi { builder => '_build_callback_obj', ); - has 'api' + has 'tests' => ( is => 'ro', - isa => "Test::Irssi::API", + isa => "HashRef", required => 1, - lazy => 1, - builder => "_build_api" + default => sub { {} }, + traits => [qw/Hash/], + handles => { + all_tests => 'values' + }, + ); + + has 'active_test' + => ( + is => 'rw', + isa => 'Test::Irssi::Test', ); - method _build_api { - Test::Irssi::API->new(parent => $self); + sub new_test { + my ($self, $name, @params) = @_; + my $new = Test::Irssi::Test->new(name => $name, parent => $self); + $self->tests->{$name} = $new; } method _build_callback_obj { @@ -153,6 +162,12 @@ class Test::Irssi { $self->_logfile_fh->say($msg); } + method run_tests { + foreach my $test ($self->all_tests) { + $test->execute(); + } + } + method run { $self->_driver->setup; $self->_vt_setup; @@ -161,6 +176,13 @@ class Test::Irssi { $poe_kernel->run(); } + sub apply_delay { + my ($self, $delay, $next_index) = @_; + $poe_kernel->post(IrssiTestDriver + => create_delay + => $delay, $next_index); + } + sub inject_text { my ($self, $text) = @_; $poe_kernel->post(IrssiTestDriver => got_terminal_stdin diff --git a/testing/lib/Test/Irssi/API.pm b/testing/lib/Test/Irssi/API.pm deleted file mode 100644 index 3a659ed..0000000 --- a/testing/lib/Test/Irssi/API.pm +++ /dev/null @@ -1,80 +0,0 @@ -use strictures 1; -use MooseX::Declare; - -class Test::Irssi::API { - - use POE; - use Data::Dumper; - - has 'parent' - => ( - is => 'ro', - isa => 'Test::Irssi', - required => 1, - ); - - - has 'tests' - => ( - traits => [qw/Hash/], - is => 'rw', - isa => 'HashRef', - default => sub { {} }, - handles => { - test_names => 'keys', - }, - ); - - - sub create_test { - my ($self, $name, $desc) = @_; - $self->tests->{$name} = {desc => $desc, input => [], output => []}; - } - - sub simulate_input { - my ($self, $name, $input) = @_; - push @{ $self->tests->{$name}->{input} }, { input => $input }; - } - - sub simulate_delay { - my ($self, $name, $delay) = @_; - push @{ $self->tests->{$name}->{input} }, { delay => $delay }; - - } - - sub expect_output { - my ($self, $name, $regex, $line) = @_; # line is optional? - push @{ $self->tests->{$name}->{output} }, { regex => $regex, line => $line }; - } - - sub run_test { - my ($self, $test_name) = @_; - my $data = $self->tests->{$test_name}; - foreach my $entry (@{ $data->{input} }) { - if (exists $entry->{input}) { - my $text = $entry->{input}; - $self->parent->inject_text($text); - } elsif (exists $entry->{delay}) { - my $delay = $entry->{delay}; - _do_delay($delay); - } else { - die "What: " . Dumper($entry); - } - } - } - - sub run_tests { - my ($self) = @_; - foreach my $test_name ($self->test_names) { - my $test = $self->tests->{$test_name}; - print "Going to prcess: $test_name"; - print Dumper($test); - - } - } - - - sub _do_delay { - $poe_kernel->post('IrssiTestDriver' => create_delay => 5); - } -} diff --git a/testing/lib/Test/Irssi/Callbacks.pm b/testing/lib/Test/Irssi/Callbacks.pm index adceb65..9a8b583 100644 --- a/testing/lib/Test/Irssi/Callbacks.pm +++ b/testing/lib/Test/Irssi/Callbacks.pm @@ -107,7 +107,7 @@ sub vt_dump { sub log { my ($self, $msg) = @_; - $self->parent->_logfile_fh->say($msg); + #$self->parent->_logfile_fh->say($msg); } __PACKAGE__->meta->make_immutable; diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm index 9d39d44..7a20d91 100644 --- a/testing/lib/Test/Irssi/Driver.pm +++ b/testing/lib/Test/Irssi/Driver.pm @@ -130,9 +130,11 @@ sub setup { { _start => 'START', _stop => 'STOP', + got_sigchld => 'CHILD', + got_terminal_stdin => 'terminal_stdin', got_child_stdout => 'child_stdout', - got_sigchld => 'CHILD', + got_delay => 'timer_expired', create_delay => 'timer_created', testing_ready => 'start_tests', @@ -148,16 +150,21 @@ sub setup { sub start_tests { my ($self) = $_[OBJECT]; - $self->parent->api->run_test('test1'); + $self->log("Starting to run tests"); + $self->log("-" x 80); + $self->parent->run_tests(); } sub timer_created { - my ($heap, $kernel, $duration) = @_[HEAP, KERNEL, ARG0]; - $kernel->delay(got_delay => $duration, 0); + my ($self, $heap, $kernel, $duration) = @_[OBJECT, HEAP, KERNEL, ARG0]; + $kernel->delay(got_delay => $duration); + $self->log("Timer created"); } sub timer_expired { - die "Timer Expired"; + my ($self, $data) = @_[OBJECT,ARG0]; + $self->log("Timeout invoking test again."); + $self->parent->active_test->resume_from_timer; } sub save_term_settings { diff --git a/testing/lib/Test/Irssi/Test.pm b/testing/lib/Test/Irssi/Test.pm index f1e217d..ca53739 100644 --- a/testing/lib/Test/Irssi/Test.pm +++ b/testing/lib/Test/Irssi/Test.pm @@ -3,8 +3,170 @@ use MooseX::Declare; class Test::Irssi::Test { - has 'items' + use Test::Irssi; + use Test::Irssi::Driver; + use feature qw/say/; + + has 'parent' + => ( + is => 'ro', + isa => 'Test::Irssi', + required => 1, + ); + has 'name' + => ( + is => 'ro', + isa => 'Str', + required => 1, + ); + + has 'description' + => ( + is => 'rw', + isa => 'Str', + default => '', + ); + + has 'states' + => ( + is => 'ro', + isa => 'ArrayRef', + traits => [qw/Array/], + default => sub { [] }, + lazy => 1, + handles => { + add_state => 'push', + state_count => 'count', + get_state => 'get', + }, + ); + + has 'results' + => ( + is => 'ro', + isa => 'ArrayRef', + default => sub { [] }, + ); + + has '_next_state' => ( - + is => 'rw', + isa => 'Int', + default => 0, + traits => [qw/Counter/], + handles => { + _increment_state_counter => 'inc', + _clear_state => 'reset', + }, ); -}c + + + method add_input_sequence(Str $input) { + $self->add_state({input => $input }); + $self->log("Adding $input as input"); + } + + method add_delay (Num $delay) { + $self->add_state({delay => $delay }); + $self->log("Adding $delay as delay"); + + } + + sub add_pattern_match { + my ($self, $pattern, $constraints) = @_; + $self->add_state({output => 1, + pattern => $expected, + constraints => $constraints}); + + $self->log("Adding $expected as output match "); + } + + sub add_evaluation_function { + my ($self, $coderef) = @_; + $self->add_state({code => $coderef}); + } + + method process_next_state { + my $state_num = $self->_next_state; + $self->log("PNS: $state_num"); + my $state = $self->states->[$state_num]; + + my $return = 0; + + + $self->_next_state($state_num+1); + if ($self->has_next_state) { + $self->log("Has another state"); + } else { + $self->log("Has no more state"); + + return 2; + } + + return $return; + } + + sub check_output { + my ($self, $pattern) = @_; + say "All Goodn\n\n"; + } + + sub get_next_state { + my ($self) = @_; + my $item = $self->get_state($self->_next_state); + $self->_increment_state_counter; + + return $item; + } + + sub execute { + my ($self) = @_; + # set this as hte currently active test. + $self->parent->active_test($self); + $self->evaluate_test; + } + + sub evaluate_test { + + my ($self) = @_; + $self->log("Eval Test:"); + while (my $state = $self->get_next_state) { + if ( exists($state->{delay})) { + $self->parent->apply_delay($state->{delay}); + return; + } else { + + if (exists $state->{input}) { + $self->parent->inject_text($state->{input}); + $self->log("input: ". $state->{input}); + } + + if (exists $state->{code}) { + my @args = ($self, $self->parent, $self->parent->vt); + my $ret = $state->{code}->(@args); + + if (exists $state->{output}) { + my $pattern = $state->{pattern}; + $self->check_output($pattern); + } + + } + } + $self->log("Execution Finished"); + } + + sub resume_from_timer { + my ($self) = @_; + $self->log("Resuming after timeout"); + $self->evaluate_test; + } + sub log { + my ($self, $msg) = @_; + $self->parent->_logfile_fh->say($msg); + } + +} + + + + __END__ diff --git a/testing/test.pl b/testing/test.pl index 5d2c1dd..3940116 100755 --- a/testing/test.pl +++ b/testing/test.pl @@ -8,20 +8,32 @@ use feature qw/say/; use lib 'blib/lib'; use Test::Irssi; -use Test::Irssi::API; -my $test = Test::Irssi->new +my $tester = Test::Irssi->new (irssi_binary => "/opt/stow/repo/irssi-debug/bin/irssi", irssi_homedir => $ENV{HOME} . "/projects/tmp/test/irssi-debug"); say "Created test instance"; -my $api = $test->api; -$api->create_test('test1', 'bacon'); -$api->simulate_input("test1", "/echo This is a test\n"); -$api->simulate_delay("test1", 0.5); -$api->expect_output("test1", qr/is a test/); -$api->run_tests; -$test->run; +my $test = $tester->new_test('test1'); + +$test->add_input_sequence("/echo Hello\n"); +$test->add_delay(2); +$test->add_input_sequence("/echo Hello Again\n"); +for (1..10) { + $test->add_input_sequence($_); + $test->add_delay(0.2); +} + +#$test->add_input_sequence("This is\x0acursor movement\x0a"); +# $test->add_delay(5); + $test->add_input_sequence("\n"); + + $test->add_input_sequence("/clear\n"); +# $test->add_expected_output("Hello"); + + + +$tester->run; |