random checkin, thinks are a bit in flux and about to change greatly so I'm

checkpinting them

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;