Beta Shell v2.0

File Manager

Name	Size	Perms	Modified	Actions
[ .. / .. ]
basics_bankaccount_methodmodifiersandsubclassing.t	3.71 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_binarytree_attributefeatures.t	3.83 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_company_subtypes.t	9.54 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_datetime_extendingnonmooseparent.t	1.16 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_document_augmentandinner.t	1.45 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_genome_overloadingsubtypesandcoercion.t	5.2 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_http_subtypesandcoercion.t	3.24 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_point_attributesandsubclassing.t	5.35 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
extending_debugging_baseclassrole.t	755 B	-rw-r--r--	2019-10-21 09:36:33	Edit Del
extending_mooseish_moosesugar.t	983 B	-rw-r--r--	2019-10-21 09:36:33	Edit Del
legacy_debugging_baseclassreplacement.t	953 B	-rw-r--r--	2019-10-21 09:36:33	Edit Del
legacy_labeled_attributemetaclass.t	1.52 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
meta_globref_instancemetaclass.t	3.23 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
meta_labeled_attributetrait.t	1.43 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
meta_privateorpublic_methodmetaclass.t	1.93 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
meta_table_metaclasstrait.t	798 B	-rw-r--r--	2019-10-21 09:36:33	Edit Del
roles_applicationtoinstance.t	1.73 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
roles_comparable_codereuse.t	5.16 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
roles_restartable_advancedcomposition.t	2 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del

Editing: roles_restartable_advancedcomposition.t (2 KB)

#!/usr/bin/perl -w

use strict;
use Test::More 'no_plan';
use Test::Fatal;
$| = 1;



# =begin testing SETUP
{

  package Restartable;
  use Moose::Role;

  has 'is_paused' => (
      is      => 'rw',
      isa     => 'Bool',
      default => 0,
  );

  requires 'save_state', 'load_state';

  sub stop { 1 }

  sub start { 1 }

  package Restartable::ButUnreliable;
  use Moose::Role;

  with 'Restartable' => {
      -alias => {
          stop  => '_stop',
          start => '_start'
      },
      -excludes => [ 'stop', 'start' ],
  };

  sub stop {
      my $self = shift;

      $self->explode() if rand(1) > .5;

      $self->_stop();
  }

  sub start {
      my $self = shift;

      $self->explode() if rand(1) > .5;

      $self->_start();
  }

  package Restartable::ButBroken;
  use Moose::Role;

  with 'Restartable' => { -excludes => [ 'stop', 'start' ] };

  sub stop {
      my $self = shift;

      $self->explode();
  }

  sub start {
      my $self = shift;

      $self->explode();
  }
}



# =begin testing
{
{
    my $unreliable = Moose::Meta::Class->create_anon_class(
        superclasses => [],
        roles        => [qw/Restartable::ButUnreliable/],
        methods      => {
            explode      => sub { },    # nop.
            'save_state' => sub { },
            'load_state' => sub { },
        },
    )->new_object();
    ok( $unreliable, 'made anon class with Restartable::ButUnreliable role' );
    can_ok( $unreliable, qw/start stop/ );
}

{
    my $cnt    = 0;
    my $broken = Moose::Meta::Class->create_anon_class(
        superclasses => [],
        roles        => [qw/Restartable::ButBroken/],
        methods      => {
            explode      => sub { $cnt++ },
            'save_state' => sub { },
            'load_state' => sub { },
        },
    )->new_object();

    ok( $broken, 'made anon class with Restartable::ButBroken role' );

    $broken->start();

    is( $cnt, 1, '... start called explode' );

    $broken->stop();

    is( $cnt, 2, '... stop also called explode' );
}
}




1;