From 71c173db56f8e462fbaa8c0472788c04982478db Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Mon, 21 Feb 2011 01:58:22 +0000
Subject: start of makign this a proper module

---
 testing/lib/Test/Irssi.pm | 90 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 90 insertions(+)
 create mode 100644 testing/lib/Test/Irssi.pm

(limited to 'testing/lib')

diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm
new file mode 100644
index 0000000..cb350ee
--- /dev/null
+++ b/testing/lib/Test/Irssi.pm
@@ -0,0 +1,90 @@
+use strictures 1;
+use MooseX::Declare
+
+our $VERSION = 0.01;
+
+class Test::Irssi {
+
+    use Term::VT102;
+    use Term::Terminfo;
+    use feature qw/say switch/;
+    use Data::Dump;
+    use IO::File;
+
+    has 'irssi_binary'
+      => (
+          is => 'ro',
+          isa => 'Str',
+          required => 1,
+         );
+
+    has 'irssi_homedir'
+      => (
+          is => 'ro',
+          isa => 'Str',
+          required => 1,
+         );
+
+    has 'terminal_width'
+      => (
+          is => 'ro',
+          isa => 'Int',
+          required => 1,
+          default => 80,
+         );
+
+    has 'terminal_height'
+      => (
+          is => 'ro',
+          isa => 'Int',
+          required => 1,
+          default => 24,
+         );
+
+    has 'logfile'
+      => (
+          is => 'ro',
+          isa => 'Str',
+          required => 1,
+          default => 'irssi-test.log',
+         );
+
+    has '_logfile_fh'
+      => (
+          is => 'ro',
+          isa => 'IO::File',
+          required => 1,
+          lazy => 1,
+          builder => '_build_logfile_fh',
+         );
+
+
+    method _build_logfile_fh {
+        my $fh = IO::File->new($self->logfile, 'w');
+        die "Couldn't open $logfile for writing: $!" unless defined $fh;
+        $fh->autoflush(1);
+
+        return $fh;
+    }
+
+
+
+
+
+    method log (Str $msg) {
+        say $self->_logfile_fh $msg;
+    }
+}
+__END__
+
+=head1 NAME
+
+Test::Irssi
+
+=head1 ABSTRACT
+
+Abstract goes here
+
+=head1 SYNOPSIS
+
+blah blah blah
-- 
cgit v1.2.3


From 3916b2945123f211c40ccc19d876474ed3478950 Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Mon, 21 Feb 2011 03:42:44 +0000
Subject: moving a whole bunch of code around into a modular sort of thing. 
 Still a big WIP

---
 testing/lib/Test/Irssi.pm           |  73 ++++++++++++++---
 testing/lib/Test/Irssi/Callbacks.pm |   0
 testing/lib/Test/Irssi/Driver.pm    | 153 ++++++++++++++++++++++++++++++++++++
 3 files changed, 217 insertions(+), 9 deletions(-)
 create mode 100644 testing/lib/Test/Irssi/Callbacks.pm
 create mode 100644 testing/lib/Test/Irssi/Driver.pm

(limited to 'testing/lib')

diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm
index cb350ee..f4acb71 100644
--- a/testing/lib/Test/Irssi.pm
+++ b/testing/lib/Test/Irssi.pm
@@ -1,5 +1,5 @@
 use strictures 1;
-use MooseX::Declare
+use MooseX::Declare;
 
 our $VERSION = 0.01;
 
