testing: mostly working TAP output, test.pl uses TAP::Harness to run tests. now

we just need some tests.

5 files changed, 116 insertions, 43 deletions

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;
 
diff --git a/testing/tests/001-basic.t b/testing/tests/001-basic.t
index 4373855..60578d8 100755
--- a/testing/tests/001-basic.t
+++ b/testing/tests/001-basic.t
@@ -4,17 +4,19 @@ use strict;
 use warnings;
 
 use feature qw/say/;
-
-#use lib 'blib/lib';
-
 use Test::Irssi;
 
 my $tester = Test::Irssi->new
   (irssi_binary  => "/opt/stow/repo/irssi-debug/bin/irssi",
    irssi_homedir => $ENV{HOME} . "/projects/tmp/test/irssi-debug");
 
-say "Created test instance";
-$tester->run_headless(1);
+if (exists $ENV{IRSSI_TEST_HEADLESS} and $ENV{IRSSI_TEST_NOHEADLESS} == 1) {
+    $tester->run_headless(0);
+    $tester->generate_tap(0);
+} else {
+    $tester->run_headless(1);
+    $tester->generate_tap(1);
+}
 
 my $test = $tester->new_test('test1');
 $test->description("simple echo tests");
@@ -22,15 +24,17 @@ $test->description("simple echo tests");
 $test->add_input_sequence("/echo Hello cats\n");
 $test->add_delay(1);
 $test->add_input_sequence("/echo Hello Again\n");
-$test->add_input_sequence("this is a lang test");
-$test->add_pattern_match(qw/long/, 'prompt', 'prompt contains hello');
-$test->add_pattern_match(qw/longfdajkfd/, 'prompt', 'prompt contains hello');
+$test->add_input_sequence("this is a long test");
+$test->add_delay(0.5);
+$test->add_pattern_match(qr/long/, 'prompt', 'prompt contains long');
+$test->add_delay(1);
 
+$test->add_pattern_match(qr/this is a .*? test/, 'prompt', 'prompt matches');
 
 my $test2 = $tester->new_test('test2');
 $test2->description("cursor movement and deletion");
 
-$test2->add_delay(2);
+$test2->add_delay(1);
 $test2->add_input_sequence("\x01");
 $test2->add_delay(0.1);
 $test2->add_input_sequence("\x0b");
@@ -43,10 +47,4 @@ my $quit = $tester->new_test('quit');
 $quit->description('quitting');
 $quit->add_input_sequence("/quit\n");
 
-# for (1..10) {
-#     $test->add_input_sequence("\xff");
-#     $test->add_delay(0.1);
-    
-# }
-
 $tester->run;
diff --git a/testing/tests/002-cursor-test.t b/testing/tests/002-cursor-test.t
new file mode 100755
index 0000000..eb35170
--- /dev/null
+++ b/testing/tests/002-cursor-test.t
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use feature qw/say/;
+use Test::Irssi;
+
+my $tester = Test::Irssi->new
+  (irssi_binary  => "/opt/stow/repo/irssi-debug/bin/irssi",
+   irssi_homedir => $ENV{HOME} . "/projects/tmp/test/irssi-debug");
+
+if (exists $ENV{IRSSI_TEST_HEADLESS} and $ENV{IRSSI_TEST_NOHEADLESS} == 1) {
+    $tester->run_headless(0);
+    $tester->generate_tap(0);
+} else {
+    $tester->run_headless(1);
+    $tester->generate_tap(1);
+}
+
+my $test = $tester->new_test('test1');
+$test->description("simple echo tests");
+$test->add_diag("Testing 123");
+
+my $quit = $tester->new_test('quit');
+$quit->description('quitting');
+$quit->add_input_sequence("/quit\n");
+
+$tester->run;