From 1e6f98e7d399163ac51b0bd10f9f6e1714163016 Mon Sep 17 00:00:00 2001 From: Tom Feist Date: Mon, 21 Feb 2011 00:54:59 +0000 Subject: moved testing into its own dir --- testing/auto-testing.pl | 214 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 214 insertions(+) create mode 100755 testing/auto-testing.pl (limited to 'testing') diff --git a/testing/auto-testing.pl b/testing/auto-testing.pl new file mode 100755 index 0000000..31a9e5e --- /dev/null +++ b/testing/auto-testing.pl @@ -0,0 +1,214 @@ + +package Test::Irssi; + +use warnings; +use strict; + +# for fixed version of P:W:R +use lib $ENV{HOME} . "/projects/poe/lib"; + +sub PROGRAM () { "/opt/stow/repo/irssi-debug/bin/irssi" } + +use POSIX; + +use POE qw( Wheel::ReadWrite Wheel::Run Filter::Stream ); + +use Term::VT102; +use Term::TermInfo; +use feature qw/say switch/; +use Data::Dumper; +use IO::File; + +my $logfile = "irssi.log"; +#open my $logfh, ">", $logfile or die "Couldn't open $logfile for writing: $!"; +my $logfh = IO::File->new($logfile, 'w'); + die "Couldn't open $logfile for writing: $!" unless defined $logfh; +$logfh->autoflush(1); + + +my $ti = Term::Terminfo->new(); + +my $vt = Term::VT102->new(rows => 24, cols => 80); + +$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); + +$vt->option_set(LINEWRAP => 1); +$vt->option_set(LFTOCRLF => 1); + +sub vt_output { + my ($vt, $cb_name, $cb_data, $priv_data) = @_; + say $logfh "OUTPUT: " . Dumper([@_[1..$#_]]); +} + + +sub vt_rowchange { + my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; + #say $logfh "ROWCHANGE: " . Dumper(\@_); + #say $logfh "Row $arg1 changed: "; + #say $logfh $vt->row_plaintext($arg1); + my $bottom_line = $vt->rows(); + say $logfh "-" x 100; + say $logfh "Window Line"; + say $logfh $vt->row_plaintext($bottom_line - 1); + say $logfh "-" x 100; + say $logfh "Prompt line"; + say $logfh $vt->row_plaintext($bottom_line); + say $logfh "-" x 100; + + # +# print $ti->getstr("clear"); + # print vt_dump(); + +} + +sub vt_clear { + my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; + say $logfh "VT Cleared"; +} +sub vt_scr_dn { + my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; + say $logfh "Scroll Down"; +} +sub vt_scr_up { + my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; + say $logfh "Scroll Up"; +} +sub vt_goto { + my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; + say $logfh "Goto: $arg1, $arg2"; +} + +sub vt_dump { + my $str = ''; + for my $y (1..24) { + $str .= $vt->row_sgrtext($y) . "\n"; + } + return $str; +} + +### Handle the _start event. This sets things in motion. +sub handle_start { + my ($kernel, $heap) = @_[KERNEL, HEAP]; + + save_term_settings($heap); + + # Set a signal handler. + $kernel->sig(CHLD => "got_sigchld"); + + make_raw(); + + # Start the terminal reader/writer. + $heap->{stdio} = POE::Wheel::ReadWrite->new( + InputHandle => \*STDIN, + OutputHandle => \*STDOUT, + InputEvent => "got_terminal_stdin", + Filter => POE::Filter::Stream->new(), + ); + + # Start the asynchronous child process. + $heap->{program} = POE::Wheel::Run->new( + Program => PROGRAM, + ProgramArgs => [qw/--noconnect/], + Conduit => "pty", + Winsize => [24, 80, 0, 0], + StdoutEvent => "got_child_stdout", + StdioFilter => POE::Filter::Stream->new(), + ); +} + +### Handle the _stop event. This restores the original terminal +### settings when we're done. That's very important. +sub handle_stop { + my $heap = $_[HEAP]; + $heap->{stdin_tio}->setattr (0, TCSANOW); + $heap->{stdout_tio}->setattr(1, TCSANOW); + $heap->{stderr_tio}->setattr(2, TCSANOW); + + $logfh->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 ($heap, $input) = @_[HEAP, ARG0]; + if ($input =~ m/\003/g) { + $input = "/echo I like cakes\n"; + } elsif ($input =~ m/\004/g) { + say $logfh vt_dump(); + } + $heap->{program}->put($input); +} +## +### Handle STDOUT from the child program. +sub handle_child_stdout { + my ($heap, $input) = @_[HEAP, ARG0]; + # process via vt + $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 handle_sigchld { + my ($heap, $child_pid) = @_[HEAP, ARG1]; + if ($child_pid == $heap->{program}->PID) { + delete $heap->{program}; + delete $heap->{stdio}; + } + return 0; +} + + +### Start a session to encapsulate the previous features. +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 make_raw { + + # 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 save_term_settings { + my ($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); +} + +### Start POE's main loop, which runs the session until it's done. +$poe_kernel->run(); +exit 0; -- cgit v1.2.3 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/Changes | 0 testing/MANIFEST | 8 +++++ testing/Makefile.PL | 30 ++++++++++++++++ testing/README | 0 testing/auto-testing.pl | 49 ++++++++++++++++---------- testing/lib/Test/Irssi.pm | 90 +++++++++++++++++++++++++++++++++++++++++++++++ testing/t/001-use.t | 25 +++++++++++++ 7 files changed, 183 insertions(+), 19 deletions(-) create mode 100644 testing/Changes create mode 100644 testing/MANIFEST create mode 100644 testing/Makefile.PL create mode 100644 testing/README create mode 100644 testing/lib/Test/Irssi.pm create mode 100755 testing/t/001-use.t (limited to 'testing') diff --git a/testing/Changes b/testing/Changes new file mode 100644 index 0000000..e69de29 diff --git a/testing/MANIFEST b/testing/MANIFEST new file mode 100644 index 0000000..8548d92 --- /dev/null +++ b/testing/MANIFEST @@ -0,0 +1,8 @@ +Makefile.PL +MANIFEST +README +Changes +t/001-use.t + + +lib/Test/Irssi.pm diff --git a/testing/Makefile.PL b/testing/Makefile.PL new file mode 100644 index 0000000..3312c95 --- /dev/null +++ b/testing/Makefile.PL @@ -0,0 +1,30 @@ +use strict; +use warnings; +use Cwd; +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. + +WriteMakefile( + NAME => 'Test::Irssi', + AUTHOR => 'shabble ', + VERSION_FROM => 'lib/Test/Irssi.pm', # finds $VERSION + ABSTRACT_FROM => 'lib/Test/Irssi.pm', + PL_FILES => {}, + # LIBS => ["-L/opt/local/lib -lcprops"], + # INC => "-I/opt/local/include/cprops", + PREREQ_PM => { + 'Test::More' => 0, + 'Carp' => 0, + 'MooseX::Declare' => 0, + 'IO::File' => 0, + 'Term::VT102' => 0, + 'Term::Terminfo' => 0, + 'strictures' => 0, + 'Data::Dump' => 0, + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + # clean => { + # FILES => 'CProps-Trie-* Trie.inl _Inline' + # }, + ); diff --git a/testing/README b/testing/README new file mode 100644 index 0000000..e69de29 diff --git a/testing/auto-testing.pl b/testing/auto-testing.pl index 31a9e5e..9f47b6c 100755 --- a/testing/auto-testing.pl +++ b/testing/auto-testing.pl @@ -1,5 +1,9 @@ -package Test::Irssi; + +#package Test::Irssi; + +# requires the latest pre-release POE from +# https://github.com/rcaputo/poe until a new release is...released. use warnings; use strict; @@ -8,6 +12,10 @@ use strict; use lib $ENV{HOME} . "/projects/poe/lib"; sub PROGRAM () { "/opt/stow/repo/irssi-debug/bin/irssi" } +sub IRSSI_HOME () { $ENV{HOME} . "/projects/tmp/test/irssi-debug" } + +sub ROWS () { 24 } +sub COLS () { 80 } use POSIX; @@ -20,25 +28,16 @@ use Data::Dumper; use IO::File; my $logfile = "irssi.log"; -#open my $logfh, ">", $logfile or die "Couldn't open $logfile for writing: $!"; my $logfh = IO::File->new($logfile, 'w'); die "Couldn't open $logfile for writing: $!" unless defined $logfh; + $logfh->autoflush(1); my $ti = Term::Terminfo->new(); +my $vt = Term::VT102->new(rows => ROWS, cols => COLS); -my $vt = Term::VT102->new(rows => 24, cols => 80); - -$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); - -$vt->option_set(LINEWRAP => 1); -$vt->option_set(LFTOCRLF => 1); +vt_configure_callbacks($vt); sub vt_output { my ($vt, $cb_name, $cb_data, $priv_data) = @_; @@ -60,10 +59,9 @@ sub vt_rowchange { say $logfh $vt->row_plaintext($bottom_line); say $logfh "-" x 100; - # -# print $ti->getstr("clear"); - # print vt_dump(); + # print $ti->getstr("clear"); + # print vt_dump(); } sub vt_clear { @@ -85,7 +83,7 @@ sub vt_goto { sub vt_dump { my $str = ''; - for my $y (1..24) { + for my $y (1..ROWS) { $str .= $vt->row_sgrtext($y) . "\n"; } return $str; @@ -113,9 +111,9 @@ sub handle_start { # Start the asynchronous child process. $heap->{program} = POE::Wheel::Run->new( Program => PROGRAM, - ProgramArgs => [qw/--noconnect/], + ProgramArgs => ['--noconnect', '--home=' . IRSSI_HOME ], Conduit => "pty", - Winsize => [24, 80, 0, 0], + Winsize => [ROWS, COLS, 0, 0], StdoutEvent => "got_child_stdout", StdioFilter => POE::Filter::Stream->new(), ); @@ -209,6 +207,19 @@ sub save_term_settings { $heap->{stderr_tio}->getattr(2); } +sub vt_configure_callbacks { + my ($vt) = @_; + $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); + # options + $vt->option_set(LINEWRAP => 1); + $vt->option_set(LFTOCRLF => 1); +} + ### Start POE's main loop, which runs the session until it's done. $poe_kernel->run(); exit 0; 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 diff --git a/testing/t/001-use.t b/testing/t/001-use.t new file mode 100755 index 0000000..60f1bb9 --- /dev/null +++ b/testing/t/001-use.t @@ -0,0 +1,25 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Test::More; +use Data::Dumper; + +BEGIN { + use_ok 'Test::Irssi'; +} + + +my $test = new_ok 'Test::Irssi'; +my @methods = qw/logfile terminal_height terminal_width irssi_homedir irssi_binary/; +can_ok($trie, @methodss); + +undef $test + +done_testing; + +__END__ + + + -- 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/MANIFEST | 6 +- testing/MANIFEST.SKIP | 9 +++ testing/auto-testing.pl | 130 ------------------------------ testing/lib/Test/Irssi.pm | 73 ++++++++++++++--- testing/lib/Test/Irssi/Callbacks.pm | 0 testing/lib/Test/Irssi/Driver.pm | 153 ++++++++++++++++++++++++++++++++++++ 6 files changed, 231 insertions(+), 140 deletions(-) create mode 100644 testing/MANIFEST.SKIP create mode 100644 testing/lib/Test/Irssi/Callbacks.pm create mode 100644 testing/lib/Test/Irssi/Driver.pm (limited to 'testing') diff --git a/testing/MANIFEST b/testing/MANIFEST index 8548d92..09749a9 100644 --- a/testing/MANIFEST +++ b/testing/MANIFEST @@ -1,8 +1,12 @@ Makefile.PL MANIFEST +MANIFEST.SKIP README Changes -t/001-use.t +t/001-use.t lib/Test/Irssi.pm +lib/Test/Irssi/Callbacks.pm + +auto-testing.pl \ No newline at end of file diff --git a/testing/MANIFEST.SKIP b/testing/MANIFEST.SKIP new file mode 100644 index 0000000..1bfcbf3 --- /dev/null +++ b/testing/MANIFEST.SKIP @@ -0,0 +1,9 @@ +.*\.git.* +pm_to_blib +.*\.old +.*\.bak +.*\.swp +blib/.* +^Makefile$ +\d+_local_ + diff --git a/testing/auto-testing.pl b/testing/auto-testing.pl index 9f47b6c..69a855e 100755 --- a/testing/auto-testing.pl +++ b/testing/auto-testing.pl @@ -2,9 +2,6 @@ #package Test::Irssi; -# requires the latest pre-release POE from -# https://github.com/rcaputo/poe until a new release is...released. - use warnings; use strict; @@ -17,10 +14,6 @@ sub IRSSI_HOME () { $ENV{HOME} . "/projects/tmp/test/irssi-debug" } sub ROWS () { 24 } sub COLS () { 80 } -use POSIX; - -use POE qw( Wheel::ReadWrite Wheel::Run Filter::Stream ); - use Term::VT102; use Term::TermInfo; use feature qw/say switch/; @@ -89,137 +82,14 @@ sub vt_dump { return $str; } -### Handle the _start event. This sets things in motion. -sub handle_start { - my ($kernel, $heap) = @_[KERNEL, HEAP]; - - save_term_settings($heap); - - # Set a signal handler. - $kernel->sig(CHLD => "got_sigchld"); - - make_raw(); - - # Start the terminal reader/writer. - $heap->{stdio} = POE::Wheel::ReadWrite->new( - InputHandle => \*STDIN, - OutputHandle => \*STDOUT, - InputEvent => "got_terminal_stdin", - Filter => POE::Filter::Stream->new(), - ); - - # Start the asynchronous child process. - $heap->{program} = POE::Wheel::Run->new( - Program => PROGRAM, - ProgramArgs => ['--noconnect', '--home=' . IRSSI_HOME ], - Conduit => "pty", - Winsize => [ROWS, COLS, 0, 0], - StdoutEvent => "got_child_stdout", - StdioFilter => POE::Filter::Stream->new(), - ); -} - -### Handle the _stop event. This restores the original terminal -### settings when we're done. That's very important. -sub handle_stop { - my $heap = $_[HEAP]; - $heap->{stdin_tio}->setattr (0, TCSANOW); - $heap->{stdout_tio}->setattr(1, TCSANOW); - $heap->{stderr_tio}->setattr(2, TCSANOW); - $logfh->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 ($heap, $input) = @_[HEAP, ARG0]; - if ($input =~ m/\003/g) { - $input = "/echo I like cakes\n"; - } elsif ($input =~ m/\004/g) { - say $logfh vt_dump(); - } - $heap->{program}->put($input); -} -## -### Handle STDOUT from the child program. -sub handle_child_stdout { - my ($heap, $input) = @_[HEAP, ARG0]; - # process via vt - $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 handle_sigchld { - my ($heap, $child_pid) = @_[HEAP, ARG1]; - if ($child_pid == $heap->{program}->PID) { - delete $heap->{program}; - delete $heap->{stdio}; - } - return 0; -} - - -### Start a session to encapsulate the previous features. -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 make_raw { - - # 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 save_term_settings { - my ($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 vt_configure_callbacks { my ($vt) = @_; - $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); - # options - $vt->option_set(LINEWRAP => 1); - $vt->option_set(LFTOCRLF => 1); } ### Start POE's main loop, which runs the session until it's done. -$poe_kernel->run(); exit 0; 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 e589c5008130742df8826cc6774e91a211892d6a Mon Sep 17 00:00:00 2001 From: Tom Feist Date: Mon, 21 Feb 2011 03:43:03 +0000 Subject: start of a test. Only checks if things load, but that's proving hard enogh so far. --- testing/t/001-use.t | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'testing') diff --git a/testing/t/001-use.t b/testing/t/001-use.t index 60f1bb9..6ebbb5a 100755 --- a/testing/t/001-use.t +++ b/testing/t/001-use.t @@ -11,11 +11,13 @@ BEGIN { } -my $test = new_ok 'Test::Irssi'; +my $test = new_ok 'Test::Irssi', + [irssi_binary => 'null', irssi_homedir => 'null']; + my @methods = qw/logfile terminal_height terminal_width irssi_homedir irssi_binary/; -can_ok($trie, @methodss); +can_ok($test, @methods); -undef $test +undef $test; done_testing; -- cgit v1.2.3 From 4d7fa7ffc33b3e227ef8721211eba76905587a01 Mon Sep 17 00:00:00 2001 From: Tom Feist Date: Mon, 21 Feb 2011 03:44:55 +0000 Subject: added a gitignore for generated stuff and other pointless cruft --- testing/.gitignore | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 testing/.gitignore (limited to 'testing') diff --git a/testing/.gitignore b/testing/.gitignore new file mode 100644 index 0000000..119fe08 --- /dev/null +++ b/testing/.gitignore @@ -0,0 +1,5 @@ +Makefile +Makefile.old +blib/ +irssi.log +pm_to_blib -- 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/auto-testing.pl | 95 ------------------------------ testing/lib/Test/Irssi.pm | 32 ++++++---- testing/lib/Test/Irssi/Callbacks.pm | 113 ++++++++++++++++++++++++++++++++++++ testing/lib/Test/Irssi/Driver.pm | 89 ++++++++++++++++++++-------- 4 files changed, 199 insertions(+), 130 deletions(-) delete mode 100755 testing/auto-testing.pl (limited to 'testing') diff --git a/testing/auto-testing.pl b/testing/auto-testing.pl deleted file mode 100755 index 69a855e..0000000 --- a/testing/auto-testing.pl +++ /dev/null @@ -1,95 +0,0 @@ - - -#package Test::Irssi; - -use warnings; -use strict; - -# for fixed version of P:W:R -use lib $ENV{HOME} . "/projects/poe/lib"; - -sub PROGRAM () { "/opt/stow/repo/irssi-debug/bin/irssi" } -sub IRSSI_HOME () { $ENV{HOME} . "/projects/tmp/test/irssi-debug" } - -sub ROWS () { 24 } -sub COLS () { 80 } - -use Term::VT102; -use Term::TermInfo; -use feature qw/say switch/; -use Data::Dumper; -use IO::File; - -my $logfile = "irssi.log"; -my $logfh = IO::File->new($logfile, 'w'); - die "Couldn't open $logfile for writing: $!" unless defined $logfh; - -$logfh->autoflush(1); - - -my $ti = Term::Terminfo->new(); -my $vt = Term::VT102->new(rows => ROWS, cols => COLS); - -vt_configure_callbacks($vt); - -sub vt_output { - my ($vt, $cb_name, $cb_data, $priv_data) = @_; - say $logfh "OUTPUT: " . Dumper([@_[1..$#_]]); -} - - -sub vt_rowchange { - my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; - #say $logfh "ROWCHANGE: " . Dumper(\@_); - #say $logfh "Row $arg1 changed: "; - #say $logfh $vt->row_plaintext($arg1); - my $bottom_line = $vt->rows(); - say $logfh "-" x 100; - say $logfh "Window Line"; - say $logfh $vt->row_plaintext($bottom_line - 1); - say $logfh "-" x 100; - say $logfh "Prompt line"; - say $logfh $vt->row_plaintext($bottom_line); - say $logfh "-" x 100; - - - # print $ti->getstr("clear"); - # print vt_dump(); -} - -sub vt_clear { - my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; - say $logfh "VT Cleared"; -} -sub vt_scr_dn { - my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; - say $logfh "Scroll Down"; -} -sub vt_scr_up { - my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; - say $logfh "Scroll Up"; -} -sub vt_goto { - my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; - say $logfh "Goto: $arg1, $arg2"; -} - -sub vt_dump { - my $str = ''; - for my $y (1..ROWS) { - $str .= $vt->row_sgrtext($y) . "\n"; - } - return $str; -} - - - - - - -sub vt_configure_callbacks { - my ($vt) = @_; -} - -### Start POE's main loop, which runs the session until it's done. -exit 0; 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 48df96665ec4b9e30469f7de2604578dae169f17 Mon Sep 17 00:00:00 2001 From: Tom Feist Date: Mon, 21 Feb 2011 06:08:19 +0000 Subject: added test and launcher script --- testing/t/002-init.t | 33 +++++++++++++++++++++++++++++++++ testing/test.pl | 18 ++++++++++++++++++ 2 files changed, 51 insertions(+) create mode 100755 testing/t/002-init.t create mode 100755 testing/test.pl (limited to 'testing') diff --git a/testing/t/002-init.t b/testing/t/002-init.t new file mode 100755 index 0000000..df61e1e --- /dev/null +++ b/testing/t/002-init.t @@ -0,0 +1,33 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Test::More; +use Data::Dumper; + +BEGIN { + use_ok 'Test::Irssi'; +} + + +my $test = new_ok 'Test::Irssi', + [irssi_binary => "/opt/stow/repo/irssi-debug/bin/irssi", + irssi_homedir => $ENV{HOME} . "/projects/tmp/test/irssi-debug"]; + +if (-f $test->logfile) { + ok(unlink $test->logfile, 'deleted old logfile'); +} + +my $drv = $test->_driver; +isa_ok($drv, 'Test::Irssi::Driver', 'driver created ok'); + +diag "Starting POE session"; +$test->run(); + +done_testing; + +__END__ + + + diff --git a/testing/test.pl b/testing/test.pl new file mode 100755 index 0000000..b062160 --- /dev/null +++ b/testing/test.pl @@ -0,0 +1,18 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use feature qw/say/; + +use lib 'blib/lib'; + +use Test::Irssi; + +my $test = 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"; + +$test->run; -- 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/MANIFEST | 5 +- 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 ++++++++ testing/test.pl | 9 +++ 7 files changed, 260 insertions(+), 80 deletions(-) create mode 100644 testing/lib/Test/Irssi/API.pm create mode 100644 testing/lib/Test/Irssi/VirtualIrssi.pm (limited to 'testing') diff --git a/testing/MANIFEST b/testing/MANIFEST index 09749a9..4d67b37 100644 --- a/testing/MANIFEST +++ b/testing/MANIFEST @@ -5,8 +5,9 @@ README Changes t/001-use.t +t/002-init.t lib/Test/Irssi.pm lib/Test/Irssi/Callbacks.pm - -auto-testing.pl \ No newline at end of file +lib/Test/Irssi/Driver.pm +lib/Test/Irssi/API.pm \ No newline at end of file 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 + => ( + ); +} diff --git a/testing/test.pl b/testing/test.pl index b062160..5d2c1dd 100755 --- a/testing/test.pl +++ b/testing/test.pl @@ -8,6 +8,7 @@ use feature qw/say/; use lib 'blib/lib'; use Test::Irssi; +use Test::Irssi::API; my $test = Test::Irssi->new (irssi_binary => "/opt/stow/repo/irssi-debug/bin/irssi", @@ -15,4 +16,12 @@ my $test = Test::Irssi->new say "Created test instance"; +my $api = $test->api; + +$api->create_test('test1', 'bacon'); +$api->simulate_input("test1", "/echo This is a test\n"); +$api->simulate_delay("test1", 0.5); +$api->expect_output("test1", qr/is a test/); + +$api->run_tests; $test->run; -- cgit v1.2.3 From dc13053a103da811280653a36bdd8f0604d8ff77 Mon Sep 17 00:00:00 2001 From: Tom Feist 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') 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 Date: Sat, 26 Feb 2011 00:37:11 +0000 Subject: lots of work moving things around so it mostly works. Hooray --- testing/MANIFEST | 2 +- 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 +++++++++++++++++++++++++++++++++++- testing/test.pl | 30 +++++-- 7 files changed, 231 insertions(+), 108 deletions(-) delete mode 100644 testing/lib/Test/Irssi/API.pm (limited to 'testing') diff --git a/testing/MANIFEST b/testing/MANIFEST index 4d67b37..1810c3e 100644 --- a/testing/MANIFEST +++ b/testing/MANIFEST @@ -10,4 +10,4 @@ t/002-init.t lib/Test/Irssi.pm lib/Test/Irssi/Callbacks.pm lib/Test/Irssi/Driver.pm -lib/Test/Irssi/API.pm \ No newline at end of file +lib/Test/Irssi/Test.pm \ No newline at end of file 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__ diff --git a/testing/test.pl b/testing/test.pl index 5d2c1dd..3940116 100755 --- a/testing/test.pl +++ b/testing/test.pl @@ -8,20 +8,32 @@ use feature qw/say/; use lib 'blib/lib'; use Test::Irssi; -use Test::Irssi::API; -my $test = Test::Irssi->new +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"; -my $api = $test->api; -$api->create_test('test1', 'bacon'); -$api->simulate_input("test1", "/echo This is a test\n"); -$api->simulate_delay("test1", 0.5); -$api->expect_output("test1", qr/is a test/); -$api->run_tests; -$test->run; +my $test = $tester->new_test('test1'); + +$test->add_input_sequence("/echo Hello\n"); +$test->add_delay(2); +$test->add_input_sequence("/echo Hello Again\n"); +for (1..10) { + $test->add_input_sequence($_); + $test->add_delay(0.2); +} + +#$test->add_input_sequence("This is\x0acursor movement\x0a"); +# $test->add_delay(5); + $test->add_input_sequence("\n"); + + $test->add_input_sequence("/clear\n"); +# $test->add_expected_output("Hello"); + + + +$tester->run; -- 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 +++++++++++++++---- testing/lib/Test/Irssi/Callbacks.pm | 7 ++ testing/lib/Test/Irssi/Driver.pm | 48 ++++++++++--- testing/lib/Test/Irssi/Test.pm | 132 ++++++++++++++++++++++++++---------- testing/test.pl | 12 +++- 5 files changed, 204 insertions(+), 63 deletions(-) (limited to 'testing') 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 { diff --git a/testing/test.pl b/testing/test.pl index 3940116..d505758 100755 --- a/testing/test.pl +++ b/testing/test.pl @@ -26,14 +26,20 @@ for (1..10) { $test->add_input_sequence($_); $test->add_delay(0.2); } +$test->add_evaluation_function(sub { 1 }, 'this should succeed'); +$test->add_pattern_match(qr/2345/, 'prompt', 'prompt contains numbers'); #$test->add_input_sequence("This is\x0acursor movement\x0a"); # $test->add_delay(5); - $test->add_input_sequence("\n"); +$test->add_input_sequence("\n"); - $test->add_input_sequence("/clear\n"); -# $test->add_expected_output("Hello"); +$test->add_input_sequence("/clear\n"); +my $test2 = $tester->new_test("Test2"); +$test2->add_input_sequence("hello"); +$test2->add_delay(5); +$test2->add_pattern_match(qr/hello/, 'prompt', 'hello'); + $tester->run; -- 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 +++++++++++++++++------------ testing/lib/Test/Irssi/Driver.pm | 40 ++++++++++++++++++++++------------------ testing/lib/Test/Irssi/Test.pm | 14 +++++--------- testing/test.pl | 6 +++--- 4 files changed, 47 insertions(+), 42 deletions(-) (limited to 'testing') 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 { diff --git a/testing/test.pl b/testing/test.pl index d505758..ea90e1c 100755 --- a/testing/test.pl +++ b/testing/test.pl @@ -19,8 +19,8 @@ say "Created test instance"; my $test = $tester->new_test('test1'); -$test->add_input_sequence("/echo Hello\n"); -$test->add_delay(2); +$test->add_input_sequence("/echo Hello cats\n"); +$test->add_delay(20); $test->add_input_sequence("/echo Hello Again\n"); for (1..10) { $test->add_input_sequence($_); @@ -37,7 +37,7 @@ $test->add_input_sequence("/clear\n"); my $test2 = $tester->new_test("Test2"); -$test2->add_input_sequence("hello"); +$test2->add_input_sequence("hello from twooooooo"); $test2->add_delay(5); $test2->add_pattern_match(qr/hello/, 'prompt', 'hello'); -- 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 +- testing/lib/Test/Irssi/Driver.pm | 4 ++-- testing/test2.pl | 38 ++++++++++++++++++++++++++++++++++++ testing/test3.pl | 42 ++++++++++++++++++++++++++++++++++++++++ 4 files changed, 83 insertions(+), 3 deletions(-) create mode 100755 testing/test2.pl create mode 100755 testing/test3.pl (limited to 'testing') 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'); } diff --git a/testing/test2.pl b/testing/test2.pl new file mode 100755 index 0000000..661e66b --- /dev/null +++ b/testing/test2.pl @@ -0,0 +1,38 @@ +#!/usr/bin/env perl + +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"); + +my $test = $tester->new_test('test2'); +$test->add_input_sequence("/echo 'Window one'\n"); +$test->add_delay(5); +$test->add_input_sequence("/window new hide\n"); +$test->add_input_sequence("/win 2\n"); +for (1..10) { + $test->add_input_sequence($_); + $test->add_delay(0.2); +} +$test->add_input_sequence("\x01/echo \x05\n"); +$test->add_delay(10); +$test->add_input_sequence("\x1b\x31"); +$test->add_delay(10); +#$test->add_input_sequence("This is\x0acursor movement\x0a"); +# $test->add_delay(5); + + + +# $test->add_expected_output("Hello"); + + + +$tester->run; diff --git a/testing/test3.pl b/testing/test3.pl new file mode 100755 index 0000000..1c783ac --- /dev/null +++ b/testing/test3.pl @@ -0,0 +1,42 @@ +#!/usr/bin/env perl + +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"; + +my $test = $tester->new_test('test1'); + +$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 long test"); +$test->add_pattern_match(qw/long/, 'prompt', 'prompt contains hello'); + +my $test2 = $tester->new_test('test2'); +$test2->add_delay(1); +$test2->add_input_sequence("\x01"); +$test2->add_delay(0.1); +$test2->add_input_sequence("\x0b"); +$test2->add_delay(0.1); +$test2->add_input_sequence("/clear\n"); +$test2->add_delay(0.1); +$test2->add_input_sequence("/echo moo\n"); + +# for (1..10) { +# $test->add_input_sequence("\xff"); +# $test->add_delay(0.1); + +# } + +$tester->run; -- cgit v1.2.3 From 6deca692390e63157de0f5682020d65e4e3567f7 Mon Sep 17 00:00:00 2001 From: Tom Feist Date: Tue, 1 Mar 2011 20:27:13 +0000 Subject: uberprompt: updated docs to clarify $uber variable, and polish help stirngs. --- testing/test-shim.pl | 114 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 114 insertions(+) create mode 100644 testing/test-shim.pl (limited to 'testing') diff --git a/testing/test-shim.pl b/testing/test-shim.pl new file mode 100644 index 0000000..628f7af --- /dev/null +++ b/testing/test-shim.pl @@ -0,0 +1,114 @@ +use strict; +use warnings; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; +use POSIX; +use Time::HiRes qw/sleep/; +use JSON::Any; + + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => 'test-shim', + description => '', + license => 'Public Domain', + ); + + +my $forked = 0; + +sub pipe_and_fork { + my ($read_handle, $write_handle); + pipe($read_handle, $write_handle); + + my $oldfh = select($write_handle); + $| = 1; + select $oldfh; + + return if $forked; + + my $pid = fork(); + + if (not defined $pid) { + _error("Can't fork: Aborting"); + close($read_handle); + close($write_handle); + return; + } + + $forked = 1; + + if ($pid > 0) { # this is the parent (Irssi) + close ($write_handle); + Irssi::pidwait_add($pid); + my $job = $pid; + my $tag; + my @args = ($read_handle, \$tag, $job); + $tag = Irssi::input_add(fileno($read_handle), + Irssi::INPUT_READ, + \&child_input, + \@args); + + } else { # child + child_process($write_handle); + close $write_handle; + + POSIX::_exit(1); + } +} +sub _cleanup_child { + my ($read_handle, $input_tag_ref) = @_; + close $read_handle; + Irssi::input_remove($$input_tag_ref); + _msg("child finished"); + $forked = 0; +} +sub child_input { + my $args = shift; + my ($read_handle, $input_tag_ref, $job) = @$args; + + my $input = <$read_handle>; + my $data = JSON::Any::jsonToObj($input); + if (ref $data ne 'HASH') { + _error("Invalid data received: $input"); + _cleanup_child($read_handle, $input_tag_ref); + } + + if (exists $data->{connection}) { + if ($data->{connection} eq 'close') { + _cleanup_child($read_handle, $input_tag_ref); + } + } else { + parent_process_response($data); + } +} + +sub parent_process_response { + my ($data) = @_; +} + + +sub child_process { + my ($handle) = @_; + +} + +sub _error { + my ($msg) = @_; + my $win = Irssi::active_win(); + $win->print($msg, Irssi::MSGLEVEL_CLIENTERROR); +} + +sub _msg { + my ($msg) = @_; + my $win = Irssi::active_win(); + $win->print($msg, Irssi::MSGLEVEL_CLIENTCRAP); +} + +Irssi::command_bind("start_pipes", \&pipe_and_fork); -- cgit v1.2.3 From ec8db9ad0414fcf118a24fecc68f42fb18f50557 Mon Sep 17 00:00:00 2001 From: Tom Feist 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') 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 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 +++++++++++++++++++++++++++------------ testing/test3.pl | 9 ++- 5 files changed, 170 insertions(+), 57 deletions(-) create mode 100644 testing/lib/Test/Irssi/Misc.pm (limited to 'testing') 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 } } diff --git a/testing/test3.pl b/testing/test3.pl index 1c783ac..57be5ed 100755 --- a/testing/test3.pl +++ b/testing/test3.pl @@ -20,11 +20,13 @@ my $test = $tester->new_test('test1'); $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 long test"); +$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'); + my $test2 = $tester->new_test('test2'); -$test2->add_delay(1); +$test2->add_delay(2); $test2->add_input_sequence("\x01"); $test2->add_delay(0.1); $test2->add_input_sequence("\x0b"); @@ -33,6 +35,9 @@ $test2->add_input_sequence("/clear\n"); $test2->add_delay(0.1); $test2->add_input_sequence("/echo moo\n"); +my $quit = $tester->new_test('quit'); +$quit->add_input_sequence("/quit\n"); + # for (1..10) { # $test->add_input_sequence("\xff"); # $test->add_delay(0.1); -- 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 +++++++++++++++++----- testing/t/002-init.t | 2 +- testing/test.pl | 46 ++++++++--------------------------------- testing/test2.pl | 38 ---------------------------------- testing/test3.pl | 47 ------------------------------------------ testing/tests/001-basic.t | 52 +++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 81 insertions(+), 128 deletions(-) delete mode 100755 testing/test2.pl delete mode 100755 testing/test3.pl create mode 100755 testing/tests/001-basic.t (limited to 'testing') 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(); } } diff --git a/testing/t/002-init.t b/testing/t/002-init.t index df61e1e..b688f9f 100755 --- a/testing/t/002-init.t +++ b/testing/t/002-init.t @@ -19,7 +19,7 @@ if (-f $test->logfile) { ok(unlink $test->logfile, 'deleted old logfile'); } -my $drv = $test->_driver; +my $drv = $test->driver; isa_ok($drv, 'Test::Irssi::Driver', 'driver created ok'); diag "Starting POE session"; diff --git a/testing/test.pl b/testing/test.pl index ea90e1c..bf01530 100755 --- a/testing/test.pl +++ b/testing/test.pl @@ -4,42 +4,14 @@ use strict; use warnings; use feature qw/say/; +#use lib 'blib/lib'; -use lib 'blib/lib'; +use TAP::Harness; +my $harness = TAP::Harness->new({ verbosity => 1, + lib => 'blib/lib', + color => 1, + }); -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"; - - - -my $test = $tester->new_test('test1'); - -$test->add_input_sequence("/echo Hello cats\n"); -$test->add_delay(20); -$test->add_input_sequence("/echo Hello Again\n"); -for (1..10) { - $test->add_input_sequence($_); - $test->add_delay(0.2); -} -$test->add_evaluation_function(sub { 1 }, 'this should succeed'); -$test->add_pattern_match(qr/2345/, 'prompt', 'prompt contains numbers'); - -#$test->add_input_sequence("This is\x0acursor movement\x0a"); -# $test->add_delay(5); -$test->add_input_sequence("\n"); - -$test->add_input_sequence("/clear\n"); - - -my $test2 = $tester->new_test("Test2"); -$test2->add_input_sequence("hello from twooooooo"); -$test2->add_delay(5); -$test2->add_pattern_match(qr/hello/, 'prompt', 'hello'); - - -$tester->run; +my @tests = glob($ARGV[0]); +say "Tests: " . join (", ", @tests); +$harness->runtests(@tests); diff --git a/testing/test2.pl b/testing/test2.pl deleted file mode 100755 index 661e66b..0000000 --- a/testing/test2.pl +++ /dev/null @@ -1,38 +0,0 @@ -#!/usr/bin/env perl - -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"); - -my $test = $tester->new_test('test2'); -$test->add_input_sequence("/echo 'Window one'\n"); -$test->add_delay(5); -$test->add_input_sequence("/window new hide\n"); -$test->add_input_sequence("/win 2\n"); -for (1..10) { - $test->add_input_sequence($_); - $test->add_delay(0.2); -} -$test->add_input_sequence("\x01/echo \x05\n"); -$test->add_delay(10); -$test->add_input_sequence("\x1b\x31"); -$test->add_delay(10); -#$test->add_input_sequence("This is\x0acursor movement\x0a"); -# $test->add_delay(5); - - - -# $test->add_expected_output("Hello"); - - - -$tester->run; diff --git a/testing/test3.pl b/testing/test3.pl deleted file mode 100755 index 57be5ed..0000000 --- a/testing/test3.pl +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/env perl - -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"; - -my $test = $tester->new_test('test1'); - -$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'); - - -my $test2 = $tester->new_test('test2'); -$test2->add_delay(2); -$test2->add_input_sequence("\x01"); -$test2->add_delay(0.1); -$test2->add_input_sequence("\x0b"); -$test2->add_delay(0.1); -$test2->add_input_sequence("/clear\n"); -$test2->add_delay(0.1); -$test2->add_input_sequence("/echo moo\n"); - -my $quit = $tester->new_test('quit'); -$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/001-basic.t b/testing/tests/001-basic.t new file mode 100755 index 0000000..4373855 --- /dev/null +++ b/testing/tests/001-basic.t @@ -0,0 +1,52 @@ +#!/usr/bin/env perl + +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); + +my $test = $tester->new_test('test1'); +$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'); + + +my $test2 = $tester->new_test('test2'); +$test2->description("cursor movement and deletion"); + +$test2->add_delay(2); +$test2->add_input_sequence("\x01"); +$test2->add_delay(0.1); +$test2->add_input_sequence("\x0b"); +$test2->add_delay(0.1); +$test2->add_input_sequence("/clear\n"); +$test2->add_delay(0.1); +$test2->add_input_sequence("/echo moo\n"); + +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; -- 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 ++++++++++++++++++++++++++++------------ testing/lib/Test/Irssi/Driver.pm | 5 +-- testing/lib/Test/Irssi/Test.pm | 30 +++++++++++++----- testing/tests/001-basic.t | 28 ++++++++--------- testing/tests/002-cursor-test.t | 29 +++++++++++++++++ 5 files changed, 116 insertions(+), 43 deletions(-) create mode 100755 testing/tests/002-cursor-test.t (limited to 'testing') 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; -- cgit v1.2.3 From 6374b67079740260ad8e7d6301f11c14dd9d90a3 Mon Sep 17 00:00:00 2001 From: Tom Feist Date: Fri, 4 Mar 2011 05:25:22 +0000 Subject: testing: adapted rudi's vim_mode insert test to new format. seems to work fine. --- testing/tests/003-vim-mode.t | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100755 testing/tests/003-vim-mode.t (limited to 'testing') diff --git a/testing/tests/003-vim-mode.t b/testing/tests/003-vim-mode.t new file mode 100755 index 0000000..a732f66 --- /dev/null +++ b/testing/tests/003-vim-mode.t @@ -0,0 +1,43 @@ +#!/usr/bin/env perl + +# Must be run in a 80x24 terminal unless a fixed POE is released. +use strict; +use warnings; + +use Test::Irssi; + +sub statusbar_mode { + my ($test, $mode) = @_; + + $test->add_pattern_match(qr/^ \[\d{2}:\d{2}\] \[\] \[1\] \[$mode\]\s+$/, + 'window_sbar', "[$mode] in vim-mode statusbar"); +} + +my $tester = Test::Irssi->new + (irssi_binary => "/opt/stow/repo/irssi-debug/bin/irssi", + irssi_homedir => $ENV{HOME} . "/projects/tmp/test/irssi-debug"); + +$tester->run_headless(1); +$tester->generate_tap(1); + +my $test = $tester->new_test('insert-command-mode'); +$test->description("switching between insert and command mode in vim_mode script"); + +# Make sure irssi is finished - not entirely sure why this is necessary. +$test->add_delay(2); + +# We start in insert mode. +statusbar_mode($test, 'Insert'); + +$test->add_input_sequence("\e"); +$test->add_delay(1); +statusbar_mode($test, 'Command'); + +$test->add_input_sequence("i"); +$test->add_delay(1); +statusbar_mode($test, 'Insert'); + +# Quit irssi, necessary to terminate the test. +$test->add_input_sequence("\n/quit\n"); + +$tester->run; -- cgit v1.2.3 From 5df2b67f2cbef974c59c5d91d1937ea6e99b3ae9 Mon Sep 17 00:00:00 2001 From: Simon Ruderich Date: Sat, 5 Mar 2011 02:49:58 +0100 Subject: vim-mode/tests.pl: Add first real tests: h l 0 ^ $ f t. Merge testing/tests/003-vim-mode.t with vim-mode/tests.pl and remove it from testing/. --- testing/tests/003-vim-mode.t | 43 ------------------------------------------- 1 file changed, 43 deletions(-) delete mode 100755 testing/tests/003-vim-mode.t (limited to 'testing') diff --git a/testing/tests/003-vim-mode.t b/testing/tests/003-vim-mode.t deleted file mode 100755 index a732f66..0000000 --- a/testing/tests/003-vim-mode.t +++ /dev/null @@ -1,43 +0,0 @@ -#!/usr/bin/env perl - -# Must be run in a 80x24 terminal unless a fixed POE is released. -use strict; -use warnings; - -use Test::Irssi; - -sub statusbar_mode { - my ($test, $mode) = @_; - - $test->add_pattern_match(qr/^ \[\d{2}:\d{2}\] \[\] \[1\] \[$mode\]\s+$/, - 'window_sbar', "[$mode] in vim-mode statusbar"); -} - -my $tester = Test::Irssi->new - (irssi_binary => "/opt/stow/repo/irssi-debug/bin/irssi", - irssi_homedir => $ENV{HOME} . "/projects/tmp/test/irssi-debug"); - -$tester->run_headless(1); -$tester->generate_tap(1); - -my $test = $tester->new_test('insert-command-mode'); -$test->description("switching between insert and command mode in vim_mode script"); - -# Make sure irssi is finished - not entirely sure why this is necessary. -$test->add_delay(2); - -# We start in insert mode. -statusbar_mode($test, 'Insert'); - -$test->add_input_sequence("\e"); -$test->add_delay(1); -statusbar_mode($test, 'Command'); - -$test->add_input_sequence("i"); -$test->add_delay(1); -statusbar_mode($test, 'Insert'); - -# Quit irssi, necessary to terminate the test. -$test->add_input_sequence("\n/quit\n"); - -$tester->run; -- cgit v1.2.3