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