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) },
  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->then($self->next)->bind_stream(
  32       $state->scope_var($var),
  33       ArrayStream->from_array(@$array),
  34     )
  35   }
  36 }
  37
  38 sub test_values {
  39   my ($vars, $test) = @_;
  40   sub {
  41     my ($self, $state) = @_;
  42     my @values = map $state->scope_var($_)->bound_value, @$vars;
  43     if ($test->(@values)) {
  44       return $state->then($self->next);
  45     }
  46     return $state->backtrack;
  47   }
  48 }
  49
  50 sub make_op {
  51   my ($inner) = @_;
  52   FromCode->new(
  53     code => bind_array(S => \@servers),
  54     next => FromCode->new(
  55       code => test_values([ 'S' ], sub { $_[0] =~ /\.example\.com$/ }),
  56       next => $inner,
  57     )
  58   );
  59 }
  60
  61 my $op = make_op;
  62
  63 sub make_state {
  64   my ($vars, $op) = @_;
  65
  66   my %scope = map +($_ => $_), @{$vars};
  67   my %by_id = map +($_ => DX::Var->new(id => $_)), @{$vars};
  68
  69   DX::State->new(
  70     next_op => $op,
  71     return_stack => [],
  72     by_id => \%by_id,
  73     scope => \%scope,
  74     last_choice => []
  75   );
  76 }
  77
  78 my $stream = DX::ResultStream->new(for_state => make_state([ 'S' ], $op));
  79
  80 is($stream->next->value_for('S'), $_)
  81   for qw(jim.example.com joe.example.com bob.example.com);
  82
  83 is($stream->next, undef, 'No more');
  84
  85 my $complex_op = FromCode->new(
  86   code => bind_array(S => \@servers),
  87   next => FromCode->new(
  88     code => test_values([ 'S' ], sub { $_[0] =~ /\.example\.com$/ }),
  89     next => FromCode->new(
  90       code => bind_array(P => \@shells),
  91       next => FromCode->new(
  92         code => test_values([ qw(S P) ], sub { $shells{$_[1]}{$_[0]} }),
  93       )
  94     )
  95   )
  96 );
  97
  98 sub bound_values {
  99   map {
 100     my $v = $_;
 101     +{
 102        map +($_ => $v->value_for($_)), $v->var_names,
 103     }
 104   } @_
 105 }
 106
 107 my $cstream = DX::ResultStream->new(
 108   for_state => make_state([ qw(S P) ], $complex_op)
 109 );
 110
 111 is_deeply(
 112   [ bound_values $cstream->results ],
 113   [
 114     { P => 'csh', S => 'jim.example.com' },
 115     { P => 'csh', S => 'joe.example.com' },
 116     { P => 'bash', S => 'joe.example.com' },
 117     { P => 'csh', S => 'bob.example.com' },
 118   ],
 119   'Complex stream'
 120 );
 121
 122 my $pop_stack = FromCode->new(
 123   code => sub { $_[1]->pop_return_stack }
 124 );
 125
 126 my $inner_op = make_op($pop_stack);
 127
 128 my $call_op = FromCode->new(
 129   code => sub {
 130     my ($self, $state) = @_;
 131     my $save_scope = $state->scope;
 132     my %scope = (S => $save_scope->{S});
 133     my $ret_op = FromCode->new(
 134       code => sub { $_[1]->but(scope => $save_scope, next_op => $_[0]->next) },
 135       next => $self->next,
 136     );
 137     $state->but(scope => \%scope)->push_return_then($ret_op, $inner_op);
 138   },
 139   next => FromCode->new(
 140     code => bind_array(P => \@shells),
 141     next => FromCode->new(
 142       code => test_values([ qw(S P) ], sub { $shells{$_[1]}{$_[0]} }),
 143     )
 144   )
 145 );
 146
 147 my $callstream = DX::ResultStream->new(
 148   for_state => make_state([ qw(S P) ], $call_op)
 149 );
 150
 151 is_deeply(
 152   [ bound_values $callstream->results ],
 153   [
 154     { P => 'csh', S => 'jim.example.com' },
 155     { P => 'csh', S => 'joe.example.com' },
 156     { P => 'bash', S => 'joe.example.com' },
 157     { P => 'csh', S => 'bob.example.com' },
 158   ],
 159   'Call stream'
 160 );
 161
 162 my $has_csh = FromCode->new(
 163   code => test_values([ 'S' ], sub { $shells{csh}{$_[0]} }),
 164   next => $pop_stack
 165 );
 166 my $has_bash = FromCode->new(
 167   code => test_values([ 'S' ], sub { $shells{bash}{$_[0]} }),
 168   next => $pop_stack
 169 );
 170
 171 my $or_code = sub {
 172   my ($self, $state) = @_;
 173   my $var = DX::Var->new(id => 'OR')->with_stream(
 174     my $stream = ArrayStream->from_array($has_csh, $has_bash)
 175   );
 176   my $inner_or = FromCode->new(
 177     code => sub { $_[1]->then($var->bound_value) }
 178   );
 179   $state->push_return_then($self->next, $inner_or)
 180         ->mark_choice($var);
 181 };
 182
 183 my $top_or = FromCode->new(
 184   code => bind_array(S => \@servers),
 185   next => FromCode->new(code => $or_code),
 186 );
 187
 188 my $orstream = DX::ResultStream->new(
 189   for_state => make_state([ qw(S) ], $top_or)
 190 );
 191
 192 is_deeply(
 193   [ bound_values $orstream->results ],
 194   [
 195     {
 196       S => "kitty.scsys.co.uk"
 197     },
 198     {
 199       S => "jim.example.com"
 200     },
 201     {
 202       S => "joe.example.com"
 203     },
 204     {
 205       S => "joe.example.com"
 206     },
 207     {
 208       S => "bob.example.com"
 209     }
 210   ],
 211   'Or stream'
 212 );
 213
 214 my $top_or_2 = FromCode->new(
 215   code => bind_array(S => \@servers),
 216   next => FromCode->new(
 217     code => $or_code,
 218     next => FromCode->new(
 219       code => test_values([ 'S' ], sub { $_[0] =~ /\.example\.com$/ }),
 220     ),
 221   ),
 222 );
 223
 224 my $orstream_2 = DX::ResultStream->new(
 225   for_state => make_state([ qw(S) ], $top_or_2)
 226 );
 227
 228 is_deeply(
 229   [ bound_values $orstream_2->results ],
 230   [
 231     {
 232       S => "jim.example.com"
 233     },
 234     {
 235       S => "joe.example.com"
 236     },
 237     {
 238       S => "joe.example.com"
 239     },
 240     {
 241       S => "bob.example.com"
 242     }
 243   ],
 244   'Or stream'
 245 );
 246
 247 done_testing;