view release on metacpan or  search on metacpan

t/base/turn.t  view on Meta::CPAN

# $Id: turn.t 564 2025-02-13 21:33:15Z whynot $
# Copyright 2013, 2022 Eric Pozharski <whynot@pozharski.name>
# Copyright 2025 Eric Pozharski <wayside.ultimate@tuta.io>
# GNU GPLv3
# AS-IS, NO-WARRANTY, HOPE-TO-BE-USEFUL

use strict;
use warnings;

package main;
use version 0.77; our $VERSION = version->declare( v2.3.3 );

use t::TestSuite qw| :diag :wraps |;
use Test::More;

use Acme::FSM;
use List::Util qw| sum |;

our( $bb, $rc, $stderr );
my %st = ( );
my %opts   = ( diag_level => -t STDOUT ? 10 : 1 );
my $method = q|turn|;

my @data =
([ '', [qw| init |], { }                                             ],
 [         q|no args, no fst|,
  [qw|                pass |],
  [                         ],
  [                0, undef ],
  qr.(?m)^\Q[turn]: no args .                                        ],
 [                       '',
  [qw|              init |],
  { KNOPPIX =>      undef,
    Kiwi    => q|BackBox|,
    Tuquito => [        ],
    DEFT    =>  sub { 1 } },                                         ],
 [             q|entry isa missing|,
  [qw|                      pass |],
  [qw|                     Linvo |],
  [                      4, undef ],
  qr.(?m)\Q(Linvo): no such {fst} .                                  ],
 [                    q|entry isa undef|,
  [qw|                           fail |],
  [qw|                        KNOPPIX |],
  qr.\Q{KNOPPIX}(): entry !isa defined .                             ],
 [           q|entry isa scalar|,
  [qw|                   fail |],
  [qw|                   Kiwi |],
  qr.\Q{Kiwi}(): entry isa (), .                                     ],
 [                  q|entry isa (ARRAY)|,
  [qw|                           fail |],
  [qw|                        Tuquito |],
  qr.\Q{Tuquito}(): entry isa (ARRAY), .                             ],
 [
  q|entry isa (CODE)|,
  [qw| fail |],
  [qw| DEFT |],
  qr.\Q{DEFT}(): entry isa (CODE), .                                 ],
 [                                                                '',
  [qw|                                                       init |],
  { KNOPPIX  => {                                                },
    Kiwi     => {                                 tturn => undef },
    Tuquito  => {                                 fturn => undef },
    Linvo    => {                 tturn => undef, fturn => undef },
    Plamo    => {                                 eturn => undef },
    Gentoo   => {                                 uturn => undef },
    Emmabunt => { tturn => undef, fturn => undef, turns => undef } } ],
 [                           q|empty entry|,
  [qw|                              pass |],
  [qw|                           KNOPPIX |],
  [                              7, undef ],
  qr.(?m)\Q{KNOPPIX}: none supported turn .                          ],
 [   q|lone {tturn}|,
  [qw| pass quiet |],
  [qw|       Kiwi |],
  [          7, '' ]                                                 ],
 [   q|lone {fturn}|,
  [qw| pass quiet |],
  [qw|    Tuquito |],

t/base/turn.t  view on Meta::CPAN

  [qw|                     pass quiet |],
  [qw|                 CONTINUE tturn |],
  [ 4,          [ q|Caixa_M_gica|, '' ]]                             ],
 [ q|{CONTINUE}{fturn} action isa undef|,
  [qw|                     pass quiet |],
  [qw|                 CONTINUE fturn |],
  [ 4,                [ q|Macpup|, '' ]]                             ],
 [        q|{BREAK}{eturn} action isa undef|,
  [qw|                               fail |],
  [qw|                        BREAK eturn |],
  qr.\Q{BREAK}(eturn): action !isa defined .                         ],
 [        q|{BREAK}{uturn} action isa undef|,
  [qw|                               fail |],
  [qw|                        BREAK uturn |],
  qr.\Q{BREAK}(uturn): action !isa defined .                         ],
 [        q|{BREAK}{tturn} action isa undef|,
  [qw|                               fail |],
  [qw|                        BREAK tturn |],
  qr.\Q{BREAK}(tturn): action !isa defined .                         ],
 [        q|{BREAK}{fturn} action isa undef|,
  [qw|                               fail |],
  [qw|                        BREAK fturn |],
  qr.\Q{BREAK}(fturn): action !isa defined .                         ],
 [                                                               '',
  [qw|                                                      init |],
  { START    => { turns => { KNOPPIX => [ q|BackBox|,   undef ]}},
    STOP     => { turns => { Kiwi    => [ q|aLinux|,    undef ]}},
    CONTINUE => { turns => { Tuquito => [ q|EasyPeasy|, undef ]}},
    BREAK    => { turns => { DEFT    => [ q|CAELinux|,  undef ]}} }  ],
 [ q|{START}{turns} action isa undef|,
  [qw|                  pass quiet |],
  [qw|          START turn%KNOPPIX |],
  [ 4,            [ q|BackBox|, '' ]]                                ],
 [            q|{STOP}{turns} action isa undef|,
  [qw|                                  fail |],
  [qw|                        STOP turn%Kiwi |],
  qr.\Q{STOP}(turn%Kiwi): action !isa defined .                      ],
 [ q|{CONTINUE}{turns} action isa undef|,
  [qw|                     pass quiet |],
  [qw|          CONTINUE turn%Tuquito |],
  [ 4,             [ q|EasyPeasy|, '' ]]                             ],
 [            q|{BREAK}{turns} action isa undef|,
  [qw|                                   fail |],
  [qw|                        BREAK turn%DEFT |],
  qr.\Q{BREAK}(turn%DEFT): action !isa defined .                     ] );

plan tests => sum map                  {
    grep( $_ eq q|init|,  @$_ ) ? 0 :
    grep( $_ eq q|fail|,  @$_ ) ? 1 :
    grep( $_ eq q|quiet|, @$_ ) ? 1 : 2 }
                  map {         $_->[1] } @data;

foreach my $unit ( @data )                                           {
    if( grep $_ eq q|init|, @{$unit->[1]}    )                      {
        %st = %{$unit->[2]};
        AFSMTS_class_wrap { %opts }, \%st                            }
    elsif( grep $_ eq q|pass|, @{$unit->[1]} )                      {
        AFSMTS_method_wrap $method, @{$unit->[2]};
        is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], $unit->[3],
          qq|$unit->[0], queried|;
        like $stderr, $unit->[4], qq|$unit->[0], noted|                 unless
          grep $_ eq q|quiet|, @{$unit->[1]}                         }
    elsif( grep $_ eq q|fail|, @{$unit->[1]} )                      {
        AFSMTS_method_wrap $method, @{$unit->[2]};
        like $@, $unit->[3], AFSMTS_croakson qq|$unit->[0], queried| }}

# vim: set filetype=perl