From 71c173db56f8e462fbaa8c0472788c04982478db Mon Sep 17 00:00:00 2001 From: Tom Feist 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/Test/Irssi.pm') 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 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 +++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 64 insertions(+), 9 deletions(-) (limited to 'testing/lib/Test/Irssi.pm') 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 -- cgit v1.2.3 From 2dc34ae882623c06117a5fd63bb71dfdacf9c765 Mon Sep 17 00:00:00 2001 From: Tom Feist 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 ++++++++++++++++++++++---------- 1 file changed, 22 insertions(+), 10 deletions(-) (limited to 'testing/lib/Test/Irssi.pm') 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 -- cgit v1.2.3 From 754328bfe7acbc9409fd4d38340d76aabf96845c Mon Sep 17 00:00:00 2001 From: Tom Feist 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 +++++++++++++++++++++++++++++----------------- 1 file changed, 89 insertions(+), 52 deletions(-) (limited to 'testing/lib/Test/Irssi.pm') 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__ -- cgit v1.2.3 From bf563d29e40e6bb6cb9732b4457e633468a8c6c2 Mon Sep 17 00:00:00 2001 From: Tom Feist 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 +++++++++++++++++++++++++++++++--------- 1 file changed, 31 insertions(+), 9 deletions(-) (limited to 'testing/lib/Test/Irssi.pm') 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 -- cgit v1.2.3 From d1c4786397a692268e9d47c53af1feea3270b579 Mon Sep 17 00:00:00 2001 From: Tom Feist 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 +++++++++++++++++++++++++++++++++++++---------- 1 file changed, 54 insertions(+), 14 deletions(-) (limited to 'testing/lib/Test/Irssi.pm') 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 -- cgit v1.2.3 From 1063657c9145eed77b9228066488c91880093391 Mon Sep 17 00:00:00 2001 From: Tom Feist Date: Mon, 28 Feb 2011 00:32:04 +0000 Subject: refactor everything to make tests more test-like. --- testing/lib/Test/Irssi.pm | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) (limited to 'testing/lib/Test/Irssi.pm') 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__ -- cgit v1.2.3 From fa7b4c4482f718ffbcbfe580c37f9c2f2067ec43 Mon Sep 17 00:00:00 2001 From: Tom Feist Date: Mon, 28 Feb 2011 20:53:15 +0000 Subject: added other tests --- testing/lib/Test/Irssi.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'testing/lib/Test/Irssi.pm') 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"); } -- cgit v1.2.3 From bdcbcad70d9f5380b5be7c68dfdb2d0ef7365924 Mon Sep 17 00:00:00 2001 From: Tom Feist 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 ++++++++++++++++++++++++-------------- 1 file changed, 24 insertions(+), 14 deletions(-) (limited to 'testing/lib/Test/Irssi.pm') 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(); } } -- cgit v1.2.3 From 7ec10e516a04a05a85cb82b30a8f9982f13c6c90 Mon Sep 17 00:00:00 2001 From: Tom Feist 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/Test/Irssi.pm') 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 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 +++++++++++++++++++++++++++++++++-------------- 1 file changed, 48 insertions(+), 19 deletions(-) (limited to 'testing/lib/Test/Irssi.pm') 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); + } } -- cgit v1.2.3