Commits

Fabrice Gabolde  committed c704cfb

"yield" command allows Lembas spec to return control to calling test script.

  • Participants
  • Parent commits 230ead5

Comments (0)

Files changed (3)

File lib/Lembas.pm

 has '_ansi_escape' => (is => 'ro',
                        default => sub { qr/\x{1B}\[([0-9]{1,3}((;[0-9]{1,3})*)?)?[m|K]/ });
 
+has '_is_resuming' => (is => 'rw',
+                       default => sub { 0 });
+
 sub _build_subprocess {
 
     my $self = shift;
 
     my $self = shift;
 
-    foreach my $command (@{$self->commands}) {
+    while (@{$self->commands}) {
 
-        if (not defined $command->{shell}) {
+        # we are not shifting/popping from the commands arrayref
+        # because we need to be able to exit this loop and reenter at
+        # the same command, as long as it hasn't been completely
+        # processed, in case of "yield"
+        my $command = $self->commands->[0];
 
-            # called command "preamble", need to start matching output
-            # *before* sending input
+        if ($self->_is_resuming) {
 
-            $self->builder->note('Matching preamble output...');
+            $self->_is_resuming(0);
+            $self->builder->note('Resuming tests...');
 
         } else {
 
-            $self->builder->note($command->{shell});
-            ${$self->input} .= $command->{shell} . "\n";
+            if (not defined $command->{shell}) {
+
+                # called command "preamble", need to start matching
+                # output *before* sending input
+
+                $self->builder->note('Matching preamble output...');
+
+            } else {
+
+                $self->builder->note($command->{shell});
+                ${$self->input} .= $command->{shell} . "\n";
+
+            }
 
         }
 
                     $self->builder->todo_output(\$fastforwarding_buffer);
                 } elsif ($expected_output->{command} eq 'wait_less_than') {
                     alarm $parameters[0];
+                } elsif ($expected_output->{command} eq 'yield') {
+                    $self->builder->note('Yielding control to calling script.');
+                    $self->_is_resuming(1);
+                    return $self;
                 } else {
                     croak(sprintf(q{unknown command '%s'},
                                   $expected_output->{command}));
         # cleanup output to make room for the next command
         ${$self->output} = '';
 
+        # done with this one.
+        shift @{$self->commands};
+
     }
 
     $self->subprocess->finish;

File lib/Lembas/Specification.pod

 C<VALUE> may be any value.  C<UNIT> may be "second", "seconds",
 "minute" or "minutes".
 
+=head2 yield
+
+  yield
+
+The C<yield> command exits the Lembas loop mid-tests so that you can
+perform some other tasks.  You can resume the Lembas tests by calling
+the C<run> method again.
+
 =head1 AUTHOR
 
 Fabrice Gabolde <fabrice.gabolde@gmail.com>

File t/commands/02-yield.t

+use strict;
+use warnings;
+use 5.010;
+use Carp;
+
+use Test::More;
+use Test::Exception;
+use Test::Builder;
+use Test::Builder::Tester;
+use IO::Scalar;
+
+use_ok 'Lembas';
+
+my $lembas = new_ok('Lembas', [ shell => [ qw{examples/ush --horns 1} ],
+                                commands => [ { shell => undef,
+                                                outputs => [
+                                                    { match_type => 'regex',
+                                                      output => 'This is unicorn-shell version [\\d.]+', },
+                                                    { match_type => 'literal',
+                                                      output => 'You have asked for a shell with 1 horn(s)' },
+                                                    { command => 'yield',
+                                                      parameters => [] },
+                                                    { command => 'fastforward',
+                                                      parameters => [ qw/some/ ] },
+                                                    { match_type => 'literal',
+                                                      output => '' },
+                                                    ] } ] ]);
+
+test_out(q{# Matching preamble output...});
+test_out(q{ok 1 - regex match of 'This is unicorn-shell version [\d.]+'});
+test_out(q{ok 2 - literal match of 'You have asked for a shell with 1 horn(s)'});
+test_out(q{# Yielding control to calling script.});
+
+$lembas->run;
+test_test(q{'yield' command exits from run loop before it is over});
+
+# note test numbers are reset by test_test, not Lembas
+test_out(q{# Resuming tests...});
+test_out(q{# Fastforwarding...});
+test_out(q{ok 1 - literal match of ''});
+test_out(q{ok 2 - all output tested for '<preamble>'});
+
+$lembas->run;
+test_test(q{... and we can resume execution afterwards});
+
+done_testing;