Commit | Line | Data |
60cda014 |
1 | use strictures 1; |
2 | use Test::More; |
3 | use aliased 'DX::Op::FromCode'; |
4 | use aliased 'DX::ArrayStream'; |
94565614 |
5 | use DX::ResultStream; |
60cda014 |
6 | use DX::Var; |
7 | use DX::State; |
94565614 |
8 | use Test::Exception; |
60cda014 |
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), |
46894e63 |
22 | qw(joe.example.com kitty.scsys.co.uk) }, |
60cda014 |
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) = @_; |
7a0670cd |
31 | $state->then($self->next)->bind_stream( |
60cda014 |
32 | $state->scope_var($var), |
33 | ArrayStream->from_array(@$array), |
60cda014 |
34 | ) |
35 | } |
36 | } |
37 | |
5622b4df |
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 | |
54817920 |
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; |
60cda014 |
62 | |
5622b4df |
63 | sub make_state { |
64 | my ($vars, $op) = @_; |
60cda014 |
65 | |
5622b4df |
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 | } |
60cda014 |
77 | |
5622b4df |
78 | my $stream = DX::ResultStream->new(for_state => make_state([ 'S' ], $op)); |
94565614 |
79 | |
deec7cc4 |
80 | is($stream->next->value_for('S'), $_) |
94565614 |
81 | for qw(jim.example.com joe.example.com bob.example.com); |
60cda014 |
82 | |
5622b4df |
83 | is($stream->next, undef, 'No more'); |
84 | |
5622b4df |
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 | |
71217e42 |
98 | sub bound_values { |
99 | map { |
100 | my $v = $_; |
101 | +{ |
deec7cc4 |
102 | map +($_ => $v->value_for($_)), $v->var_names, |
71217e42 |
103 | } |
104 | } @_ |
105 | } |
106 | |
5622b4df |
107 | my $cstream = DX::ResultStream->new( |
108 | for_state => make_state([ qw(S P) ], $complex_op) |
109 | ); |
110 | |
26300a7d |
111 | is_deeply( |
71217e42 |
112 | [ bound_values $cstream->results ], |
26300a7d |
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 | ); |
60cda014 |
121 | |
46894e63 |
122 | my $pop_stack = FromCode->new( |
b40d5c51 |
123 | code => sub { $_[1]->pop_return_stack } |
46894e63 |
124 | ); |
125 | |
126 | my $inner_op = make_op($pop_stack); |
54817920 |
127 | |
71d26209 |
128 | my $call_op = FromCode->new( |
129 | code => sub { |
130 | my ($self, $state) = @_; |
71d26209 |
131 | my $save_scope = $state->scope; |
132 | my %scope = (S => $save_scope->{S}); |
133 | my $ret_op = FromCode->new( |
03079510 |
134 | code => sub { $_[1]->but(scope => $save_scope, next_op => $_[0]->next) }, |
71d26209 |
135 | next => $self->next, |
136 | ); |
12face77 |
137 | $state->but(scope => \%scope)->push_return_then($ret_op, $inner_op); |
71d26209 |
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( |
71217e42 |
152 | [ bound_values $callstream->results ], |
71d26209 |
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 | |
46894e63 |
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 | ); |
12face77 |
179 | $state->push_return_then($self->next, $inner_or) |
180 | ->mark_choice($var); |
46894e63 |
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( |
71217e42 |
193 | [ bound_values $orstream->results ], |
46894e63 |
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( |
71217e42 |
229 | [ bound_values $orstream_2->results ], |
46894e63 |
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 | |
60cda014 |
247 | done_testing; |