1#!/usr/bin/perl -w
2
3use strict;
4#use Test::More 'no_plan';
5use Test::More tests => 327;
6
7my $CLASS;
8BEGIN {
9    $CLASS = 'FSA::Rules';
10    use_ok($CLASS) or die;
11}
12
13ok my $fsa = $CLASS->new, "Construct an empty state machine";
14isa_ok $fsa, $CLASS;
15
16ok $fsa = $CLASS->new(
17    foo => {},
18), "Construct with a single state";
19
20is $fsa->curr_state, undef, "... The current state should be undefined";
21ok my $state =  $fsa->curr_state('foo'), "... We should be able to set the state";
22isa_ok $state, 'FSA::State';
23is $state->name, 'foo', "... The name of the current state should be 'foo'";
24is $state->label, undef, '... The label should be undef';
25is $state->machine, $fsa, '... The state object should return the machine';
26is $fsa->curr_state, $state, "... The current state should be 'foo'";
27is $fsa->done, undef, "... It should not be done";
28is $fsa->done(1), $fsa, "... But we can set doneness";
29is $fsa->done, 1, "... And then retreive that value";
30is $fsa->strict, undef, "... It should not be strict";
31is $fsa->strict(1), $fsa, "... But we can set strict";
32is $fsa->strict, 1, "... And now strict is turned on";
33
34# Try a bogus state.
35eval { $fsa->curr_state('bogus') };
36ok my $err = $@, "... Assigning a bogus state should fail";
37like $err, qr/No such state "bogus"/, "... And throw the proper exception";
38
39# Try a do code ref.
40ok $fsa = $CLASS->new(
41    foo => {
42        label => 'This is foo',
43        do => sub { shift->machine->{foo}++ }
44    },
45), "Construct with a single state with an action";
46
47is $fsa->curr_state, undef, "... The current state should be undefined";
48is $fsa->{foo}, undef, "... The code should not have been executed";
49ok $state = $fsa->curr_state('foo'), "... We should be able to set the state";
50isa_ok $state, 'FSA::State';
51is $state->name, 'foo', "... The name of the current state should be 'foo'";
52is $state->label, 'This is foo', 'The label should be set';
53is $fsa->curr_state, $state, "... The current state should be 'foo'";
54is $fsa->{foo}, 1, "... The code should now have been executed";
55
56# Try a do code array ref.
57ok $fsa = $CLASS->new(
58    foo => {
59        do => [ sub { shift->machine->{foo}++ },
60                sub { shift->machine->{foo}++ } ],
61    },
62), "Construct with a single state with two actions";
63
64is $fsa->curr_state, undef, "... The current state should be undefined";
65is $fsa->{foo}, undef, "... The code should not have been executed";
66ok $state = $fsa->curr_state('foo'), "... We should be able to set the state";
67isa_ok $state, 'FSA::State';
68is $state->name, 'foo', "... The name of the current state should be 'foo'";
69is $fsa->curr_state, $state, "... The current state should be 'foo'";
70is $fsa->{foo}, 2, "... Both actions should now have been executed";
71
72# Try a single enter action.
73ok $fsa = $CLASS->new(
74    foo => {
75        on_enter => sub { shift->machine->{foo_enter}++ },
76        do => sub { shift->machine->{foo}++ }
77    },
78), "Construct with a single state with an enter action";
79
80is $fsa->curr_state, undef, "... The current state should be undefined";
81is $fsa->{foo}, undef, "... The code should not have been executed";
82is $fsa->{foo_enter}, undef, "... The enter code should not have executed";
83ok $state = $fsa->curr_state('foo'), "... We should be able to set the state";
84isa_ok $state, 'FSA::State';
85is $state->name, 'foo', "... The name of the current state should be 'foo'";
86is $fsa->curr_state, $state, "... The current state should be 'foo'";
87is $fsa->{foo}, 1, "... The code should now have been executed";
88is $fsa->{foo_enter}, 1, "... The enter code should have executed";
89
90# Try an enter action array ref.
91ok $fsa = $CLASS->new(
92    foo => {
93        on_enter => [ sub { shift->machine->{foo_enter}++ },
94                      sub { shift->machine->{foo_enter}++ }
95                    ],
96        do => sub { shift->machine->{foo}++ }
97    },
98), "Construct with a single state with multiple enter actions";
99
100is $fsa->curr_state, undef, "... The current state should be undefined";
101is $fsa->{foo}, undef, "... The code should not have been executed";
102is $fsa->{foo_enter}, undef, "... The enter code should not have executed";
103ok $state = $fsa->curr_state('foo'), "... We should be able to set the state";
104isa_ok $state, 'FSA::State';
105is $state->name, 'foo', "... The name of the current state should be 'foo'";
106is $fsa->curr_state, $state, "... The current state should be 'foo'";
107is $fsa->{foo}, 1, "... The code should now have been executed";
108is $fsa->{foo_enter}, 2, "... Both enter actions should have executed";
109
110# Try a second state with exit actions in the first state.
111ok $fsa = $CLASS->new(
112    foo => {
113        on_enter => sub { shift->machine->{foo_enter}++ },
114        do => sub { shift->machine->{foo}++ },
115        on_exit => sub { shift->machine->{foo_exit}++ },
116    },
117    bar => {
118        on_enter => sub { shift->machine->{bar_enter}++ },
119        do => sub { $_[0]->machine->{bar} = $_[0]->machine->{bar_enter} }
120    },
121), "Construct with a two states and a exit action";
122
123is $fsa->curr_state, undef, "... The current state should be undefined";
124is $fsa->{foo}, undef, "... The foo code should not have been executed";
125is $fsa->{foo_enter}, undef, "... The 'foo' enter code should not have executed";
126is $fsa->{bar}, undef, "... The bar code should not have been executed";
127is $fsa->{bar_enter}, undef, "... The enter code should not have executed";
128ok $state = $fsa->curr_state('foo'), "... We should be able to set the state";
129isa_ok $state, 'FSA::State';
130is $state->name, 'foo', "... The name of the current state should be 'foo'";
131is $fsa->curr_state, $state, "... The current state should be 'foo'";
132is $fsa->{foo}, 1, "... The 'foo' code should now have been executed";
133is $fsa->{foo_enter}, 1, "... The  'foo' enter action should have executed";
134is $fsa->{foo_exit}, undef, "... The  'foo' exit action should not have executed";
135ok $state = $fsa->curr_state('bar'), "... We should be able to change the state to 'bar'";
136isa_ok $state, 'FSA::State';
137is $state->name, 'bar', "... The name of the current state should be 'bar'";
138is $fsa->curr_state, $state, "... The current state should be 'bar'";
139is $fsa->{foo_exit}, 1, "... The 'foo' exit action should have executed";
140is $fsa->{bar}, 1, "... The 'bar' code should now have been executed";
141is $fsa->{bar_enter}, 1, "... The 'bar' enter action should have executed";
142
143# Try a second state with multiple exit actions in the first state.
144ok $fsa = $CLASS->new(
145    foo => {
146        on_enter => sub { shift->machine->{foo_enter}++ },
147        do => sub { shift->machine->{foo}++ },
148        on_exit => [sub { shift->machine->{foo_exit}++ }, sub { shift->machine->{foo_exit}++ } ],
149    },
150    bar => {
151        on_enter => sub { shift->machine->{bar_enter}++ },
152        do => sub { $_[0]->machine->{bar} = $_[0]->machine->{bar_enter} }
153    },
154), "Construct with a two states and multiple exit actions";
155
156is $fsa->curr_state, undef, "... The current state should be undefined";
157is $fsa->{foo}, undef, "... The foo code should not have been executed";
158is $fsa->{foo_enter}, undef, "... The 'foo' enter code should not have executed";
159is $fsa->{bar}, undef, "... The bar code should not have been executed";
160is $fsa->{bar_enter}, undef, "... The enter code should not have executed";
161ok $state = $fsa->curr_state('foo'), "... We should be able to set the state";
162isa_ok $state, 'FSA::State';
163is $state->name, 'foo', "... The name of the current state should be 'foo'";
164is $fsa->curr_state, $state, "... The current state should be 'foo'";
165is $fsa->{foo}, 1, "... The 'foo' code should now have been executed";
166is $fsa->{foo_enter}, 1, "... The  'foo' enter action should have executed";
167is $fsa->{foo_exit}, undef, "... The  'foo' exit action should not have executed";
168ok $state = $fsa->curr_state('bar'), "... We should be able to change the state to 'bar'";
169isa_ok $state, 'FSA::State';
170is $state->name, 'bar', "... The name of the current state should be 'bar'";
171is $fsa->curr_state, $state, "... The current state should be 'bar'";
172is $fsa->{foo_exit}, 2, "... Both 'foo' exit actions should have executed";
173is $fsa->{bar}, 1, "... The 'bar' code should now have been executed";
174is $fsa->{bar_enter}, 1, "... The  'bar' enter action should have executed";
175
176# Set up switch rules (rules).
177ok $fsa = $CLASS->new(
178    foo => {
179        on_enter => sub { shift->machine->{foo_enter}++ },
180        do => sub { shift->machine->{foo}++ },
181        on_exit => sub { shift->machine->{foo_exit}++ },
182        rules => [
183            bar => sub { shift->machine->{foo} },
184        ],
185    },
186    bar => {
187        on_enter => sub { shift->machine->{bar_enter}++ },
188        do => sub { $_[0]->machine->{bar} = $_[0]->machine->{bar_enter} },
189    },
190), "Construct with a two states and a switch rule";
191
192is $fsa->curr_state, undef, "... The current state should be undefined";
193is $fsa->{foo}, undef, "... The foo code should not have been executed";
194is $fsa->{foo_enter}, undef, "... The 'foo' enter code should not have executed";
195is $fsa->{bar}, undef, "... The bar code should not have been executed";
196is $fsa->{bar_enter}, undef, "... The enter code should not have executed";
197ok $state = $fsa->curr_state('foo'), "... We should be able to set the state";
198isa_ok $state, 'FSA::State';
199is $state->name, 'foo', "... The name of the current state should be 'foo'";
200is $fsa->curr_state, $state, "... The current state should be 'foo'";
201is $fsa->{foo}, 1, "... The 'foo' code should now have been executed";
202is $fsa->{foo_enter}, 1, "... The  'foo' enter action should have executed";
203is $fsa->{foo_exit}, undef, "... The 'foo' exit action should not have executed";
204ok $state =  $fsa->try_switch, "... The try_switch method should return the 'bar' state";
205isa_ok $state, 'FSA::State';
206is $state->name, 'bar', "... The name of the current state should be 'bar'";
207is $fsa->curr_state, $state, "... The current state should be 'bar'";
208is $fsa->{foo_exit}, 1, "... Now the 'foo' exit action should have executed";
209is $fsa->{bar}, 1, "... And the 'bar' code should now have been executed";
210is $fsa->{bar_enter}, 1, "... And the 'bar' enter action should have executed";
211
212# There are no switchs from bar.
213eval { $fsa->switch };
214ok $err = $@, "... Another attempt to switch should fail";
215like $err, qr/Cannot determine transition from state "bar"/,
216  "... And throw the proper exception";
217
218# Test that rule labels are no-ops for normal operation
219ok $fsa = $CLASS->new(
220    foo => {
221        on_enter => sub { shift->machine->{foo_enter}++ },
222        do       => sub { shift->machine->{foo}++ },
223        on_exit  => sub { shift->machine->{foo_exit}++ },
224        rules => [
225            bar => {
226                rule    => sub { shift->machine->{foo} },
227                message => 'some rule label',
228            },
229        ],
230    },
231    bar => {
232        on_enter => sub { shift->machine->{bar_enter}++ },
233        do => sub { $_[0]->machine->{bar} = $_[0]->machine->{bar_enter} },
234    },
235), "Construct with a two states and a switch rule";
236
237is $fsa->curr_state, undef, "Adding labels to rules should not affect behavior";
238is $fsa->{foo}, undef, "... The foo code should not have been executed";
239is $fsa->{foo_enter}, undef, "... The 'foo' enter code should not have executed";
240is $fsa->{bar}, undef, "... The bar code should not have been executed";
241is $fsa->{bar_enter}, undef, "... The enter code should not have executed";
242ok $state = $fsa->curr_state('foo'), "... We should be able to set the state";
243isa_ok $state, 'FSA::State';
244is $state->name, 'foo', "... The name of the current state should be 'foo'";
245is $fsa->curr_state, $state, "... The current state should be 'foo'";
246is $fsa->{foo}, 1, "... The 'foo' code should now have been executed";
247is $fsa->{foo_enter}, 1, "... The  'foo' enter action should have executed";
248is $fsa->{foo_exit}, undef, "... The 'foo' exit action should not have executed";
249ok $state =  $fsa->try_switch, "... The try_switch method should return the 'bar' state";
250isa_ok $state, 'FSA::State';
251is $state->name, 'bar', "... The name of the current state should be 'bar'";
252is $fsa->curr_state, $state, "... The current state should be 'bar'";
253is $fsa->{foo_exit}, 1, "... Now the 'foo' exit action should have executed";
254is $fsa->{bar}, 1, "... And the 'bar' code should now have been executed";
255is $fsa->{bar_enter}, 1, "... And the 'bar' enter action should have executed";
256
257can_ok $fsa, 'states';
258my @messages = map { $_->message } $fsa->states('foo');
259is $messages[0], 'some rule label',
260  '... and states should have messages automatically added';
261eval {$fsa->states('no_such_state')};
262ok $@, '... but asking for a state that was never defined should die';
263like $@, qr/No such state\(s\) 'no_such_state'/, '... with an appropriate error message';
264
265# Try switch actions.
266ok $fsa = $CLASS->new(
267    foo => {
268        on_enter => sub { shift->machine->{foo_enter}++ },
269        do => sub { shift->machine->{foo}++ },
270        on_exit => sub { shift->machine->{foo_exit}++ },
271        rules => [
272            bar => [sub { shift->machine->{foo} },
273                    sub {
274                        my ($foo, $bar) = @_;
275                        isa_ok $_, 'FSA::State' for ($foo, $bar);
276                        is $foo->name, 'foo', 'The first parameter is "foo"';
277                        is $bar->name, 'bar', 'The second parameter is "bar"';
278                        $foo->machine->{foo_bar}++ }
279                   ],
280        ],
281    },
282    bar => {
283        on_enter => sub { $_[0]->machine->{bar_enter} = $_[0]->machine->{foo_bar} },
284        do => sub { $_[0]->machine->{bar} = $_[0]->machine->{bar_enter} }
285    },
286), "Construct with a two states and a switch rule with its own action";
287
288is $fsa->curr_state, undef, "... The current state should be undefined";
289is $fsa->{foo}, undef, "... The foo code should not have been executed";
290is $fsa->{foo_enter}, undef, "... The 'foo' enter code should not have executed";
291is $fsa->{bar}, undef, "... The bar code should not have been executed";
292is $fsa->{bar_enter}, undef, "... The enter code should not have executed";
293ok $state = $fsa->curr_state('foo'), "... We should be able to set the state";
294isa_ok $state, 'FSA::State';
295is $state->name, 'foo', "... The name of the current state should be 'foo'";
296is $fsa->curr_state, $state, "... The current state should be 'foo'";
297is $fsa->{foo}, 1, "... The 'foo' code should now have been executed";
298is $fsa->{foo_enter}, 1, "... The  'foo' enter action should have executed";
299is $fsa->{foo_exit}, undef, "... The 'foo' exit action should not have executed";
300ok $state =  $fsa->switch, "... The switch method should return the 'bar' state";
301isa_ok $state, 'FSA::State';
302is $state->name, 'bar', "... The name of the current state should be 'bar'";
303is $fsa->curr_state, $state, "... The current state should be 'bar'";
304is $fsa->{foo_exit}, 1, "... Now the 'foo' exit action should have executed";
305is $fsa->{bar}, 1, "... And the 'bar' code should now have been executed";
306is $fsa->{foo_bar}, 1, "... And the 'foo' to 'bar' switch action should have executed";
307is $fsa->{bar_enter}, 1, "... And the 'bar' enter action should have executed";
308
309# Try a simple true value switch rule.
310ok $fsa = $CLASS->new(
311    foo => {
312        on_enter => sub { shift->machine->{foo_enter}++ },
313        do => sub { shift->machine->{foo}++ },
314        on_exit => sub { shift->machine->{foo_exit}++ },
315        rules => [
316            foo => 0,
317            bar => 1
318        ],
319    },
320    bar => {
321        on_enter => sub { shift->machine->{bar_enter}++ },
322        do => sub { $_[0]->machine->{bar} = $_[0]->machine->{bar_enter} }
323    },
324), "Construct with a two states and a switch rule of '1'";
325
326is $fsa->curr_state, undef, "... The current state should be undefined";
327is $fsa->{foo}, undef, "... The foo code should not have been executed";
328is $fsa->{foo_enter}, undef, "... The 'foo' enter code should not have executed";
329is $fsa->{bar}, undef, "... The bar code should not have been executed";
330is $fsa->{bar_enter}, undef, "... The enter code should not have executed";
331ok $state = $fsa->curr_state('foo'), "... We should be able to set the state";
332isa_ok $state, 'FSA::State';
333is $state->name, 'foo', "... The name of the current state should be 'foo'";
334is $fsa->curr_state, $state, "... The current state should be 'foo'";
335is $fsa->{foo}, 1, "... The 'foo' code should now have been executed";
336is $fsa->{foo_enter}, 1, "... The  'foo' enter action should have executed";
337is $fsa->{foo_exit}, undef, "... The 'foo' exit action should not have executed";
338ok $state =  $fsa->switch, "... The switch method should return the 'bar' state";
339isa_ok $state, 'FSA::State';
340is $state->name, 'bar', "... The name of the current state should be 'bar'";
341is $fsa->curr_state, $state, "... The current state should be 'bar'";
342is $fsa->{foo_exit}, 1, "... Now the 'foo' exit action should have executed";
343is $fsa->{bar}, 1, "... And the 'bar' code should now have been executed";
344is $fsa->{bar_enter}, 1, "... And the 'bar' enter action should have executed";
345
346# Try a simple true value switch rule with switch actions.
347ok $fsa = $CLASS->new(
348    foo => {
349        on_enter => sub { shift->machine->{foo_enter}++ },
350        do => sub { shift->machine->{foo}++ },
351        on_exit => sub { shift->machine->{foo_exit}++ },
352        rules => [
353            bar => [1, sub { shift->machine->{foo_bar}++ } ],
354        ],
355    },
356    bar => {
357        on_enter => sub { $_[0]->machine->{bar_enter} = $_[0]->machine->{foo_bar} },
358        do => sub { $_[0]->machine->{bar} = $_[0]->machine->{bar_enter} }
359    },
360), "Construct with a two states, a switch rule of '1', and a switch action";
361
362is $fsa->curr_state, undef, "... The current state should be undefined";
363is $fsa->{foo}, undef, "... The foo code should not have been executed";
364is $fsa->{foo_enter}, undef, "... The 'foo' enter code should not have executed";
365is $fsa->{bar}, undef, "... The bar code should not have been executed";
366is $fsa->{bar_enter}, undef, "... The enter code should not have executed";
367ok $state = $fsa->curr_state('foo'), "... We should be able to set the state";
368isa_ok $state, 'FSA::State';
369is $state->name, 'foo', "... The name of the current state should be 'foo'";
370is $fsa->curr_state, $state, "... The current state should be 'foo'";
371is $fsa->{foo}, 1, "... The 'foo' code should now have been executed";
372is $fsa->{foo_enter}, 1, "... The  'foo' enter action should have executed";
373is $fsa->{foo_exit}, undef, "... The 'foo' exit action should not have executed";
374ok $state =  $fsa->switch, "... The switch method should return the 'bar' state";
375isa_ok $state, 'FSA::State';
376is $state->name, 'bar', "... The name of the current state should be 'bar'";
377is $fsa->curr_state, $state, "... The current state should be 'bar'";
378is $fsa->{foo_exit}, 1, "... Now the 'foo' exit action should have executed";
379is $fsa->{foo_bar}, 1, "... And the 'foo' to 'bar' switch action should have executed";
380is $fsa->{bar}, 1, "... And the 'bar' code should now have been executed";
381is $fsa->{bar_enter}, 1, "... And the 'bar' enter action should have executed";
382
383# Try start().
384ok $fsa = $CLASS->new(
385    foo => {
386        do => sub { shift->machine->{foo}++ }
387    },
388), "Construct with a single state with an enter action";
389
390is $fsa->curr_state, undef, "... The current state should be undefined";
391is $fsa->{foo}, undef, "... The code should not have been executed";
392ok $state = $fsa->start, "... The start method should return the start state";
393isa_ok $state, 'FSA::State';
394is $state->name, 'foo', "... The name of the current state should be 'foo'";
395is $fsa->curr_state, $state, "... The current state should be 'foo'";
396is $fsa->{foo}, 1, "... The code should now have been executed";
397eval { $fsa->start };
398ok $err = $@, '... Calling start on a running machine should die';
399like $err, qr/Cannot start machine because it is already running/,
400  '... And it should throw the proper exception';
401
402# Try start() with a second state.
403ok $fsa = $CLASS->new(
404    foo => {
405        do => sub { shift->machine->{foo}++ }
406    },
407    bar => {
408        do => sub { shift->machine->{bar}++ }
409    },
410), "Construct with a single state with an enter action";
411
412is $fsa->curr_state, undef, "... The current state should be undefined";
413is $fsa->{foo}, undef, "... The 'foo' code should not have been executed";
414is $fsa->{bar}, undef, "... The 'bar' code should not have been executed";
415ok $state = $fsa->start, "... The start method should return the start state";
416isa_ok $state, 'FSA::State';
417is $state->name, 'foo', "... The name of the current state should be 'foo'";
418is $fsa->curr_state, $state, "... The current state should be 'foo'";
419is $fsa->{foo}, 1, "... The code should now have been executed";
420is $fsa->{bar}, undef, "... The 'bar' code still should not have been executed";
421
422# Try a bad switch state name.
423eval {
424    $CLASS->new(
425        foo => { rules => [bad => 1] }
426    )
427};
428
429ok $err = $@, "A bad state name in rules should fail";
430like $err, qr/Unknown state "bad" referenced by state "foo"/,
431  "... And give the appropriate error message";
432
433# Try numbered states.
434ok $fsa = $CLASS->new(
435    0 => { rules => [ 1 => 1 ] },
436    1 => {},
437), "Construct with numbered states";
438ok $state = $fsa->start, "... Call to start() should return state '0'";
439isa_ok $state, 'FSA::State';
440is $state->name, 0, "... The name of the current state should be '0'";
441is $fsa->curr_state, $state, "... The current state should be '0'";
442
443ok $state = $fsa->switch, "... Call to switch should return '1' state";
444isa_ok $state, 'FSA::State';
445is $state->name, 1, "... The name of the current state should be '1'";
446is $fsa->curr_state, $state, "... The current state should be '1'";
447
448# Try run().
449ok $fsa = $CLASS->new(
450    0 => { rules => [ 1 => [ 1, sub { shift->machine->{count}++ } ] ] },
451    1 => { rules => [ 0 => [ 1, sub { $_[0]->done($_[0]->machine->{count} == 3 ) } ] ] },
452), "Construct with simple states to run";
453
454is $fsa->run, $fsa, "... Run should return the FSA object";
455is $fsa->{count}, 3,
456  "... And it should have run through the proper number of iterations.";
457# Reset and try again.
458$fsa->{count} = 0;
459is $fsa->done(0), $fsa, "... We should be able to reset done";
460ok $state = $fsa->curr_state,  "... We should be left in state '0'";
461isa_ok $state, 'FSA::State';
462is $state->name, 0, "... The name of the current state should be '0'";
463is $fsa->run, $fsa, "... Run should still work.";
464is $fsa->{count}, 3,
465  "... And it should have run through the proper number of again.";
466
467# Try done with a code refernce.
468ok $fsa = $CLASS->new(
469    0 => { rules => [ 1 => [ 1, sub { shift->machine->{count}++ } ] ] },
470    1 => { rules => [ 0 => [ 1 ] ] },
471), "Construct with simple states to test a done code ref";
472
473
474is $fsa->done( sub { shift->{count} == 3 }), $fsa,
475  "Set done to a code reference";
476$fsa->{count} = 0;
477is $fsa->run, $fsa, "... Run should still work.";
478is $fsa->{count}, 3,
479  "... And it should have run through the proper number of again.";
480
481# Check for duplicate states.
482eval { $CLASS->new( foo => {}, foo => {}) };
483ok $err = $@, 'Attempt to specify the same state twice should throw an error';
484like $err, qr/The state "foo" already exists/,
485  '... And that exception should have the proper message';
486
487# Try try_switch with parameters.
488my %prevs = ( 1 => 'foo', 2 => 'bar');
489ok $fsa = $CLASS->new(
490    foo => {
491        do => sub { shift->notes(test => 'foo') },
492        rules => [
493            bar => [ sub { $_[1]  eq 'bar' } ],
494            foo => [ sub { $_[1]  eq 'foo' } ],
495        ]
496    },
497    bar => {
498        do => sub {
499            my $state = shift;
500            isa_ok $state->prev_state, 'FSA::State',
501              "...state->prev_state should return a state object";
502            is $state->prev_state->name, $prevs{++$state->{count}},
503              "... state->prev_state should return the previous state";
504        },
505        rules => [
506            foo => [ sub { $_[1]  eq 'foo' } ],
507            bar => [ sub { $_[1]  eq 'bar' } ],
508        ]
509    }
510), 'Construct with switch rules that expect parameters.';
511
512
513ok my $foo = $fsa->start, "... It should start with 'foo'";
514isa_ok $foo, 'FSA::State';
515is $foo->name, 'foo', "... The name of the current state should be 'foo'";
516is $fsa->curr_state, $foo, "... The current state should be 'foo'";
517ok my $bar = $fsa->switch('bar'),
518  "... It should switch to 'bar' when passed 'bar'";
519isa_ok $bar, 'FSA::State';
520is $bar->name, 'bar', "... The name of the current state should be 'bar'";
521is $fsa->curr_state, $bar, "... The current state should be 'bar'";
522is $fsa->switch('bar'), $bar,
523  "... It should stay as 'bar' when passed 'bar' again";
524is $fsa->curr_state, $bar, "... So the state should still be 'bar'";
525is $fsa->try_switch('foo'), $foo,
526  "... It should switch back to 'foo' when passed 'foo'";
527is $fsa->curr_state, $foo, "... So the state should now be back to 'foo'";
528
529# Try some notes.
530is_deeply $fsa->notes, {test => 'foo'}, "Notes should start out empty";
531is $fsa->notes( key => 'val' ), $fsa,
532  "... And should get the machine back when setting a note";
533is $fsa->notes('key'), 'val',
534  "... And passing in the key should return the corresponding value";
535is $fsa->notes( my => 'machine' ), $fsa,
536  "We should get the machine back when setting another note";
537is $fsa->notes('my'), 'machine',
538  "... And passing in the key should return the new value";
539is_deeply $fsa->notes, { test => 'foo', key => 'val', my => 'machine' },
540  "... And passing in no arguments should return the complete notes hashref";
541$fsa->{should_not_exist_after_reset} = 1;
542$fsa->states('foo')->{should_not_exist_after_reset} = 1;
543
544# Try resetting.
545ok $fsa->done(1), "Set done to a true value";
546is_deeply $fsa->reset, $fsa, "... Calling reset() should return the machine";
547is_deeply $fsa, {}, "... it should be an empty hashref";
548is $fsa->done, undef, "... and 'done' should be reset to undef";
549is_deeply $fsa->states('foo'), {}, "... and the states should be empty, too";
550is $fsa->notes('key'), undef, '... And now passing in a key should return undef';
551is_deeply $fsa->notes, {}, "... and with no arguments, we should get an empty hash";
552
553# Try parameters to new().
554ok $fsa = $CLASS->new(
555    {
556        done   => 'done',
557        start  => 1,
558        strict => 1,
559    },
560    foo => {},
561    bar => {},
562), "Construct with a optional parameters";
563
564is $fsa->curr_state->name, 'foo',
565  "... And the engine should be started with the 'bar' state";
566is $fsa->done, 'done', '... And done should be set to "done"';
567is $fsa->strict, 1, "... And strict should be turned on";
568
569# Try strict.
570ok $fsa = $CLASS->new(
571    { strict => 1, start => 1 },
572    foo => { rules => [ bar => 1 ] },
573    bar => { rules => [ foo => 1, bar => 1 ] },
574), 'Constuct with strict enabled and multiple possible paths';
575
576is $fsa->curr_state->name, 'foo', "... The engine should be started";
577is $fsa->strict, 1, "... Strict should be enabled";
578is $fsa->switch->name, 'bar', "... The switch to 'bar' should succeed";
579eval { $fsa->try_switch };
580ok $err = $@, "... Try to switch from bar should throw an exception";
581like $err,
582  qr/Attempt to switch from state "bar" improperly found multiple destination states: "foo", "bar"/,
583  "... And the error message should be appropriate (and verbose)";
584
585can_ok $fsa, 'at';
586$fsa = $CLASS->new(
587   ping => {
588       do => sub { shift->machine->{count}++ },
589       rules => [
590           game_over => sub { shift->machine->{count} >= 20 },
591           pong      => 1,
592       ],
593   },
594   pong => {
595       rules => [ ping => 1, ], # always goes back to pong
596   },
597   game_over => {
598       do => sub { shift->machine->{save_this} = 1 },
599   },
600);
601
602$fsa->start;
603eval {$fsa->at};
604like $@, qr/You must supply a state name/,
605  '... and it should croak() if you do not supply a state name';
606eval {$fsa->at('no_such_state')};
607like $@, qr/No such state "no_such_state"/,
608  '... or if no state with the supplied name exists';
609$fsa->switch until $fsa->at('game_over');
610is $fsa->{count}, 20,
611  '... and it should terminate when I want it to.';
612is $fsa->{save_this}, 1,
613  '... and execute the "do" action.';
614
615# Try a valid strict.
616ok $fsa = $CLASS->new(
617    { strict => 1, start => 1 },
618    foo => { rules => [ bar => 1 ] },
619    bar => { rules => [ foo => 1, bar => 0 ] },
620), "Constuct with strict enabled and valid paths";
621
622is $fsa->curr_state->name, 'foo', "... The engine should be started";
623is $fsa->strict, 1, "... Strict should be enabled";
624is $fsa->switch->name, 'bar', "... The switch to 'bar' should succeed";
625is $fsa->switch->name, 'foo', "... The switch back to 'foo' should succeed";
626
627# Make sure that subclasses work.
628{
629    package FSA::Stately;
630    @FSA::Stately::ISA = qw(FSA::State);
631}
632
633ok $fsa = $CLASS->new( { state_class => 'FSA::Stately'}, foo => {} ),
634  "Construct with state_class";
635
636ok $foo = $fsa->states('foo'), 'Get "foo" state';
637isa_ok $foo, 'FSA::Stately';
638isa_ok $foo, 'FSA::State';
639
640ok $fsa = $CLASS->new( { start => 1,
641                         state_class => 'FSA::Stately',
642                         state_params  => { myarg => 'bar'} },
643                       foo => { rules => [ bar => 1 ]},
644                       bar => {},
645                   ),
646  "Construct with state_class";
647
648ok $foo = $fsa->states('foo'), 'Get "foo" state';
649isa_ok $foo, 'FSA::Stately';
650isa_ok $foo, 'FSA::State';
651isa_ok $fsa->curr_state, 'FSA::Stately';
652is $fsa->curr_state->name, 'foo';
653is $fsa->curr_state->{myarg}, 'bar';
654ok $fsa->try_switch;
655isa_ok $fsa->curr_state, 'FSA::Stately';
656is $fsa->curr_state->name, 'bar';
657is $fsa->curr_state->{myarg}, 'bar';
658
659# test that messages get set even if a state dies
660$fsa = $CLASS->new(
661    alpha => {
662        rules => [
663            omega => {
664                rule    => 1,
665                message => 'If I heard a voice from heaven ...'
666            }
667        ],
668    },
669    omega => { do => sub { die } },
670);
671$fsa->start;
672eval {$fsa->switch} until $fsa->at('omega');
673is $fsa->states('alpha')->message, 'If I heard a voice from heaven ...',
674  '... messages should be set even if the final state dies';
675
676# Test actions passed via a hash reference rule are executed.
677ok $fsa = $CLASS->new(
678    alpha => {
679        rules => [
680            beta => {
681                rule => 1,
682                action => sub { shift->machine->notes(goto_beta => 1) }
683            },
684            omega => {
685                rule    => 1,
686            }
687        ],
688    },
689    beta => {
690        rules => [
691            omega => {
692                rule    => 1,
693                action => [
694                    sub { shift->machine->notes(goto_omega => 1) },
695                    sub { shift->machine->notes(goto_omega2 => 2) },
696                ],
697            }
698        ],
699    },
700    omega => { },
701), "Construct to test for hashref rule actions";
702ok $fsa->start, "Start the machine";
703$fsa->switch until $fsa->at('omega');
704is $fsa->notes('goto_beta'), 1, '... Beta rule action should have executed';
705is $fsa->notes('goto_omega'), 1, '... Omega rule action should have executed';
706is $fsa->notes('goto_omega2'), 2,
707  '... Second omega rule action should have executed';
708
709##############################################################################
710# Regressions!
711my $i;
712ok my $rules = FSA::Rules->new(
713    { strict => 1 },
714    login => {
715        do => sub {
716            shift->notes( num => ++$i );
717        },
718        rules => [
719            login => sub {
720                shift->notes('num') <= 2;
721            },
722            next  => sub {
723                shift->notes('num') > 2;
724            }
725        ],
726    },
727    next => { do => sub { shift->done(1) } },
728), 'Create new rules with strict and dependency on do block';
729
730ok $rules->run, '... And they should run properly.';
731
732