diff options
| -rw-r--r-- | testing/lib/Test/Irssi.pm | 68 | ||||
| -rw-r--r-- | testing/lib/Test/Irssi/Callbacks.pm | 7 | ||||
| -rw-r--r-- | testing/lib/Test/Irssi/Driver.pm | 48 | ||||
| -rw-r--r-- | testing/lib/Test/Irssi/Test.pm | 132 | ||||
| -rwxr-xr-x | testing/test.pl | 12 |
5 files changed, 204 insertions, 63 deletions
diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm index a8ee49e..65e22b6 100644 --- a/testing/lib/Test/Irssi.pm +++ b/testing/lib/Test/Irssi.pm @@ -96,15 +96,28 @@ class Test::Irssi { builder => '_build_callback_obj', ); - has 'tests' + has 'pending_tests' => ( is => 'ro', - isa => "HashRef", + isa => "ArrayRef", required => 1, - default => sub { {} }, - traits => [qw/Hash/], + default => sub { [] }, + traits => [qw/Array/], handles => { - all_tests => 'values' + add_pending_test => 'push', + next_pending_test => 'pop', + } + ); + + has 'completed_tests' + => ( + is => 'ro', + isa => "ArrayRef", + required => 1, + default => sub { [] }, + traits => [qw/Array/], + handles => { + add_completed_test => 'push' }, ); @@ -117,7 +130,7 @@ class Test::Irssi { sub new_test { my ($self, $name, @params) = @_; my $new = Test::Irssi::Test->new(name => $name, parent => $self); - $self->tests->{$name} = $new; + $self->add_pending_test, $new; } method _build_callback_obj { @@ -147,7 +160,7 @@ class Test::Irssi { } method _vt_setup { - # options + # options my $vt = $self->vt; $vt->option_set(LINEWRAP => 1); @@ -162,10 +175,18 @@ class Test::Irssi { $self->_logfile_fh->say($msg); } - method run_tests { - foreach my $test ($self->all_tests) { - $test->execute(); - } + + method run_test { + # put the completed one onto the completed pile + my $old_test = $self->active_test; + $self->add_completed_test($old_test); + + # and make the next pending one active. + my $test = $self->next_pending_test; + $self->active_test($test); + + # signal to the driver to start executing it. + $poe_kernel->post(IrssiTestDriver => execute_test => $test); } method run { @@ -196,16 +217,35 @@ class Test::Irssi { } + method get_topic_line { + return $self->vt->row_plaintext(1); + } + method get_prompt_line { - return $self->vt->row_plaintext($self->terminal_height) + return $self->vt->row_plaintext($self->terminal_height); } method get_window_statusbar_line { - return $self->vt->row_plaintext($self->terminal_height() - 1) + return $self->vt->row_plaintext($self->terminal_height() - 1); + } + + method get_window_contents { + my $buf = ''; + for (2..$self->terminal_height() - 2) { + $buf .= $self->vt->row_plaintext($_); + } + return $buf; + } + + method summarise_test_results { + foreach my $t_name (sort keys %{$self->tests}) { + my $t_obj = $self->tests->{$t_name}; + printf("Test %s\t\t-\t%s\n", $t_name, $t_obj->passed?"pass":"fail"); + } } } -__END__ + __END__ =head1 NAME diff --git a/testing/lib/Test/Irssi/Callbacks.pm b/testing/lib/Test/Irssi/Callbacks.pm index 9a8b583..8321ace 100644 --- a/testing/lib/Test/Irssi/Callbacks.pm +++ b/testing/lib/Test/Irssi/Callbacks.pm @@ -114,3 +114,10 @@ __PACKAGE__->meta->make_immutable; no Moose; + + +# # delegate to Callbacks. +# sub vt_dump { +# my ($self) = @_; +# my $cb = $self->parent->_callbacks->vt_dump(); +# } diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm index 7a20d91..80199ef 100644 --- a/testing/lib/Test/Irssi/Driver.pm +++ b/testing/lib/Test/Irssi/Driver.pm @@ -5,7 +5,6 @@ package Test::Irssi::Driver; use Moose; use lib $ENV{HOME} . "/projects/poe/lib"; -#use MooseX::POE; use POE qw( Wheel::ReadWrite Wheel::Run Filter::Stream ); use POSIX; use feature qw/say/; @@ -74,6 +73,9 @@ sub STOP { $self->log("STOP called"); $self->restore_term_settings($heap); $self->parent->_logfile_fh->close(); + + say "\n\n"; + $self->parent->summarise_test_results(); } ### Handle terminal STDIN. Send it to the background program's STDIN. @@ -84,8 +86,6 @@ sub terminal_stdin { if ($input =~ m/\003/g) { # C-c $input = "/echo I like cakes\n"; - } elsif ($input =~ m/\005/g) { # C-e - $self->log( $self->vt_dump()); } elsif ($input =~ m/\x17/g) { # C-w $input = "/quit\n"; } @@ -93,11 +93,6 @@ sub terminal_stdin { $heap->{program}->put($input); } -# delegate to Callbacks. -sub vt_dump { - my ($self) = @_; - my $cb = $self->parent->_callbacks->vt_dump(); -} ### Handle STDOUT from the child program. sub child_stdout { @@ -111,6 +106,13 @@ sub child_stdout { ### Handle SIGCHLD. Shut down if the exiting child process was the ### one we've been managing. +sub shutdown { + my ($self, $heap, $kernel) = @_[OBJECT, HEAP, KERNEL]; + $self->log("Shutdown called"); + $heap->{program}->kill(15); + $kernel->alias_remove("IrssiTestDriver"); +} + sub CHILD { my ($self, $heap, $child_pid) = @_[OBJECT, HEAP, ARG1]; if ($child_pid == $heap->{program}->PID) { @@ -137,7 +139,13 @@ sub setup { got_delay => 'timer_expired', create_delay => 'timer_created', - testing_ready => 'start_tests', + + + testing_ready => 'testing_ready', + test_complete => 'test_complete', + execute_test => 'execute_test', + + shutdown => 'shutdown', } ] ); @@ -148,13 +156,33 @@ sub setup { } -sub start_tests { +sub testing_ready { my ($self) = $_[OBJECT]; + # begin by fetching a test from the pending queue. $self->log("Starting to run tests"); $self->log("-" x 80); $self->parent->run_tests(); } +sub testing_complete { + my ($self, $kernel) = @_[OBJECT, KERNEL]; + # make sure all tests have run to completion. + my $done = 1; + $self->log("Testing to see if we can quit: "); + foreach my $test ($self->parent->all_tests) { + if (not $test->complete) { + $self->log("\t" . $test->name . " is not complete"); + $done = 0; + } + } + if ($done) { + $kernel->yield('shutdown'); + } else { + # ??? + $self->parent->active_test->resume_from_timer; + } +} + sub timer_created { my ($self, $heap, $kernel, $duration) = @_[OBJECT, HEAP, KERNEL, ARG0]; $kernel->delay(got_delay => $duration); diff --git a/testing/lib/Test/Irssi/Test.pm b/testing/lib/Test/Irssi/Test.pm index ca53739..45e9bb1 100644 --- a/testing/lib/Test/Irssi/Test.pm +++ b/testing/lib/Test/Irssi/Test.pm @@ -3,6 +3,7 @@ use MooseX::Declare; class Test::Irssi::Test { + use POE; use Test::Irssi; use Test::Irssi::Driver; use feature qw/say/; @@ -48,6 +49,14 @@ class Test::Irssi::Test { default => sub { [] }, ); + has 'complete' + => ( + is => 'rw', + isa => 'Bool', + default => 0, + ); + + has '_next_state' => ( is => 'rw', @@ -60,6 +69,20 @@ class Test::Irssi::Test { }, ); + # TODO: should only be valid when complete is set. + sub passed { + my $self = shift; + return grep { 1 || undef } @{ $self->results }; + } + + sub failed { + my $self = shift; + return not $self->passed(); + } + + + ############# API FUNCTIONS ########################################## + method add_input_sequence(Str $input) { $self->add_state({input => $input }); @@ -71,44 +94,69 @@ class Test::Irssi::Test { $self->log("Adding $delay as delay"); } + method add_keycode(Str $code) { + my $input = $self->translate_keycode($code); + $self->add_state({input => $input }); + $self->log("Adding $input ($code) as input"); + + } sub add_pattern_match { - my ($self, $pattern, $constraints) = @_; + my ($self, $pattern, $constraints, $desc) = @_; $self->add_state({output => 1, - pattern => $expected, - constraints => $constraints}); + pattern => $pattern, + constraints => $constraints, + desc => $desc}); - $self->log("Adding $expected as output match "); + $self->log("Adding $pattern as output match "); } sub add_evaluation_function { - my ($self, $coderef) = @_; - $self->add_state({code => $coderef}); + my ($self, $coderef, $desc) = @_; + $self->add_state({code => $coderef, desc => $desc}); } - method process_next_state { - my $state_num = $self->_next_state; - $self->log("PNS: $state_num"); - my $state = $self->states->[$state_num]; + ############# END OF API FUNCTIONS #################################### - 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; + method translate_keycode(Str $code) { + my $seq = ''; + if ($code =~ m/M-([a-z])/i) { + $seq = "\x1b" . $1; + } elsif ($code =~ m/C-([a-z])/i) { + $seq = chr ( ord(lc $1) - 64 ); } + return $seq; + } - return $return; + method this_state { + return $self->_next_state - 1; } sub check_output { - my ($self, $pattern) = @_; - say "All Goodn\n\n"; + my ($self, $data) = @_; + + my ($pattern, $constraints) = ($data->{pattern}, $data->{constraints}); + + my $ok = 0; + my $line = ''; + if ($constraints eq 'prompt') { + $line = $self->parent->get_prompt_line; + } elsif ($constraints eq 'window_sbar') { + $line = $self->parent->get_window_statusbar_line; + } elsif ($constraints eq 'window') { + # NOTE: not actually a line. + $line = $self->parent->get_window_contents; + } elsif ($constraints eq 'topic') { + $line = $self->parent->get_topic_line; + } + + if ($line =~ m/$pattern/) { + $self->results->[$self->this_state] = 1; + } else { + $self->results->[$self->this_state] = 0;; + } } sub get_next_state { @@ -129,30 +177,42 @@ class Test::Irssi::Test { sub evaluate_test { my ($self) = @_; - $self->log("Eval Test:"); while (my $state = $self->get_next_state) { + + # stimuli if ( exists($state->{delay})) { + $self->log("inserting 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->{input}) { + $self->parent->inject_text($state->{input}); + $self->log("input: ". $state->{input}); + } - if (exists $state->{output}) { - my $pattern = $state->{pattern}; - $self->check_output($pattern); - } + # tests + if (exists $state->{code}) { + # code evaluation + my @args = ($self, $self->parent, $self->parent->vt); + my $ret = $state->{code}->(@args); + $ret //= 0; # ensure that undef failures are + # marked as such. + $self->results->[$self->this_state] = $ret; + } + if (exists $state->{output}) { + # pattern match evaluation + my $pattern = $state->{pattern}; + $self->check_output($state); } + } - $self->log("Execution Finished"); + $self->complete(1); + + $self->log("Test Execution Finished"); + + $poe_kernel->post('IrssiTestDriver' => 'test_complete'); } sub resume_from_timer { diff --git a/testing/test.pl b/testing/test.pl index 3940116..d505758 100755 --- a/testing/test.pl +++ b/testing/test.pl @@ -26,14 +26,20 @@ for (1..10) { $test->add_input_sequence($_); $test->add_delay(0.2); } +$test->add_evaluation_function(sub { 1 }, 'this should succeed'); +$test->add_pattern_match(qr/2345/, 'prompt', 'prompt contains numbers'); #$test->add_input_sequence("This is\x0acursor movement\x0a"); # $test->add_delay(5); - $test->add_input_sequence("\n"); +$test->add_input_sequence("\n"); - $test->add_input_sequence("/clear\n"); -# $test->add_expected_output("Hello"); +$test->add_input_sequence("/clear\n"); +my $test2 = $tester->new_test("Test2"); +$test2->add_input_sequence("hello"); +$test2->add_delay(5); +$test2->add_pattern_match(qr/hello/, 'prompt', 'hello'); + $tester->run; |