aboutsummaryrefslogtreecommitdiffstats
path: root/testing/lib/Test/Irssi
diff options
context:
space:
mode:
Diffstat (limited to 'testing/lib/Test/Irssi')
-rw-r--r--testing/lib/Test/Irssi/Driver.pm14
-rw-r--r--testing/lib/Test/Irssi/Misc.pm35
-rw-r--r--testing/lib/Test/Irssi/Test.pm131
3 files changed, 139 insertions, 41 deletions
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 }
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-14 15:56:46 +0000