From 41c95c731cae9d39468acce966ed3e14e39191cf Mon Sep 17 00:00:00 2001 From: Tom Feist 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/Test') 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