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/Driver.pm | 14 ++++- testing/lib/Test/Irssi/Misc.pm | 35 +++++++++++ testing/lib/Test/Irssi/Test.pm | 131 +++++++++++++++++++++++++++------------ 3 files changed, 139 insertions(+), 41 deletions(-) create mode 100644 testing/lib/Test/Irssi/Misc.pm (limited to 'testing/lib/Test/Irssi') diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm index 1319f2a..81e4f28 100644 --- a/testing/lib/Test/Irssi/Driver.pm +++ b/testing/lib/Test/Irssi/Driver.pm @@ -17,6 +17,12 @@ has 'parent' required => 1, ); +has 'headless' + => ( + is => 'rw', + isa => 'Bool', + default => 0, + ); sub START { my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP]; @@ -94,14 +100,16 @@ sub terminal_stdin { $heap->{program}->put($input); } - ### Handle STDOUT from the child program. sub child_stdout { my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0]; # process via vt $self->parent->vt->process($input); - # send to terminal - $heap->{stdio}->put($input); + + if (not $self->headless) { + # send to terminal + $heap->{stdio}->put($input); + } } ### Handle SIGCHLD. Shut down if the exiting child process was the diff --git a/testing/lib/Test/Irssi/Misc.pm b/testing/lib/Test/Irssi/Misc.pm new file mode 100644 index 0000000..a6339e0 --- /dev/null +++ b/testing/lib/Test/Irssi/Misc.pm @@ -0,0 +1,35 @@ +package Test::Irssi::Misc; +use strictures 1; + + + +sub keycombo_to_code { + my ($key_combo) = @_; + my $output = ''; + my $ctrl = 0; + my $meta = 0; + if ($key_combo =~ m/[cC](?:trl)?-(.+)/) { + $ctrl = 1; + _parse_rest($1); + } + if ($key_combo =~ m/[Mm](?:eta)?-(.+)/) { + $meta = 1; + _parse_rest($1); + } +} + +sub _parse_key { + my ($rest) = @_; + my $special = { + left => '', + right => '', + up => '', + down => '', + tab => '', + space => '', + spc => '', + }; +} + + +1; diff --git a/testing/lib/Test/Irssi/Test.pm b/testing/lib/Test/Irssi/Test.pm index 9655ee4..752a01d 100644 --- a/testing/lib/Test/Irssi/Test.pm +++ b/testing/lib/Test/Irssi/Test.pm @@ -15,6 +15,7 @@ class Test::Irssi::Test { isa => 'Test::Irssi', required => 1, ); + has 'name' => ( is => 'ro', @@ -73,57 +74,85 @@ class Test::Irssi::Test { # TODO: should only be valid when complete is set. sub passed { my $self = shift; - return grep { 1 || undef } @{ $self->results }; + my $pass = 0; + foreach my $result (@{$self->results}) { + $pass = $result; + } + return $pass and $self->complete; } sub failed { my $self = shift; - return not $self->passed(); + return not $self->passed; } + sub details { + my ($self) = shift; + my $state_count = $self->state_count; + for (0..$state_count-1) { + my $state = $self->states->[$_]; + my $result = $self->results->[$_]; + say( "\t" . $state->{type} . " - " . $state->{desc} . " " + . " = " .( $result?"ok":"not ok")); + } + } ############# API FUNCTIONS ########################################## method add_input_sequence(Str $input) { - $self->add_state({input => $input }); + $self->add_state({type => 'command', + input => $input, + desc => 'input'}); + $self->log("Adding $input as input"); } method add_delay (Num $delay) { - $self->add_state({delay => $delay }); + $self->add_state({type => 'command', + desc => 'delay', + delay => $delay }); $self->log("Adding $delay as delay"); } + method add_keycode(Str $code) { my $input = $self->translate_keycode($code); - $self->add_state({input => $input }); + $self->add_state({type => 'command', + desc => 'input', + input => $input }); $self->log("Adding $input ($code) as input"); } sub add_pattern_match { my ($self, $pattern, $constraints, $desc) = @_; - $self->add_state({output => 1, - pattern => $pattern, + $self->add_state({type => 'test', + of => 'pattern', + pattern => $pattern, constraints => $constraints, - desc => $desc}); + desc => $desc}); $self->log("Adding $pattern as output match "); } - sub add_cursor_position_test { + sub test_cursor_position { my ($self, $x, $y, $desc) = @_; - $self->add_state({output => 1, - x => $x, - y => $y, + $self->add_state({type => 'test', + of => 'cursor', + x => $x, + y => $y, desc => $desc }); $self->log("Adding cursor [$x, $y] test "); } + sub add_evaluation_function { my ($self, $coderef, $desc) = @_; - $self->add_state({code => $coderef, desc => $desc}); + $self->add_state({type => 'test', + of => 'function', + code => $coderef, + desc => $desc}); } ############# END OF API FUNCTIONS #################################### @@ -163,8 +192,10 @@ class Test::Irssi::Test { } if ($line =~ m/$pattern/) { + $self->log("Pattern $pattern passed"); $self->results->[$self->this_state] = 1; } else { + $self->log("Pattern $pattern failed"); $self->results->[$self->this_state] = 0;; } } @@ -178,39 +209,62 @@ class Test::Irssi::Test { } sub evaluate_test { - my ($self) = @_; + while (my $state = $self->get_next_state) { + $self->log("Evaluating Test: " . dump($state)); - # stimuli - if ( exists($state->{delay})) { - $self->log("inserting delay"); - $self->parent->apply_delay($state->{delay}); - return; - } + my $type = $state->{type}; - if (exists $state->{input}) { - $self->parent->inject_text($state->{input}); - $self->log("input: ". $state->{input}); - } + if ($type eq 'command') { - # tests - if (exists $state->{code}) { - # code evaluation - my @args = ($self, $self->parent, $self->parent->vt); - my $ret = $state->{code}->(@args); - $ret //= 0; # ensure that undef failures are - # marked as such. - $self->results->[$self->this_state] = $ret; - } + if (exists($state->{delay})) { + $self->log("inserting delay"); + $self->parent->apply_delay($state->{delay}); + $self->results->[$self->this_state] = 1; + return; + } - if (exists $state->{output}) { - # pattern match evaluation - my $pattern = $state->{pattern}; - $self->check_output($state); - } + if (exists $state->{input}) { + $self->parent->inject_text($state->{input}); + $self->log("input: ". $state->{input}); + } + + # all commands are considered to succeed. + $self->results->[$self->this_state] = 1; + + } elsif ($type eq 'test') { + my $test_type = $state->{of}; + + if ($test_type eq 'pattern') { + my $pattern = $state->{pattern}; + $self->check_output($state); + } + if ($test_type eq 'cursor') { + my ($curs_x, $curs_y) = $self->parent->get_cursor_position; + + my $ret = 0; + if ($state->{x} == $curs_x and $state->{y} == $curs_y) { + $ret = 1; + } + + $self->results->[$self->this_state] = $ret; + + } + + if ($test_type eq 'function') { + # code evaluation + my @args = ($self, $self->parent, $self->parent->vt); + my $ret = $state->{code}->(@args); + $ret //= 0; # ensure that undef failures are + # marked as such. + $self->results->[$self->this_state] = $ret; + } + } else { + # wtf? + } } $poe_kernel->post(IrssiTestDriver => 'test_complete'); @@ -230,6 +284,7 @@ class Test::Irssi::Test { $self->parent->_logfile_fh->say($msg); } + sub _all { $_ || return 0 for @_; 1 } } -- cgit v1.2.3