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