t/basic.t

   1 use strictures 1;
   2 use Test::More;
   3 use aliased 'DX::Op::FromCode';
   4 use aliased 'DX::ArrayStream';
   5 use DX::ResultStream;
   6 use DX::Var;
   7 use DX::State;
   8 use Test::Exception;
   9
  10 my @servers = qw(
  11   kitty.scsys.co.uk
  12   jim.example.com
  13   joe.example.com
  14   pryde.scsys.co.uk
  15   bob.example.com
  16 );
  17
  18 my @shells = qw(csh bash);
  19
  20 my %shells = (
  21   bash => { map +($_ => 1),
  22              qw(joe.example.com kitty.scsys.co.uk pryde.scsys.co.uk) },
  23   csh => { map +($_ => 1),
  24              qw(jim.example.com joe.example.com bob.example.com) },
  25 );
  26
  27 sub bind_array {
  28   my ($var, $array) = @_;
  29   sub {
  30     my ($self, $state) = @_;
  31     $state->bind_stream_then(
  32       $state->scope_var($var),
  33       ArrayStream->from_array(@$array),
  34       $self->next
  35     )
  36   }
  37 }
  38
  39 my $op = FromCode->new(
  40   code => bind_array(S => \@servers),
  41   next => FromCode->new(
  42     code => sub {
  43       my ($self, $state) = @_;
  44       my $server = $state->scope_var('S')->bound_value;
  45       if ($server =~ /\.example\.com$/) {
  46         return $state->then($self->next);
  47       }
  48       return $state->backtrack;
  49     },
  50   )
  51 );
  52
  53 my %scope = map +($_ => $_), qw(S);
  54 my %by_id = map +($_ => DX::Var->new(id => $_)), qw(S);
  55
  56 my $state = DX::State->new(
  57   next_op => $op,
  58   return_stack => [],
  59   by_id => \%by_id,
  60   scope => \%scope,
  61   last_choice => []
  62 );
  63
  64 my $stream = DX::ResultStream->new(for_state => $state);
  65
  66 is($stream->next->{'S'}, $_)
  67   for qw(jim.example.com joe.example.com bob.example.com);
  68
  69 dies_ok { $stream->next } 'No more';
  70
  71 done_testing;