@@ -10,6 +10,12 @@ class Test::Irssi {
     use feature qw/say switch/;
     use Data::Dump;
     use IO::File;
+    use Test::Irssi::Driver;
+
+    # requires the latest pre-release POE from
+    # https://github.com/rcaputo/poe until a new release is...released.
+    use POE;
+
 
     has 'irssi_binary'
       => (
@@ -41,6 +47,15 @@ class Test::Irssi {
           default => 24,
          );
 
+    has 'vt'
+      => (
+          is => 'ro',
+          isa => 'Term::VT102',
+          required => 1,
+          lazy => 1,
+          builder => '_build_vt102',
+         );
+
     has 'logfile'
       => (
           is => 'ro',
@@ -58,9 +73,46 @@ class Test::Irssi {
           builder => '_build_logfile_fh',
          );
 
+    has '_driver'
+      => (
+          is => 'ro',
+          isa => 'Test::Irssi::Driver',
+          required => 1,
+          lazy => 1,
+          builder => '_build_driver',
+         );
+
+    method _build_driver {
+        my $drv = Test::Irssi::Driver->new(parent => $self);
+        return $drv;
+    }
+
+    method _build_vt102 {
+        my $rows = $self->terminal_height;
+        my $cols = $self->terminal_width;
+
+        my $vt = Term::VT102->new($cols, $rows);
+
+        # options
+        $vt->option_set(LINEWRAP => 1);
+        $vt->option_set(LFTOCRLF => 1);
+
+        # callbacks
+        $vt->callback_set(OUTPUT      => \&vt_output,    undef);
+        $vt->callback_set(ROWCHANGE   => \&vt_rowchange, undef);
+        $vt->callback_set(CLEAR       => \&vt_clear,     undef);
+        $vt->callback_set(SCROLL_DOWN => \&vt_scr_dn,    undef);
+        $vt->callback_set(SCROLL_UP   => \&vt_scr_up,    undef);
+        $vt->callback_set(GOTO        => \&vt_goto,      undef);
+
+        return $vt;
+    }
 
     method _build_logfile_fh {
-        my $fh = IO::File->new($self->logfile, 'w');
+
+        my $logfile = $self->logfile;
+
+        my $fh = IO::File->new($logfile, 'w');
         die "Couldn't open $logfile for writing: $!" unless defined $fh;
         $fh->autoflush(1);
 
@@ -68,22 +120,25 @@ class Test::Irssi {
     }
 
 
+    method log (Str $msg) {
+        $self->_logfile_fh->say($msg);
+    }
 
 
+    method run {
 
-    method log (Str $msg) {
-        say $self->_logfile_fh $msg;
+        ### Start a session to encapsulate the previous features.
+        $poe_kernel->run();
     }
 }
-__END__
 
-=head1 NAME
 
-Test::Irssi
 
-=head1 ABSTRACT
+__END__
+
+=head1 NAME
 
-Abstract goes here
+Test::Irssi - A cunning testing system for Irssi scripts
 
 =head1 SYNOPSIS
 
diff --git a/testing/lib/Test/Irssi/Callbacks.pm b/testing/lib/Test/Irssi/Callbacks.pm
new file mode 100644
index 0000000..e69de29
diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm
new file mode 100644
index 0000000..8aa547a
--- /dev/null
+++ b/testing/lib/Test/Irssi/Driver.pm
@@ -0,0 +1,153 @@
+use strictures 1;
+
+package Test::Irssi::Driver;
+
+use Moose;
+use MooseX::POE;
+use POE qw( Wheel::ReadWrite Wheel::Run Filter::Stream );
+use POSIX;
+
+has 'parent'
+  => (
+      is => 'ro',
+      isa => 'Test::Irssi',
+      required => 1,
+     );
+
+
+sub  START {
+    my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
+
+    $self->save_term_settings($heap);
+
+    # Set a signal handler.
+    $kernel->sig(CHLD => "got_sigchld");
+
+    $self->make_raw_terminal;
+
+    my @stdio_options =
+      (
+       InputHandle  => \*STDIN,
+       OutputHandle => \*STDOUT,
+       InputEvent   => "got_terminal_stdin",
+       Filter       => POE::Filter::Stream->new(),
+      );
+
+    # Start the terminal reader/writer.
+    $heap->{stdio} = POE::Wheel::ReadWrite->new(@stdio_options);
+
+    my $rows = $self->parent->terminal_height;
+    my $cols = $self->parent->terminal_width;
+
+    my @program_options =
+      (
+       Program     => $self->parent->irssi_binary,
+       ProgramArgs => ['--noconnect', '--home=' . $self->parent->irssi_homedir ],
+       Conduit     => "pty",
+       Winsize     => [$rows, $cols, 0, 0],
+       StdoutEvent => "got_child_stdout",
+       StdioFilter => POE::Filter::Stream->new(),
+      );
+
+    # Start the asynchronous child process.
+    $heap->{program} = POE::Wheel::Run->new(@program_options);
+}
+
+
+
+sub STOP {
+    my ($self, $heap) = @_[OBJECT,HEAP];
+    $heap->{stdin_tio}->setattr (0, TCSANOW);
+    $heap->{stdout_tio}->setattr(1, TCSANOW);
+    $heap->{stderr_tio}->setattr(2, TCSANOW);
+    $self->_logfile_fh->close();
+}
+
+### Handle terminal STDIN.  Send it to the background program's STDIN.
+### If the user presses ^C, then echo a little string
+
+sub handle_terminal_stdin {
+    my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0];
+    if ($input =~ m/\003/g) {
+        $input = "/echo I like cakes\n";
+    } elsif ($input =~ m/\004/g) {
+        $self->log( vt_dump());
+    }
+    $heap->{program}->put($input);
+}
+##
+### Handle STDOUT from the child program.
+sub handle_child_stdout {
+    my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0];
+    # process via vt
+    $self->parent->vt->process($input);
+    # send to terminal
+    $heap->{stdio}->put($input);
+}
+
+### Handle SIGCHLD.  Shut down if the exiting child process was the
+### one we've been managing.
+
+sub  CHILD {
+    my ($self, $heap, $child_pid) = @_[OBJECT, HEAP, ARG1];
+    if ($child_pid == $heap->{program}->PID) {
+        delete $heap->{program};
+        delete $heap->{stdio};
+    }
+    return 0;
+}
+
+sub bacon { 
+    POE::Session->create
+        (
+         inline_states => {
+                           _start             => \&handle_start,
+                           _stop              => \&handle_stop,
+                           got_terminal_stdin => \&handle_terminal_stdin,
+                           got_child_stdout   => \&handle_child_stdout,
+                           got_sigchld        => \&handle_sigchld,
+                          },
+        );
+}
+
+sub save_term_settings {
+    my ($self, $heap) = @_;
+    # Save the original terminal settings so they can be restored later.
+    $heap->{stdin_tio} = POSIX::Termios->new();
+    $heap->{stdin_tio}->getattr(0);
+    $heap->{stdout_tio} = POSIX::Termios->new();
+    $heap->{stdout_tio}->getattr(1);
+    $heap->{stderr_tio} = POSIX::Termios->new();
+    $heap->{stderr_tio}->getattr(2);
+}
+
+
+sub make_raw_terminal {
+    my ($self) = @_;
+    # Put the terminal into raw input mode.  Otherwise discrete
+    # keystrokes will not be read immediately.
+    my $tio = POSIX::Termios->new();
+    $tio->getattr(0);
+    my $lflag = $tio->getlflag;
+    $lflag &= ~(ECHO | ECHOE | ECHOK | ECHONL | ICANON | IEXTEN | ISIG);
+    $tio->setlflag($lflag);
+    my $iflag = $tio->getiflag;
+    $iflag &= ~(BRKINT | INPCK | ISTRIP | IXON);
+    $tio->setiflag($iflag);
+    my $cflag = $tio->getcflag;
+    $cflag &= ~(CSIZE | PARENB);
+    $tio->setcflag($cflag);
+    $tio->setattr(0, TCSANOW);
+}
+
+sub log {
+    my ($self, $msg) = @_;
+    my $fh = $self->parent->_logfile_fh;
+    $fh->say($msg);
+}
+
+
+__PACKAGE__->meta->make_immutable;
+
+no Moose;
+
-- 
cgit v1.2.3


From 2dc34ae882623c06117a5fd63bb71dfdacf9c765 Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Mon, 21 Feb 2011 06:07:22 +0000
Subject: mostly working except for callback handling. Removed original
 auto-testing script. Started work on some more tests

---
 testing/lib/Test/Irssi.pm           |  32 ++++++----
 testing/lib/Test/Irssi/Callbacks.pm | 113 ++++++++++++++++++++++++++++++++++++
 testing/lib/Test/Irssi/Driver.pm    |  89 ++++++++++++++++++++--------
 3 files changed, 199 insertions(+), 35 deletions(-)

(limited to 'testing/lib')

diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm
index f4acb71..be87dcf 100644
--- a/testing/lib/Test/Irssi.pm
+++ b/testing/lib/Test/Irssi.pm
@@ -11,9 +11,11 @@ class Test::Irssi {
     use Data::Dump;
     use IO::File;
     use Test::Irssi::Driver;
+    use Test::Irssi::Callbacks;
 
     # requires the latest pre-release POE from
     # https://github.com/rcaputo/poe until a new release is...released.
+    use lib $ENV{HOME} . "/projects/poe/lib";
     use POE;
 
 
@@ -82,6 +84,24 @@ class Test::Irssi {
           builder => '_build_driver',
          );
 
+    has '_callbacks'
+      => (
+          is => 'ro',
+          isa => 'Test::Irssi::Callbacks',
+          required => 1,
+          lazy => 1,
+          builder => '_build_callback_obj',
+         );
+
+    method _build_callback_obj {
+        my $cbo = Test::Irssi::Callbacks->new(parent => $self);
+
+        $self->log("Going to register vt callbacks");
+        $cbo->register_vt_callbacks;
+
+        return $cbo;
+    }
+
     method _build_driver {
         my $drv = Test::Irssi::Driver->new(parent => $self);
         return $drv;
@@ -97,13 +117,6 @@ class Test::Irssi {
         $vt->option_set(LINEWRAP => 1);
         $vt->option_set(LFTOCRLF => 1);
 
-        # callbacks
-        $vt->callback_set(OUTPUT      => \&vt_output,    undef);
-        $vt->callback_set(ROWCHANGE   => \&vt_rowchange, undef);
-        $vt->callback_set(CLEAR       => \&vt_clear,     undef);
-        $vt->callback_set(SCROLL_DOWN => \&vt_scr_dn,    undef);
-        $vt->callback_set(SCROLL_UP   => \&vt_scr_up,    undef);
-        $vt->callback_set(GOTO        => \&vt_goto,      undef);
 
         return $vt;
     }
@@ -126,14 +139,13 @@ class Test::Irssi {
 
 
     method run {
-
+        $self->_driver->setup();
+        $self->log("Driver setup complete");
         ### Start a session to encapsulate the previous features.
         $poe_kernel->run();
     }
 }
 
-
-
 __END__
 
 =head1 NAME
diff --git a/testing/lib/Test/Irssi/Callbacks.pm b/testing/lib/Test/Irssi/Callbacks.pm
index e69de29..eb33039 100644
--- a/testing/lib/Test/Irssi/Callbacks.pm
+++ b/testing/lib/Test/Irssi/Callbacks.pm
@@ -0,0 +1,113 @@
+use strictures 1;
+
+package Test::Irssi::Callbacks;
+
+use Moose;
+use Data::Dump qw/dump/;
+
+has 'parent'
+  => (
+      is       => 'ro',
+      isa      => 'Test::Irssi',
+      required => 1,
+     );
+
+sub register_vt_callbacks {
+    my ($self) = @_;
+
+    $self->log("Callbacks registered");
+    my $vt = $self->parent->vt;
+    # callbacks
+    $self->log("VT is " . ref($vt));
+
+    $vt->callback_set(OUTPUT      => sub { \&vt_output    }, $self);
+    $vt->callback_set(ROWCHANGE   => sub { \&vt_rowchange }, $self);
+    $vt->callback_set(CLEAR       => sub { \&vt_clear     }, $self);
+    $vt->callback_set(SCROLL_DOWN => sub { \&vt_scr_dn    }, $self);
+    $vt->callback_set(SCROLL_UP   => sub { \&vt_scr_up    }, $self);
+    $vt->callback_set(GOTO        => sub { \&vt_goto      }, $self);
+}
+
+sub vt_output {
+    my ($vt, $cb_name, $cb_data, $self) = @_;
+    $self->log( "OUTPUT: " . dump([@_[1..$#_]]));
+}
+
+sub vt_rowchange {
+    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+
+    $self->log("Type of param is: " . ref($_)) for (@_);
+
+    $arg1 //= '?';
+    $arg2 //= '?';
+
+    $self->log( "-" x 100);
+    $self->log( "Row $arg1 changed: ");
+
+    my $bottom_line = $vt->rows();
+
+    $self->log( "-" x 100);
+    $self->log( "Window Line");
+    $self->log( "-" x 100);
+    $self->log(  $vt->row_plaintext($bottom_line - 1));
+    $self->log( "-" x 100);
+    $self->log( "Prompt line");
+    $self->log( "-" x 100);
+    $self->log(  $vt->row_plaintext($bottom_line));
+
+}
+
+sub vt_clear {
+    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    $arg1 //= '?';
+    $arg2 //= '?';
+
+    $self->log( "VT Cleared");
+}
+
+sub vt_scr_dn {
+    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    $arg1 //= '?';
+    $arg2 //= '?';
+
+    $self->log( "Scroll Down");
+}
+
+sub vt_scr_up {
+    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    $arg1 //= '?';
+    $arg2 //= '?';
+
+    $self->log( "Scroll Up");
+}
+
+
+sub vt_goto {
+    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    $arg1 //= '?';
+    $arg2 //= '?';
+
+    $self->log( "Goto: $arg1, $arg2");
+}
+
+sub vt_dump {
+    my ($self) = @_;
+    my $vt = $self->parent->vt;
+    my $rows = $self->parent->terminal_height;
+    my $str = '';
+    for my $y (1..$rows) {
+        $str .= $vt->row_sgrtext($y) . "\n";
+    }
+
+    return $str;
+}
+
+sub log {
+    my ($self, $msg) = @_;
+    $self->parent->_logfile_fh->say($msg);
+}
+
+__PACKAGE__->meta->make_immutable;
+
+no Moose;
+
diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm
index 8aa547a..0ff90e9 100644
--- a/testing/lib/Test/Irssi/Driver.pm
+++ b/testing/lib/Test/Irssi/Driver.pm
@@ -3,14 +3,18 @@ use strictures 1;
 package Test::Irssi::Driver;
 
 use Moose;
-use MooseX::POE;
+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/;
+use Data::Dump qw/dump/;
 
 has 'parent'
   => (
-      is => 'ro',
-      isa => 'Test::Irssi',
+      is       => 'ro',
+      isa      => 'Test::Irssi',
       required => 1,
      );
 
@@ -18,6 +22,8 @@ has 'parent'
 sub  START {
     my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
 
+    $self->log("Start handler called");
+
     $self->save_term_settings($heap);
 
     # Set a signal handler.
@@ -32,10 +38,13 @@ sub  START {
        InputEvent   => "got_terminal_stdin",
        Filter       => POE::Filter::Stream->new(),
       );
+    $self->log("stdio options: " . dump(@stdio_options));
 
     # Start the terminal reader/writer.
     $heap->{stdio} = POE::Wheel::ReadWrite->new(@stdio_options);
 
+    $self->log("Created stdio wheel");
+
     my $rows = $self->parent->terminal_height;
     my $cols = $self->parent->terminal_width;
 
@@ -49,35 +58,47 @@ sub  START {
        StdioFilter => POE::Filter::Stream->new(),
       );
 
+    $self->log("wheel options: " . dump(@program_options));
+
     # Start the asynchronous child process.
     $heap->{program} = POE::Wheel::Run->new(@program_options);
-}
 
+    $self->log("Created child run wheel");
 
+}
 
 sub STOP {
     my ($self, $heap) = @_[OBJECT,HEAP];
-    $heap->{stdin_tio}->setattr (0, TCSANOW);
-    $heap->{stdout_tio}->setattr(1, TCSANOW);
-    $heap->{stderr_tio}->setattr(2, TCSANOW);
-    $self->_logfile_fh->close();
+    $self->log("STOP called");
+    $self->restore_term_settings($heap);
+    $self->parent->_logfile_fh->close();
 }
 
 ### Handle terminal STDIN.  Send it to the background program's STDIN.
 ### If the user presses ^C, then echo a little string
 
-sub handle_terminal_stdin {
+sub terminal_stdin {
     my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0];
+
     if ($input =~ m/\003/g) {
         $input = "/echo I like cakes\n";
-    } elsif ($input =~ m/\004/g) {
-        $self->log( vt_dump());
+    } elsif ($input =~ m/\005/g) {
+        $self->log( $self->vt_dump());
+    } elsif ($input =~ m/\x17/g) {
+        $input = "/quit\n";
     }
+
     $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 handle_child_stdout {
+sub child_stdout {
     my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0];
     # process via vt
     $self->parent->vt->process($input);
@@ -85,10 +106,11 @@ sub handle_child_stdout {
     $heap->{stdio}->put($input);
 }
 
+
 ### Handle SIGCHLD.  Shut down if the exiting child process was the
 ### one we've been managing.
 
-sub  CHILD {
+sub CHILD {
     my ($self, $heap, $child_pid) = @_[OBJECT, HEAP, ARG1];
     if ($child_pid == $heap->{program}->PID) {
         delete $heap->{program};
@@ -97,17 +119,27 @@ sub  CHILD {
     return 0;
 }
 
-sub bacon { 
-    POE::Session->create
-        (
-         inline_states => {
-                           _start             => \&handle_start,
-                           _stop              => \&handle_stop,
-                           got_terminal_stdin => \&handle_terminal_stdin,
-                           got_child_stdout   => \&handle_child_stdout,
-                           got_sigchld        => \&handle_sigchld,
-                          },
-        );
+sub setup {
+    my $self = shift;
+
+    my @states =
+      (
+       object_states =>
+       [ $self =>
+         {
+          _start => 'START',
+          _stop  => 'STOP',
+          got_terminal_stdin => 'terminal_stdin',
+          got_child_stdout   => 'child_stdout',
+          got_sigchld        => 'CHILD',
+         }
+       ]
+      );
+    $self->log("creating root session");
+
+    POE::Session->create(@states);
+    $self->log("session created");
+
 }
 
 sub save_term_settings {
@@ -121,6 +153,13 @@ sub save_term_settings {
     $heap->{stderr_tio}->getattr(2);
 }
 
+sub restore_term_settings {
+    my ($self, $heap) = @_;
+
+    $heap->{stdin_tio}->setattr (0, TCSANOW);
+    $heap->{stdout_tio}->setattr(1, TCSANOW);
+    $heap->{stderr_tio}->setattr(2, TCSANOW);
+}
 
 sub make_raw_terminal {
     my ($self) = @_;
-- 
cgit v1.2.3


From 754328bfe7acbc9409fd4d38340d76aabf96845c Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Thu, 24 Feb 2011 01:59:38 +0000
Subject: more work on testing system for irssi.  Most of the screenscraping
 now works, trying to finalise an API for actual testing usage.

---
 testing/lib/Test/Irssi.pm              | 141 +++++++++++++++++++++------------
 testing/lib/Test/Irssi/API.pm          |  80 +++++++++++++++++++
 testing/lib/Test/Irssi/Callbacks.pm    |  41 +++++-----
 testing/lib/Test/Irssi/Driver.pm       |  32 ++++++--
 testing/lib/Test/Irssi/VirtualIrssi.pm |  32 ++++++++
 5 files changed, 248 insertions(+), 78 deletions(-)
 create mode 100644 testing/lib/Test/Irssi/API.pm
 create mode 100644 testing/lib/Test/Irssi/VirtualIrssi.pm

(limited to 'testing/lib')

diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm
index be87dcf..dbb2505 100644
--- a/testing/lib/Test/Irssi.pm
+++ b/testing/lib/Test/Irssi.pm
@@ -5,120 +5,125 @@ our $VERSION = 0.01;
 
 class Test::Irssi {
 
+    # requires the latest pre-release POE from
+    # https://github.com/rcaputo/poe until a new release is...released.
+    use lib $ENV{HOME} . "/projects/poe/lib";
+    use POE;
+
+
     use Term::VT102;
     use Term::Terminfo;
     use feature qw/say switch/;
     use Data::Dump;
     use IO::File;
+
     use Test::Irssi::Driver;
     use Test::Irssi::Callbacks;
+    use Test::Irssi::API;
+
 
-    # requires the latest pre-release POE from
-    # https://github.com/rcaputo/poe until a new release is...released.
-    use lib $ENV{HOME} . "/projects/poe/lib";
-    use POE;
 
 
     has 'irssi_binary'
       => (
-          is => 'ro',
-          isa => 'Str',
+          is       => 'ro',
+          isa      => 'Str',
           required => 1,
          );
 
     has 'irssi_homedir'
       => (
-          is => 'ro',
-          isa => 'Str',
+          is       => 'ro',
+          isa      => 'Str',
           required => 1,
          );
 
     has 'terminal_width'
       => (
-          is => 'ro',
-          isa => 'Int',
+          is       => 'ro',
+          isa      => 'Int',
           required => 1,
-          default => 80,
+          default  => 80,
          );
 
     has 'terminal_height'
       => (
-          is => 'ro',
-          isa => 'Int',
+          is       => 'ro',
+          isa      => 'Int',
           required => 1,
-          default => 24,
+          default  => 24,
          );
 
     has 'vt'
       => (
-          is => 'ro',
-          isa => 'Term::VT102',
+          is       => 'ro',
+          isa      => 'Term::VT102',
           required => 1,
-          lazy => 1,
-          builder => '_build_vt102',
+          lazy     => 1,
+          builder  => '_build_vt_obj',
          );
 
     has 'logfile'
       => (
-          is => 'ro',
-          isa => 'Str',
+          is       => 'ro',
+          isa      => 'Str',
           required => 1,
-          default => 'irssi-test.log',
+          default  => 'irssi-test.log',
          );
 
     has '_logfile_fh'
       => (
-          is => 'ro',
-          isa => 'IO::File',
+          is       => 'ro',
+          isa      => 'IO::File',
           required => 1,
-          lazy => 1,
-          builder => '_build_logfile_fh',
+          lazy     => 1,
+          builder  => '_build_logfile_fh',
          );
 
     has '_driver'
       => (
-          is => 'ro',
-          isa => 'Test::Irssi::Driver',
+          is       => 'ro',
+          isa      => 'Test::Irssi::Driver',
           required => 1,
-          lazy => 1,
-          builder => '_build_driver',
+          lazy     => 1,
+          builder  => '_build_driver_obj',
          );
 
     has '_callbacks'
+      => (
+          is       => 'ro',
+          isa      => 'Test::Irssi::Callbacks',
+          required => 1,
+          lazy     => 1,
+          builder  => '_build_callback_obj',
+         );
+
+    has 'api'
       => (
           is => 'ro',
-          isa => 'Test::Irssi::Callbacks',
+          isa => "Test::Irssi::API",
           required => 1,
           lazy => 1,
-          builder => '_build_callback_obj',
+          builder => "_build_api"
          );
 
-    method _build_callback_obj {
-        my $cbo = Test::Irssi::Callbacks->new(parent => $self);
-
-        $self->log("Going to register vt callbacks");
-        $cbo->register_vt_callbacks;
+    method _build_api {
+        Test::Irssi::API->new(parent => $self);
+    }
 
-        return $cbo;
+    method _build_callback_obj {
+        Test::Irssi::Callbacks->new(parent => $self);
     }
 
-    method _build_driver {
-        my $drv = Test::Irssi::Driver->new(parent => $self);
-        return $drv;
+    method _build_driver_obj {
+        Test::Irssi::Driver->new(parent => $self);
     }
 
-    method _build_vt102 {
+    method _build_vt_obj {
         my $rows = $self->terminal_height;
         my $cols = $self->terminal_width;
 
-        my $vt = Term::VT102->new($cols, $rows);
-
-        # options
-        $vt->option_set(LINEWRAP => 1);
-        $vt->option_set(LFTOCRLF => 1);
-
-
-        return $vt;
+        Term::VT102->new($cols, $rows);
     }
 
     method _build_logfile_fh {
@@ -132,18 +137,50 @@ class Test::Irssi {
         return $fh;
     }
 
+    method _vt_setup {
+         # options
+        my $vt = $self->vt;
+
+        $vt->option_set(LINEWRAP => 1);
+        $vt->option_set(LFTOCRLF => 1);
+
+        $self->_callbacks->register_callbacks;;
 
-    method log (Str $msg) {
-        $self->_logfile_fh->say($msg);
     }
 
+    sub log {
+        my ($self, $msg) = @_;
+        $self->_logfile_fh->say($msg);
+    }
 
     method run {
-        $self->_driver->setup();
+        $self->_driver->setup;
+        $self->_vt_setup;
         $self->log("Driver setup complete");
         ### Start a session to encapsulate the previous features.
         $poe_kernel->run();
     }
+
+    sub inject_text {
+        my ($self, $text) = @_;
+        $poe_kernel->post(IrssiTestDriver => got_terminal_stdin
+                          => $text);
+    }
+
+    sub simulate_keystroke {
+        my ($self, $text) = @_;
+        $poe_kernel->post(IrssiTestDriver => got_terminal_stdin
+                          => $text);
+
+    }
+
+    method get_prompt_line {
+        return $self->vt->row_plaintext($self->terminal_height)
+    }
+
+    method get_window_statusbar_line {
+        return $self->vt->row_plaintext($self->terminal_height() - 1)
+    }
 }
 
 __END__
diff --git a/testing/lib/Test/Irssi/API.pm b/testing/lib/Test/Irssi/API.pm
new file mode 100644
index 0000000..3a659ed
--- /dev/null
+++ b/testing/lib/Test/Irssi/API.pm
@@ -0,0 +1,80 @@
+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 eb33039..adceb65 100644
--- a/testing/lib/Test/Irssi/Callbacks.pm
+++ b/testing/lib/Test/Irssi/Callbacks.pm
@@ -4,6 +4,7 @@ package Test::Irssi::Callbacks;
 
 use Moose;
 use Data::Dump qw/dump/;
+use Data::Dumper;
 
 has 'parent'
   => (
@@ -12,31 +13,29 @@ has 'parent'
       required => 1,
      );
 
-sub register_vt_callbacks {
+sub register_callbacks {
     my ($self) = @_;
 
-    $self->log("Callbacks registered");
     my $vt = $self->parent->vt;
-    # callbacks
-    $self->log("VT is " . ref($vt));
-
-    $vt->callback_set(OUTPUT      => sub { \&vt_output    }, $self);
-    $vt->callback_set(ROWCHANGE   => sub { \&vt_rowchange }, $self);
-    $vt->callback_set(CLEAR       => sub { \&vt_clear     }, $self);
-    $vt->callback_set(SCROLL_DOWN => sub { \&vt_scr_dn    }, $self);
-    $vt->callback_set(SCROLL_UP   => sub { \&vt_scr_up    }, $self);
-    $vt->callback_set(GOTO        => sub { \&vt_goto      }, $self);
+    $self->log("Callbacks registered");
+
+    $vt->callback_set(OUTPUT      => sub { $self->vt_output(@_)    }, undef);
+    $vt->callback_set(ROWCHANGE   => sub { $self->vt_rowchange(@_) }, undef);
+    $vt->callback_set(CLEAR       => sub { $self->vt_clear(@_)     }, undef);
+    $vt->callback_set(SCROLL_DOWN => sub { $self->vt_scr_up(@_)    }, undef);
+    $vt->callback_set(SCROLL_UP   => sub { $self->vt_scr_dn(@_)    }, undef);
+    $vt->callback_set(GOTO        => sub { $self->vt_goto(@_)      }, undef);
+
 }
 
 sub vt_output {
-    my ($vt, $cb_name, $cb_data, $self) = @_;
+    my ($self, $vt, $cb_name, $cb_data) = @_;
     $self->log( "OUTPUT: " . dump([@_[1..$#_]]));
 }
 
 sub vt_rowchange {
-    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
-
-    $self->log("Type of param is: " . ref($_)) for (@_);
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
 
     $arg1 //= '?';
     $arg2 //= '?';
@@ -58,7 +57,8 @@ sub vt_rowchange {
 }
 
 sub vt_clear {
-    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
     $arg1 //= '?';
     $arg2 //= '?';
 
@@ -66,7 +66,8 @@ sub vt_clear {
 }
 
 sub vt_scr_dn {
-    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
     $arg1 //= '?';
     $arg2 //= '?';
 
@@ -74,7 +75,8 @@ sub vt_scr_dn {
 }
 
 sub vt_scr_up {
-    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
     $arg1 //= '?';
     $arg2 //= '?';
 
@@ -83,7 +85,8 @@ sub vt_scr_up {
 
 
 sub vt_goto {
-    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
     $arg1 //= '?';
     $arg2 //= '?';
 
diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm
index 0ff90e9..9d39d44 100644
--- a/testing/lib/Test/Irssi/Driver.pm
+++ b/testing/lib/Test/Irssi/Driver.pm
@@ -22,6 +22,8 @@ has 'parent'
 sub  START {
     my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
 
+    $kernel->alias_set("IrssiTestDriver");
+
     $self->log("Start handler called");
 
     $self->save_term_settings($heap);
@@ -64,7 +66,7 @@ sub  START {
     $heap->{program} = POE::Wheel::Run->new(@program_options);
 
     $self->log("Created child run wheel");
-
+    $poe_kernel->yield('testing_ready');
 }
 
 sub STOP {
@@ -80,11 +82,11 @@ sub STOP {
 sub terminal_stdin {
     my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0];
 
-    if ($input =~ m/\003/g) {
+    if ($input =~ m/\003/g) { # C-c
         $input = "/echo I like cakes\n";
-    } elsif ($input =~ m/\005/g) {
+    } elsif ($input =~ m/\005/g) { # C-e
         $self->log( $self->vt_dump());
-    } elsif ($input =~ m/\x17/g) {
+    } elsif ($input =~ m/\x17/g) { # C-w
         $input = "/quit\n";
     }
 
@@ -106,7 +108,6 @@ sub child_stdout {
     $heap->{stdio}->put($input);
 }
 
-
 ### Handle SIGCHLD.  Shut down if the exiting child process was the
 ### one we've been managing.
 
@@ -127,11 +128,14 @@ sub setup {
        object_states =>
        [ $self =>
          {
-          _start => 'START',
-          _stop  => 'STOP',
+          _start             => 'START',
+          _stop              => 'STOP',
           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',
          }
        ]
       );
@@ -142,6 +146,20 @@ sub setup {
 
 }
 
+sub start_tests {
+    my ($self) = $_[OBJECT];
+    $self->parent->api->run_test('test1');
+}
+
+sub timer_created {
+    my ($heap, $kernel, $duration) = @_[HEAP, KERNEL, ARG0];
+    $kernel->delay(got_delay => $duration, 0);
+}
+
+sub timer_expired {
+    die "Timer Expired";
+}
+
 sub save_term_settings {
     my ($self, $heap) = @_;
     # Save the original terminal settings so they can be restored later.
diff --git a/testing/lib/Test/Irssi/VirtualIrssi.pm b/testing/lib/Test/Irssi/VirtualIrssi.pm
new file mode 100644
index 0000000..dc3bfc7
--- /dev/null
+++ b/testing/lib/Test/Irssi/VirtualIrssi.pm
@@ -0,0 +1,32 @@
+use strictures 1;
+use MooseX::Declare;
+
+class Test::Irssi::VirtualIrssi {
+
+# class that pretends to be irssi which you can pull out various data from.
+
+
+has cursor
+ => (
+     is      => 'ro',
+     writer  => '_set_cursor',
+     isa     => 'ArrayRef[Int]',
+     default => sub { [0, 0] },
+    );
+
+has topic_row
+ => (
+    );
+
+has window_row
+ => (
+    );
+
+has prompt_row
+ => (
+    );
+
+has window
+ => (
+    );
+}
-- 
cgit v1.2.3


From dc13053a103da811280653a36bdd8f0604d8ff77 Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Sat, 26 Feb 2011 00:36:54 +0000
Subject: added T:I:T as the base object for creating tests with.

---
 testing/lib/Test/Irssi/Test.pm | 10 ++++++++++
 1 file changed, 10 insertions(+)
 create mode 100644 testing/lib/Test/Irssi/Test.pm

(limited to 'testing/lib')

diff --git a/testing/lib/Test/Irssi/Test.pm b/testing/lib/Test/Irssi/Test.pm
new file mode 100644
index 0000000..f1e217d
--- /dev/null
+++ b/testing/lib/Test/Irssi/Test.pm
@@ -0,0 +1,10 @@
+use strictures 1;
+use MooseX::Declare;
+
+class Test::Irssi::Test {
+
+    has 'items'
+      => (
+          
+         );
+}c
-- 
cgit v1.2.3


From bf563d29e40e6bb6cb9732b4457e633468a8c6c2 Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Sat, 26 Feb 2011 00:37:11 +0000
Subject: lots of work moving things around so it mostly works. Hooray

---
 testing/lib/Test/Irssi.pm           |  40 +++++++--
 testing/lib/Test/Irssi/API.pm       |  80 -----------------
 testing/lib/Test/Irssi/Callbacks.pm |   2 +-
 testing/lib/Test/Irssi/Driver.pm    |  17 ++--
 testing/lib/Test/Irssi/Test.pm      | 168 +++++++++++++++++++++++++++++++++++-
 5 files changed, 209 insertions(+), 98 deletions(-)
 delete mode 100644 testing/lib/Test/Irssi/API.pm

(limited to 'testing/lib')

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__
-- 
cgit v1.2.3


From d1c4786397a692268e9d47c53af1feea3270b579 Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Sat, 26 Feb 2011 02:54:03 +0000
Subject: random checkin, thinks are a bit in flux and about to change greatly
 so I'm checkpinting them

---
 testing/lib/Test/Irssi.pm           |  68 +++++++++++++++----
 testing/lib/Test/Irssi/Callbacks.pm |   7 ++
 testing/lib/Test/Irssi/Driver.pm    |  48 ++++++++++---
 testing/lib/Test/Irssi/Test.pm      | 132 ++++++++++++++++++++++++++----------
 4 files changed, 195 insertions(+), 60 deletions(-)

(limited to 'testing/lib')

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 });
@@ -70,45 +93,70 @@ class Test::Irssi::Test {
         $self->add_state({delay => $delay });
         $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 {
-- 
cgit v1.2.3


From 1063657c9145eed77b9228066488c91880093391 Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Mon, 28 Feb 2011 00:32:04 +0000
Subject: refactor everything to make tests more test-like.

---
 testing/lib/Test/Irssi.pm        | 29 +++++++++++++++++------------
 testing/lib/Test/Irssi/Driver.pm | 40 ++++++++++++++++++++++------------------
 testing/lib/Test/Irssi/Test.pm   | 14 +++++---------
 3 files changed, 44 insertions(+), 39 deletions(-)

(limited to 'testing/lib')

diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm
index 65e22b6..d776573 100644
--- a/testing/lib/Test/Irssi.pm
+++ b/testing/lib/Test/Irssi.pm
@@ -104,8 +104,9 @@ class Test::Irssi {
           default => sub { [] },
           traits => [qw/Array/],
           handles => {
-                      add_pending_test => 'push',
-                      next_pending_test => 'pop',
+                      add_pending_test  => 'push',
+                      next_pending_test => 'shift',
+                      tests_remaining   => 'count',
                      }
          );
 
@@ -130,7 +131,8 @@ class Test::Irssi {
     sub new_test {
         my ($self, $name, @params) = @_;
         my $new = Test::Irssi::Test->new(name => $name, parent => $self);
-        $self->add_pending_test, $new;
+        $self->add_pending_test($new);
+        return $new;
     }
 
     method _build_callback_obj {
@@ -170,17 +172,14 @@ class Test::Irssi {
 
     }
 
-    sub log {
-        my ($self, $msg) = @_;
-        $self->_logfile_fh->say($msg);
-    }
-
 
-    method run_test {
+    method complete_test {
         # put the completed one onto the completed pile
         my $old_test = $self->active_test;
         $self->add_completed_test($old_test);
+    }
 
+    method run_test {
         # and make the next pending one active.
         my $test = $self->next_pending_test;
         $self->active_test($test);
@@ -238,11 +237,17 @@ class Test::Irssi {
     }
 
     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");
+        foreach my $test ($self->completed_tests) {
+            my $name = $test->name;
+            printf("Test %s\t\t-\t%s\n", $name, $test->passed?"pass":"fail");
         }
     }
+
+  sub log {
+      my ($self, $msg) = @_;
+      $self->_logfile_fh->say($msg);
+  }
+
 }
 
   __END__
diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm
index 80199ef..3b6000b 100644
--- a/testing/lib/Test/Irssi/Driver.pm
+++ b/testing/lib/Test/Irssi/Driver.pm
@@ -39,6 +39,7 @@ sub  START {
        InputEvent   => "got_terminal_stdin",
        Filter       => POE::Filter::Stream->new(),
       );
+
     $self->log("stdio options: " . dump(@stdio_options));
 
     # Start the terminal reader/writer.
@@ -75,7 +76,7 @@ sub STOP {
     $self->parent->_logfile_fh->close();
 
     say "\n\n";
-    $self->parent->summarise_test_results();
+    #$self->parent->summarise_test_results();
 }
 
 ### Handle terminal STDIN.  Send it to the background program's STDIN.
@@ -161,32 +162,35 @@ sub testing_ready {
     # begin by fetching a test from the pending queue.
     $self->log("Starting to run tests");
     $self->log("-" x 80);
-    $self->parent->run_tests();
+    $self->parent->run_test;
+}
+
+sub execute_test {
+    my ($self, $heap, $kernel, $test) = @_[OBJECT,HEAP, KERNEL, ARG0];
+    # do some stuff here to evaluate it.
+
+    $test->evaluate_test;
+
 }
 
-sub testing_complete {
+sub test_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;
+
+    $self->parent->complete_test;
+
+    if ($self->parent->tests_remaining) {
+        $self->parent->run_test;
     }
+
+    # otherwise, we're done, and can shutdown.
+    #$kernel->yield('shutdown');
+
 }
 
 sub timer_created {
     my ($self, $heap, $kernel, $duration) = @_[OBJECT, HEAP, KERNEL, ARG0];
     $kernel->delay(got_delay => $duration);
-    $self->log("Timer created");
+    $self->log("Timer created for $duration");
 }
 
 sub timer_expired {
diff --git a/testing/lib/Test/Irssi/Test.pm b/testing/lib/Test/Irssi/Test.pm
index 45e9bb1..7ee511f 100644
--- a/testing/lib/Test/Irssi/Test.pm
+++ b/testing/lib/Test/Irssi/Test.pm
@@ -7,6 +7,7 @@ class Test::Irssi::Test {
     use Test::Irssi;
     use Test::Irssi::Driver;
     use feature qw/say/;
+    use Data::Dump qw/dump/;
 
     has 'parent'
       => (
@@ -167,17 +168,11 @@ class Test::Irssi::Test {
         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) = @_;
         while (my $state = $self->get_next_state) {
+            $self->log("Evaluating Test: " . dump($state));
 
             # stimuli
             if ( exists($state->{delay})) {
@@ -208,11 +203,12 @@ class Test::Irssi::Test {
             }
 
         }
+
+        $poe_kernel->post(IrssiTestDriver => 'test_complete');
+
         $self->complete(1);
 
         $self->log("Test Execution Finished");
-
-        $poe_kernel->post('IrssiTestDriver' => 'test_complete');
     }
 
     sub resume_from_timer {
-- 
cgit v1.2.3


From fa7b4c4482f718ffbcbfe580c37f9c2f2067ec43 Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Mon, 28 Feb 2011 20:53:15 +0000
Subject: added other tests

---
 testing/lib/Test/Irssi.pm        | 2 +-
 testing/lib/Test/Irssi/Driver.pm | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

(limited to 'testing/lib')

diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm
index d776573..4e2030b 100644
--- a/testing/lib/Test/Irssi.pm
+++ b/testing/lib/Test/Irssi.pm
@@ -237,7 +237,7 @@ class Test::Irssi {
     }
 
     method summarise_test_results {
-        foreach my $test ($self->completed_tests) {
+        foreach my $test (@{$self->completed_tests}) {
             my $name = $test->name;
             printf("Test %s\t\t-\t%s\n", $name, $test->passed?"pass":"fail");
         }
diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm
index 3b6000b..1319f2a 100644
--- a/testing/lib/Test/Irssi/Driver.pm
+++ b/testing/lib/Test/Irssi/Driver.pm
@@ -76,7 +76,7 @@ sub STOP {
     $self->parent->_logfile_fh->close();
 
     say "\n\n";
-    #$self->parent->summarise_test_results();
+    $self->parent->summarise_test_results();
 }
 
 ### Handle terminal STDIN.  Send it to the background program's STDIN.
@@ -183,7 +183,7 @@ sub test_complete {
     }
 
     # otherwise, we're done, and can shutdown.
-    #$kernel->yield('shutdown');
+   #kernel->yield('shutdown');
 
 }
 
-- 
cgit v1.2.3


From ec8db9ad0414fcf118a24fecc68f42fb18f50557 Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Fri, 4 Mar 2011 02:03:26 +0000
Subject: Test::Irssi::Test - whitespace cleanup

---
 testing/lib/Test/Irssi/Test.pm | 35 ++++++++++++++++++++++-------------
 1 file changed, 22 insertions(+), 13 deletions(-)

(limited to 'testing/lib')

diff --git a/testing/lib/Test/Irssi/Test.pm b/testing/lib/Test/Irssi/Test.pm
index 7ee511f..9655ee4 100644
--- a/testing/lib/Test/Irssi/Test.pm
+++ b/testing/lib/Test/Irssi/Test.pm
@@ -31,39 +31,39 @@ class Test::Irssi::Test {
 
     has 'states'
       => (
-          is => 'ro',
-          isa => 'ArrayRef',
-          traits => [qw/Array/],
+          is      => 'ro',
+          isa     => 'ArrayRef',
+          traits  => [qw/Array/],
           default => sub { [] },
-          lazy => 1,
+          lazy    => 1,
           handles => {
-                      add_state => 'push',
+                      add_state   => 'push',
                       state_count => 'count',
-                      get_state => 'get',
+                      get_state   => 'get',
                      },
          );
 
     has 'results'
       => (
-          is => 'ro',
-          isa => 'ArrayRef',
+          is      => 'ro',
+          isa     => 'ArrayRef',
           default => sub { [] },
          );
 
     has 'complete'
       => (
-          is => 'rw',
-          isa => 'Bool',
+          is      => 'rw',
+          isa     => 'Bool',
           default => 0,
          );
 
 
     has '_next_state'
       => (
-          is => 'rw',
-          isa => 'Int',
+          is      => 'rw',
+          isa     => 'Int',
           default => 0,
-          traits => [qw/Counter/],
+          traits  => [qw/Counter/],
           handles => {
                       _increment_state_counter => 'inc',
                       _clear_state             => 'reset',
@@ -112,6 +112,15 @@ class Test::Irssi::Test {
         $self->log("Adding $pattern as output match ");
     }
 
+    sub add_cursor_position_test {
+        my ($self, $x, $y, $desc) = @_;
+        $self->add_state({output => 1,
+                          x => $x,
+                          y => $y,
+                          desc => $desc });
+        $self->log("Adding cursor [$x, $y] test ");
+
+    }
     sub add_evaluation_function {
         my ($self, $coderef, $desc) = @_;
         $self->add_state({code => $coderef, desc => $desc});
-- 
cgit v1.2.3


From bdcbcad70d9f5380b5be7c68dfdb2d0ef7365924 Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Fri, 4 Mar 2011 03:06:03 +0000
Subject: testing: cleaned up a lot of the testing logic. Subtests are now
 reported at the end.

---
 testing/lib/Test/Irssi.pm        |  38 +++++++-----
 testing/lib/Test/Irssi/Driver.pm |  14 ++++-
 testing/lib/Test/Irssi/Misc.pm   |  35 +++++++++++
 testing/lib/Test/Irssi/Test.pm   | 131 +++++++++++++++++++++++++++------------
 4 files changed, 163 insertions(+), 55 deletions(-)
 create mode 100644 testing/lib/Test/Irssi/Misc.pm

(limited to 'testing/lib')

diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm
index 4e2030b..72f69ed 100644
--- a/testing/lib/Test/Irssi.pm
+++ b/testing/lib/Test/Irssi.pm
@@ -78,7 +78,7 @@ class Test::Irssi {
           builder  => '_build_logfile_fh',
          );
 
-    has '_driver'
+    has 'driver'
       => (
           is       => 'ro',
           isa      => 'Test::Irssi::Driver',
@@ -98,12 +98,12 @@ class Test::Irssi {
 
     has 'pending_tests'
       => (
-          is => 'ro',
-          isa => "ArrayRef",
+          is       => 'ro',
+          isa      => "ArrayRef",
           required => 1,
-          default => sub { [] },
-          traits => [qw/Array/],
-          handles => {
+          default  => sub { [] },
+          traits   => [qw/Array/],
+          handles  => {
                       add_pending_test  => 'push',
                       next_pending_test => 'shift',
                       tests_remaining   => 'count',
@@ -112,12 +112,12 @@ class Test::Irssi {
 
     has 'completed_tests'
       => (
-          is => 'ro',
-          isa => "ArrayRef",
+          is       => 'ro',
+          isa      => "ArrayRef",
           required => 1,
-          default => sub { [] },
-          traits => [qw/Array/],
-          handles => {
+          default  => sub { [] },
+          traits   => [qw/Array/],
+          handles  => {
                       add_completed_test => 'push'
                      },
          );
@@ -168,11 +168,10 @@ class Test::Irssi {
         $vt->option_set(LINEWRAP => 1);
         $vt->option_set(LFTOCRLF => 1);
 
-        $self->_callbacks->register_callbacks;;
+        $self->_callbacks->register_callbacks;
 
     }
 
-
     method complete_test {
         # put the completed one onto the completed pile
         my $old_test = $self->active_test;
@@ -189,7 +188,7 @@ class Test::Irssi {
     }
 
     method run {
-        $self->_driver->setup;
+        $self->driver->setup;
         $self->_vt_setup;
         $self->log("Driver setup complete");
         ### Start a session to encapsulate the previous features.
@@ -203,6 +202,7 @@ class Test::Irssi {
                           => $delay, $next_index);
     }
 
+    # TODO: pick one.
     sub inject_text {
         my ($self, $text) = @_;
         $poe_kernel->post(IrssiTestDriver => got_terminal_stdin
@@ -236,10 +236,20 @@ class Test::Irssi {
         return $buf;
     }
 
+    method get_cursor_position {
+        return ($self->vt->x(), $self->vt->y());
+    }
+
+    method load_script {
+        my ($script_name) = @_;
+
+    }
+
     method summarise_test_results {
         foreach my $test (@{$self->completed_tests}) {
             my $name = $test->name;
             printf("Test %s\t\t-\t%s\n", $name, $test->passed?"pass":"fail");
+            $test->details();
         }
     }
 
diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm
index 1319f2a..81e4f28 100644
--- a/testing/lib/Test/Irssi/Driver.pm
+++ b/testing/lib/Test/Irssi/Driver.pm
@@ -17,6 +17,12 @@ has 'parent'
       required => 1,
      );
 
+has 'headless'
+  => (
+      is      => 'rw',
+      isa     => 'Bool',
+      default => 0,
+     );
 
 sub  START {
     my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
@@ -94,14 +100,16 @@ sub terminal_stdin {
     $heap->{program}->put($input);
 }
 
-
 ### Handle STDOUT from the child program.
 sub child_stdout {
     my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0];
     # process via vt
     $self->parent->vt->process($input);
-    # send to terminal
-    $heap->{stdio}->put($input);
+
+    if (not $self->headless) {
+        # send to terminal
+        $heap->{stdio}->put($input);
+    }
 }
 
 ### Handle SIGCHLD.  Shut down if the exiting child process was the
diff --git a/testing/lib/Test/Irssi/Misc.pm b/testing/lib/Test/Irssi/Misc.pm
new file mode 100644
index 0000000..a6339e0
--- /dev/null
+++ b/testing/lib/Test/Irssi/Misc.pm
@@ -0,0 +1,35 @@
+package Test::Irssi::Misc;
+use strictures 1;
+
+
+
+sub keycombo_to_code {
+    my ($key_combo) = @_;
+    my $output = '';
+    my $ctrl = 0;
+    my $meta = 0;
+    if ($key_combo =~ m/[cC](?:trl)?-(.+)/) {
+        $ctrl = 1;
+        _parse_rest($1);
+    }
+    if ($key_combo =~ m/[Mm](?:eta)?-(.+)/) {
+        $meta = 1;
+        _parse_rest($1);
+    }
+}
+
+sub _parse_key {
+    my ($rest) = @_;
+    my $special = {
+                   left => '',
+                   right => '',
+                   up => '',
+                   down => '',
+                   tab => '',
+                   space => '',
+                   spc => '',
+                  };
+}
+
+
+1;
diff --git a/testing/lib/Test/Irssi/Test.pm b/testing/lib/Test/Irssi/Test.pm
index 9655ee4..752a01d 100644
--- a/testing/lib/Test/Irssi/Test.pm
+++ b/testing/lib/Test/Irssi/Test.pm
@@ -15,6 +15,7 @@ class Test::Irssi::Test {
           isa      => 'Test::Irssi',
           required => 1,
          );
+
     has 'name'
       => (
           is       => 'ro',
@@ -73,57 +74,85 @@ class Test::Irssi::Test {
     # TODO: should only be valid when complete is set.
     sub passed {
         my $self = shift;
-        return grep { 1 || undef } @{ $self->results };
+        my $pass = 0;
+        foreach my $result (@{$self->results}) {
+            $pass = $result;
+        }
+        return $pass and $self->complete;
     }
 
     sub failed {
         my $self = shift;
-        return not $self->passed();
+        return not $self->passed;
     }
 
 
+    sub details {
+        my ($self) = shift;
+        my $state_count = $self->state_count;
+        for (0..$state_count-1) {
+            my $state  = $self->states->[$_];
+            my $result = $self->results->[$_];
+            say( "\t" . $state->{type} . " - " . $state->{desc} . " "
+              . " = " .( $result?"ok":"not ok"));
+        }
+    }
     ############# API FUNCTIONS ##########################################
 
 
     method add_input_sequence(Str $input) {
-        $self->add_state({input => $input });
+        $self->add_state({type  => 'command',
+                          input => $input,
+                          desc  => 'input'});
+
         $self->log("Adding $input as input");
     }
 
     method add_delay (Num $delay) {
-        $self->add_state({delay => $delay });
+        $self->add_state({type  => 'command',
+                          desc  => 'delay',
+                          delay => $delay });
         $self->log("Adding $delay as delay");
 
     }
+
     method add_keycode(Str $code) {
         my $input = $self->translate_keycode($code);
-        $self->add_state({input => $input });
+        $self->add_state({type  => 'command',
+                          desc  => 'input',
+                          input => $input });
         $self->log("Adding $input ($code) as input");
 
     }
 
     sub add_pattern_match {
         my ($self, $pattern, $constraints, $desc) = @_;
-        $self->add_state({output => 1,
-                          pattern => $pattern,
+        $self->add_state({type        => 'test',
+                          of          => 'pattern',
+                          pattern     => $pattern,
                           constraints => $constraints,
-                          desc => $desc});
+                          desc        => $desc});
 
         $self->log("Adding $pattern as output match ");
     }
 
-    sub add_cursor_position_test {
+    sub test_cursor_position {
         my ($self, $x, $y, $desc) = @_;
-        $self->add_state({output => 1,
-                          x => $x,
-                          y => $y,
+        $self->add_state({type => 'test',
+                          of   => 'cursor',
+                          x    => $x,
+                          y    => $y,
                           desc => $desc });
         $self->log("Adding cursor [$x, $y] test ");
 
     }
+
     sub add_evaluation_function {
         my ($self, $coderef, $desc) = @_;
-        $self->add_state({code => $coderef, desc => $desc});
+        $self->add_state({type => 'test',
+                          of   => 'function',
+                          code => $coderef,
+                          desc => $desc});
     }
 
     ############# END OF API FUNCTIONS ####################################
@@ -163,8 +192,10 @@ class Test::Irssi::Test {
         }
 
         if ($line =~ m/$pattern/) {
+            $self->log("Pattern $pattern passed");
             $self->results->[$self->this_state] = 1;
         } else {
+            $self->log("Pattern $pattern failed");
             $self->results->[$self->this_state] = 0;;
         }
     }
@@ -178,39 +209,62 @@ class Test::Irssi::Test {
     }
 
     sub evaluate_test {
-
         my ($self) = @_;
+
         while (my $state = $self->get_next_state) {
+
             $self->log("Evaluating Test: " . dump($state));
 
-            # stimuli
-            if ( exists($state->{delay})) {
-                $self->log("inserting delay");
-                $self->parent->apply_delay($state->{delay});
-                return;
-            }
+            my $type = $state->{type};
 
-            if (exists $state->{input}) {
-                $self->parent->inject_text($state->{input});
-                $self->log("input: ". $state->{input});
-            }
+            if ($type eq 'command') {
 
-            # 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->{delay})) {
+                    $self->log("inserting delay");
+                    $self->parent->apply_delay($state->{delay});
+                    $self->results->[$self->this_state] = 1;
+                    return;
+                }
 
-            if (exists $state->{output}) {
-                # pattern match evaluation
-                my $pattern = $state->{pattern};
-                $self->check_output($state);
-            }
+                if (exists $state->{input}) {
+                    $self->parent->inject_text($state->{input});
+                    $self->log("input: ". $state->{input});
+                }
+
+                # all commands are considered to succeed.
+                $self->results->[$self->this_state] = 1;
+
+            } elsif ($type eq 'test') {
 
+                my $test_type = $state->{of};
+
+                if ($test_type eq 'pattern') {
+                    my $pattern = $state->{pattern};
+                    $self->check_output($state);
+                }
+                if ($test_type eq 'cursor') {
+                    my ($curs_x, $curs_y) = $self->parent->get_cursor_position;
+
+                    my $ret = 0;
+                    if ($state->{x} == $curs_x and $state->{y} == $curs_y) {
+                        $ret = 1;
+                    }
+
+                    $self->results->[$self->this_state] = $ret;
+
+                }
+
+                if ($test_type eq 'function') {
+                    # 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;
+                }
+            } else {
+                # wtf?
+            }
         }
 
         $poe_kernel->post(IrssiTestDriver => 'test_complete');
@@ -230,6 +284,7 @@ class Test::Irssi::Test {
         $self->parent->_logfile_fh->say($msg);
     }
 
+  sub _all { $_ || return 0 for @_; 1 }
 }
 
 
-- 
cgit v1.2.3


From 7ec10e516a04a05a85cb82b30a8f9982f13c6c90 Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Fri, 4 Mar 2011 04:12:47 +0000
Subject: working with TAP::Harness

---
 testing/lib/Test/Irssi.pm | 24 +++++++++++++++++++-----
 1 file changed, 19 insertions(+), 5 deletions(-)

(limited to 'testing/lib')

diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm
index 72f69ed..f723285 100644
--- a/testing/lib/Test/Irssi.pm
+++ b/testing/lib/Test/Irssi.pm
@@ -1,7 +1,7 @@
 use strictures 1;
 use MooseX::Declare;
 
-our $VERSION = 0.01;
+our $VERSION = 0.02;
 
 class Test::Irssi {
 
@@ -10,7 +10,6 @@ class Test::Irssi {
     use lib $ENV{HOME} . "/projects/poe/lib";
     use POE;
 
-
     use Term::VT102;
     use Term::Terminfo;
     use feature qw/say switch/;
@@ -85,6 +84,9 @@ class Test::Irssi {
           required => 1,
           lazy     => 1,
           builder  => '_build_driver_obj',
+          handles  => {
+                       run_headless => 'headless',
+                      }
          );
 
     has '_callbacks'
@@ -118,7 +120,8 @@ class Test::Irssi {
           default  => sub { [] },
           traits   => [qw/Array/],
           handles  => {
-                      add_completed_test => 'push'
+                      add_completed_test => 'push',
+                      tests_completed => 'count',
                      },
          );
 
@@ -176,6 +179,12 @@ class Test::Irssi {
         # put the completed one onto the completed pile
         my $old_test = $self->active_test;
         $self->add_completed_test($old_test);
+
+        # TAP: print status.
+        my $tap = sprintf("%s %d - %s", $old_test->passed?'ok':'not ok',
+                          $self->tests_completed,
+                          $old_test->description);
+        say STDOUT $tap;
     }
 
     method run_test {
@@ -188,10 +197,15 @@ class Test::Irssi {
     }
 
     method run {
+
         $self->driver->setup;
         $self->_vt_setup;
         $self->log("Driver setup complete");
         ### Start a session to encapsulate the previous features.
+
+        # TAP: print number of tests.
+        print STDOUT "1.." . $self->tests_remaining . "\n";
+
         $poe_kernel->run();
     }
 
@@ -248,8 +262,8 @@ class Test::Irssi {
     method summarise_test_results {
         foreach my $test (@{$self->completed_tests}) {
             my $name = $test->name;
-            printf("Test %s\t\t-\t%s\n", $name, $test->passed?"pass":"fail");
-            $test->details();
+            #printf("Test %s\t\t-\t%s\n", $name, $test->passed?"pass":"fail");
+            #$test->details();
         }
     }
 
-- 
cgit v1.2.3


From 41c95c731cae9d39468acce966ed3e14e39191cf Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Fri, 4 Mar 2011 05:19:41 +0000
Subject: testing: mostly working TAP output, test.pl uses TAP::Harness to run
 tests.  now we just need some tests.

---
 testing/lib/Test/Irssi.pm        | 67 ++++++++++++++++++++++++++++------------
 testing/lib/Test/Irssi/Driver.pm |  5 +--
 testing/lib/Test/Irssi/Test.pm   | 30 +++++++++++++-----
 3 files changed, 74 insertions(+), 28 deletions(-)

(limited to 'testing/lib')

diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm
index f723285..0db7ee0 100644
--- a/testing/lib/Test/Irssi.pm
+++ b/testing/lib/Test/Irssi.pm
@@ -20,6 +20,13 @@ class Test::Irssi {
     use Test::Irssi::Callbacks;
     use Test::Irssi::Test;
 
+    has 'generate_tap'
+      => (
+          is       => 'rw',
+          isa      => 'Bool',
+          required => 1,
+          default  => 1,
+         );
 
     has 'irssi_binary'
       => (
@@ -106,10 +113,10 @@ class Test::Irssi {
           default  => sub { [] },
           traits   => [qw/Array/],
           handles  => {
-                      add_pending_test  => 'push',
-                      next_pending_test => 'shift',
-                      tests_remaining   => 'count',
-                     }
+                       add_pending_test  => 'push',
+                       next_pending_test => 'shift',
+                       tests_remaining   => 'count',
+                      }
          );
 
     has 'completed_tests'
@@ -120,9 +127,9 @@ class Test::Irssi {
           default  => sub { [] },
           traits   => [qw/Array/],
           handles  => {
-                      add_completed_test => 'push',
-                      tests_completed => 'count',
-                     },
+                       add_completed_test => 'push',
+                       tests_completed => 'count',
+                      },
          );
 
     has 'active_test'
@@ -133,7 +140,9 @@ class Test::Irssi {
 
     sub new_test {
         my ($self, $name, @params) = @_;
-        my $new = Test::Irssi::Test->new(name => $name, parent => $self);
+        my $new = Test::Irssi::Test->new(name => $name, 
+                                         parent => $self,
+                                         @params);
         $self->add_pending_test($new);
         return $new;
     }
@@ -174,6 +183,14 @@ class Test::Irssi {
         $self->_callbacks->register_callbacks;
 
     }
+    method screenshot {
+        my $data = '';
+        my $vt = $self->vt;
+        foreach my $row (1 .. $vt->rows) {
+            $data .= $vt->row_plaintext($row) . "\n";
+        }
+        return $data;
+    }
 
     method complete_test {
         # put the completed one onto the completed pile
@@ -181,10 +198,20 @@ class Test::Irssi {
         $self->add_completed_test($old_test);
 
         # TAP: print status.
-        my $tap = sprintf("%s %d - %s", $old_test->passed?'ok':'not ok',
-                          $self->tests_completed,
-                          $old_test->description);
-        say STDOUT $tap;
+        if ($self->generate_tap) {
+            my $pass = $old_test->passed;
+            my $tap = sprintf("%s %d - %s", $pass?'ok':'not ok',
+                              $self->tests_completed,
+                              $old_test->description);
+            say STDOUT $tap;
+            if (not $pass) {
+                $old_test->details;
+                $self->log("-------------------");
+                $self->log($self->screenshot);
+                $self->log("-------------------");
+
+            }
+        }
     }
 
     method run_test {
@@ -204,7 +231,9 @@ class Test::Irssi {
         ### Start a session to encapsulate the previous features.
 
         # TAP: print number of tests.
-        print STDOUT "1.." . $self->tests_remaining . "\n";
+        if ($self->generate_tap) {
+            print STDOUT "1.." . $self->tests_remaining . "\n";
+        }
 
         $poe_kernel->run();
     }
@@ -262,15 +291,15 @@ class Test::Irssi {
     method summarise_test_results {
         foreach my $test (@{$self->completed_tests}) {
             my $name = $test->name;
-            #printf("Test %s\t\t-\t%s\n", $name, $test->passed?"pass":"fail");
-            #$test->details();
+            printf("Test %s\t\t-\t%s\n", $name, $test->passed?"pass":"fail");
+            $test->details();
         }
     }
 
-  sub log {
-      my ($self, $msg) = @_;
-      $self->_logfile_fh->say($msg);
-  }
+    sub log {
+        my ($self, $msg) = @_;
+        $self->_logfile_fh->say($msg);
+    }
 
 }
 
diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm
index 81e4f28..6b4e5e5 100644
--- a/testing/lib/Test/Irssi/Driver.pm
+++ b/testing/lib/Test/Irssi/Driver.pm
@@ -81,8 +81,9 @@ sub STOP {
     $self->restore_term_settings($heap);
     $self->parent->_logfile_fh->close();
 
-    say "\n\n";
-    $self->parent->summarise_test_results();
+    if (not $self->parent->generate_tap) {
+        $self->parent->summarise_test_results();
+    }
 }
 
 ### Handle terminal STDIN.  Send it to the background program's STDIN.
diff --git a/testing/lib/Test/Irssi/Test.pm b/testing/lib/Test/Irssi/Test.pm
index 752a01d..cd0a6f9 100644
--- a/testing/lib/Test/Irssi/Test.pm
+++ b/testing/lib/Test/Irssi/Test.pm
@@ -93,7 +93,7 @@ class Test::Irssi::Test {
         for (0..$state_count-1) {
             my $state  = $self->states->[$_];
             my $result = $self->results->[$_];
-            say( "\t" . $state->{type} . " - " . $state->{desc} . " "
+            say( "#\t" . $state->{type} . " - " . $state->{desc} . " "
               . " = " .( $result?"ok":"not ok"));
         }
     }
@@ -102,6 +102,7 @@ class Test::Irssi::Test {
 
     method add_input_sequence(Str $input) {
         $self->add_state({type  => 'command',
+                          of    => 'input',
                           input => $input,
                           desc  => 'input'});
 
@@ -110,6 +111,7 @@ class Test::Irssi::Test {
 
     method add_delay (Num $delay) {
         $self->add_state({type  => 'command',
+                          of    => 'delay',
                           desc  => 'delay',
                           delay => $delay });
         $self->log("Adding $delay as delay");
@@ -124,6 +126,12 @@ class Test::Irssi::Test {
         $self->log("Adding $input ($code) as input");
 
     }
+    sub add_diag {
+        my ($self, $diag) = @_;
+        $self->add_state({type => 'command',
+                          of   => 'diag',
+                          desc => $diag });
+    }
 
     sub add_pattern_match {
         my ($self, $pattern, $constraints, $desc) = @_;
@@ -155,6 +163,7 @@ class Test::Irssi::Test {
                           desc => $desc});
     }
 
+
     ############# END OF API FUNCTIONS ####################################
 
 
@@ -191,6 +200,8 @@ class Test::Irssi::Test {
             $line = $self->parent->get_topic_line;
         }
 
+        $self->log("Testing pattern against: '$line'");
+
         if ($line =~ m/$pattern/) {
             $self->log("Pattern $pattern passed");
             $self->results->[$self->this_state] = 1;
@@ -218,19 +229,24 @@ class Test::Irssi::Test {
             my $type = $state->{type};
 
             if ($type eq 'command') {
+                my $subtype = $state->{of};
 
-                if (exists($state->{delay})) {
+                if ($subtype eq 'diag') {
+                    if ($self->parent->generate_tap) {
+                        say STDOUT '#' . $state->{desc};
+                    }
+                }
+                if ($subtype eq 'input') {
+                    $self->parent->inject_text($state->{input});
+                    $self->log("input: ". $state->{input});
+                }
+                if ($subtype eq 'delay') {
                     $self->log("inserting delay");
                     $self->parent->apply_delay($state->{delay});
                     $self->results->[$self->this_state] = 1;
                     return;
                 }
 
-                if (exists $state->{input}) {
-                    $self->parent->inject_text($state->{input});
-                    $self->log("input: ". $state->{input});
-                }
-
                 # all commands are considered to succeed.
                 $self->results->[$self->this_state] = 1;
 
-- 
cgit v1.2.3