aboutsummaryrefslogtreecommitdiffstats
path: root/testing/lib/Test
diff options
context:
space:
mode:
authorTom Feist <shabble@metavore.org>2011-02-26 02:54:03 +0000
committerTom Feist <shabble@metavore.org>2011-02-26 02:54:03 +0000
commitd1c4786397a692268e9d47c53af1feea3270b579 (patch)
treea91a8b5a03d837b0790287f3e6f1236da3b4041e /testing/lib/Test
parentlots of work moving things around so it mostly works. Hooray (diff)
downloadirssi-scripts-d1c4786397a692268e9d47c53af1feea3270b579.tar.gz
irssi-scripts-d1c4786397a692268e9d47c53af1feea3270b579.zip
random checkin, thinks are a bit in flux and about to change greatly so I'm
checkpinting them
Diffstat (limited to '')
-rw-r--r--testing/lib/Test/Irssi.pm68
-rw-r--r--testing/lib/Test/Irssi/Callbacks.pm7
-rw-r--r--testing/lib/Test/Irssi/Driver.pm48
-rw-r--r--testing/lib/Test/Irssi/Test.pm132
4 files changed, 195 insertions, 60 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 {