--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+BEGIN{
+ if(eval{ require Class::Method::Modifiers::Fast } || eval{ require Class::Method::Modifiers }){
+ plan 'no_plan';
+ }
+ else{
+ plan skip_all => 'This test requires Class::Method::Modifiers(::Fast)?';
+ }
+}
+
+use Test::Exception;
+$| = 1;
+
+
+
+# =begin testing SETUP
+{
+
+ package BankAccount;
+ use Mouse;
+
+ has 'balance' => ( isa => 'Int', is => 'rw', default => 0 );
+
+ sub deposit {
+ my ( $self, $amount ) = @_;
+ $self->balance( $self->balance + $amount );
+ }
+
+ sub withdraw {
+ my ( $self, $amount ) = @_;
+ my $current_balance = $self->balance();
+ ( $current_balance >= $amount )
+ || confess "Account overdrawn";
+ $self->balance( $current_balance - $amount );
+ }
+
+ package CheckingAccount;
+ use Mouse;
+
+ extends 'BankAccount';
+
+ has 'overdraft_account' => ( isa => 'BankAccount', is => 'rw' );
+
+ before 'withdraw' => sub {
+ my ( $self, $amount ) = @_;
+ my $overdraft_amount = $amount - $self->balance();
+ if ( $self->overdraft_account && $overdraft_amount > 0 ) {
+ $self->overdraft_account->withdraw($overdraft_amount);
+ $self->deposit($overdraft_amount);
+ }
+ };
+}
+
+
+
+# =begin testing
+{
+my $savings_account;
+
+{
+ $savings_account = BankAccount->new( balance => 250 );
+ isa_ok( $savings_account, 'BankAccount' );
+
+ is( $savings_account->balance, 250, '... got the right savings balance' );
+ lives_ok {
+ $savings_account->withdraw(50);
+ }
+ '... withdrew from savings successfully';
+ is( $savings_account->balance, 200,
+ '... got the right savings balance after withdrawl' );
+
+ $savings_account->deposit(150);
+ is( $savings_account->balance, 350,
+ '... got the right savings balance after deposit' );
+}
+
+{
+ my $checking_account = CheckingAccount->new(
+ balance => 100,
+ overdraft_account => $savings_account
+ );
+ isa_ok( $checking_account, 'CheckingAccount' );
+ isa_ok( $checking_account, 'BankAccount' );
+
+ is( $checking_account->overdraft_account, $savings_account,
+ '... got the right overdraft account' );
+
+ is( $checking_account->balance, 100,
+ '... got the right checkings balance' );
+
+ lives_ok {
+ $checking_account->withdraw(50);
+ }
+ '... withdrew from checking successfully';
+ is( $checking_account->balance, 50,
+ '... got the right checkings balance after withdrawl' );
+ is( $savings_account->balance, 350,
+ '... got the right savings balance after checking withdrawl (no overdraft)'
+ );
+
+ lives_ok {
+ $checking_account->withdraw(200);
+ }
+ '... withdrew from checking successfully';
+ is( $checking_account->balance, 0,
+ '... got the right checkings balance after withdrawl' );
+ is( $savings_account->balance, 200,
+ '... got the right savings balance after overdraft withdrawl' );
+}
+
+{
+ my $checking_account = CheckingAccount->new(
+ balance => 100
+
+ # no overdraft account
+ );
+ isa_ok( $checking_account, 'CheckingAccount' );
+ isa_ok( $checking_account, 'BankAccount' );
+
+ is( $checking_account->overdraft_account, undef,
+ '... no overdraft account' );
+
+ is( $checking_account->balance, 100,
+ '... got the right checkings balance' );
+
+ lives_ok {
+ $checking_account->withdraw(50);
+ }
+ '... withdrew from checking successfully';
+ is( $checking_account->balance, 50,
+ '... got the right checkings balance after withdrawl' );
+
+ dies_ok {
+ $checking_account->withdraw(200);
+ }
+ '... withdrawl failed due to attempted overdraft';
+ is( $checking_account->balance, 50,
+ '... got the right checkings balance after withdrawl failure' );
+}
+}
+
+
+
+
+1;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+use Test::Exception;
+$| = 1;
+
+
+
+# =begin testing SETUP
+{
+
+ package BinaryTree;
+ use Mouse;
+
+ has 'node' => ( is => 'rw', isa => 'Any' );
+
+ has 'parent' => (
+ is => 'rw',
+ isa => 'BinaryTree',
+ predicate => 'has_parent',
+ weak_ref => 1,
+ );
+
+ has 'left' => (
+ is => 'rw',
+ isa => 'BinaryTree',
+ predicate => 'has_left',
+ lazy => 1,
+ default => sub { BinaryTree->new( parent => $_[0] ) },
+ trigger => \&_set_parent_for_child
+ );
+
+ has 'right' => (
+ is => 'rw',
+ isa => 'BinaryTree',
+ predicate => 'has_right',
+ lazy => 1,
+ default => sub { BinaryTree->new( parent => $_[0] ) },
+ trigger => \&_set_parent_for_child
+ );
+
+ sub _set_parent_for_child {
+ my ( $self, $child ) = @_;
+
+ confess "You cannot insert a tree which already has a parent"
+ if $child->has_parent;
+
+ $child->parent($self);
+ }
+}
+
+
+
+# =begin testing
+{
+use Scalar::Util 'isweak';
+
+my $root = BinaryTree->new(node => 'root');
+isa_ok($root, 'BinaryTree');
+
+is($root->node, 'root', '... got the right node value');
+
+ok(!$root->has_left, '... no left node yet');
+ok(!$root->has_right, '... no right node yet');
+
+ok(!$root->has_parent, '... no parent for root node');
+
+# make a left node
+
+my $left = $root->left;
+isa_ok($left, 'BinaryTree');
+
+is($root->left, $left, '... got the same node (and it is $left)');
+ok($root->has_left, '... we have a left node now');
+
+ok($left->has_parent, '... lefts has a parent');
+is($left->parent, $root, '... lefts parent is the root');
+
+ok(isweak($left->{parent}), '... parent is a weakened ref');
+
+ok(!$left->has_left, '... $left no left node yet');
+ok(!$left->has_right, '... $left no right node yet');
+
+is($left->node, undef, '... left has got no node value');
+
+lives_ok {
+ $left->node('left')
+} '... assign to lefts node';
+
+is($left->node, 'left', '... left now has a node value');
+
+# make a right node
+
+ok(!$root->has_right, '... still no right node yet');
+
+is($root->right->node, undef, '... right has got no node value');
+
+ok($root->has_right, '... now we have a right node');
+
+my $right = $root->right;
+isa_ok($right, 'BinaryTree');
+
+lives_ok {
+ $right->node('right')
+} '... assign to rights node';
+
+is($right->node, 'right', '... left now has a node value');
+
+is($root->right, $right, '... got the same node (and it is $right)');
+ok($root->has_right, '... we have a right node now');
+
+ok($right->has_parent, '... rights has a parent');
+is($right->parent, $root, '... rights parent is the root');
+
+ok(isweak($right->{parent}), '... parent is a weakened ref');
+
+# make a left node of the left node
+
+my $left_left = $left->left;
+isa_ok($left_left, 'BinaryTree');
+
+ok($left_left->has_parent, '... left does have a parent');
+
+is($left_left->parent, $left, '... got a parent node (and it is $left)');
+ok($left->has_left, '... we have a left node now');
+is($left->left, $left_left, '... got a left node (and it is $left_left)');
+
+ok(isweak($left_left->{parent}), '... parent is a weakened ref');
+
+# make a right node of the left node
+
+my $left_right = BinaryTree->new;
+isa_ok($left_right, 'BinaryTree');
+
+lives_ok {
+ $left->right($left_right)
+} '... assign to rights node';
+
+ok($left_right->has_parent, '... left does have a parent');
+
+is($left_right->parent, $left, '... got a parent node (and it is $left)');
+ok($left->has_right, '... we have a left node now');
+is($left->right, $left_right, '... got a left node (and it is $left_left)');
+
+ok(isweak($left_right->{parent}), '... parent is a weakened ref');
+
+# and check the error
+
+dies_ok {
+ $left_right->right($left_left)
+} '... cant assign a node which already has a parent';
+}
+
+
+
+
+1;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+BEGIN{
+ if(eval{ require Class::Method::Modifiers::Fast } || eval{ require Class::Method::Modifiers }){
+ eval 'use Regexp::Common; use Locale::US;';
+ if ($@) {
+ plan skip_all => 'Regexp::Common & Locale::US required for this test';
+ }
+ else{
+ plan 'no_plan';
+ }
+ }
+ else{
+ plan skip_all => 'This test requires Class::Method::Modifiers(::Fast)?';
+ }
+}
+
+use Test::Exception;
+$| = 1;
+
+
+
+# =begin testing SETUP
+BEGIN {
+ eval 'use Regexp::Common; use Locale::US;';
+ if ($@) {
+ plan skip_all => 'Regexp::Common & Locale::US required for this test';
+ }
+}
+
+
+
+# =begin testing SETUP
+{
+
+ package Address;
+ use Mouse;
+ use Mouse::Util::TypeConstraints;
+
+ use Locale::US;
+ use Regexp::Common 'zip';
+
+ my $STATES = Locale::US->new;
+ subtype 'USState'
+ => as Str
+ => where {
+ ( exists $STATES->{code2state}{ uc($_) }
+ || exists $STATES->{state2code}{ uc($_) } );
+ };
+
+ subtype 'USZipCode'
+ => as Value
+ => where {
+ /^$RE{zip}{US}{-extended => 'allow'}$/;
+ };
+
+ has 'street' => ( is => 'rw', isa => 'Str' );
+ has 'city' => ( is => 'rw', isa => 'Str' );
+ has 'state' => ( is => 'rw', isa => 'USState' );
+ has 'zip_code' => ( is => 'rw', isa => 'USZipCode' );
+
+ package Company;
+ use Mouse;
+ use Mouse::Util::TypeConstraints;
+
+ has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
+ has 'address' => ( is => 'rw', isa => 'Address' );
+ has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
+
+ sub BUILD {
+ my ( $self, $params ) = @_;
+ if ( @{ $self->employees || [] } ) {
+ foreach my $employee ( @{ $self->employees } ) {
+ $employee->employer($self);
+ }
+ }
+ }
+
+ after 'employees' => sub {
+ my ( $self, $employees ) = @_;
+ if ($employees) {
+ foreach my $employee ( @{$employees} ) {
+ $employee->employer($self);
+ }
+ }
+ };
+
+ package Person;
+ use Mouse;
+
+ has 'first_name' => ( is => 'rw', isa => 'Str', required => 1 );
+ has 'last_name' => ( is => 'rw', isa => 'Str', required => 1 );
+ has 'middle_initial' => (
+ is => 'rw', isa => 'Str',
+ predicate => 'has_middle_initial'
+ );
+ has 'address' => ( is => 'rw', isa => 'Address' );
+
+ sub full_name {
+ my $self = shift;
+ return $self->first_name
+ . (
+ $self->has_middle_initial
+ ? ' ' . $self->middle_initial . '. '
+ : ' '
+ ) . $self->last_name;
+ }
+
+ package Employee;
+ use Mouse;
+
+ extends 'Person';
+
+ has 'title' => ( is => 'rw', isa => 'Str', required => 1 );
+ has 'employer' => ( is => 'rw', isa => 'Company', weak_ref => 1 );
+
+ override 'full_name' => sub {
+ my $self = shift;
+ super() . ', ' . $self->title;
+ };
+}
+
+
+
+# =begin testing
+{
+{
+ package Company;
+
+ sub get_employee_count { scalar @{(shift)->employees} }
+}
+
+use Scalar::Util 'isweak';
+
+my $ii;
+lives_ok {
+ $ii = Company->new(
+ {
+ name => 'Infinity Interactive',
+ address => Address->new(
+ street => '565 Plandome Rd., Suite 307',
+ city => 'Manhasset',
+ state => 'NY',
+ zip_code => '11030'
+ ),
+ employees => [
+ Employee->new(
+ first_name => 'Jeremy',
+ last_name => 'Shao',
+ title => 'President / Senior Consultant',
+ address =>
+ Address->new( city => 'Manhasset', state => 'NY' )
+ ),
+ Employee->new(
+ first_name => 'Tommy',
+ last_name => 'Lee',
+ title => 'Vice President / Senior Developer',
+ address =>
+ Address->new( city => 'New York', state => 'NY' )
+ ),
+ Employee->new(
+ first_name => 'Stevan',
+ middle_initial => 'C',
+ last_name => 'Little',
+ title => 'Senior Developer',
+ address =>
+ Address->new( city => 'Madison', state => 'CT' )
+ ),
+ ]
+ }
+ );
+}
+'... created the entire company successfully';
+isa_ok( $ii, 'Company' );
+
+is( $ii->name, 'Infinity Interactive',
+ '... got the right name for the company' );
+
+isa_ok( $ii->address, 'Address' );
+is( $ii->address->street, '565 Plandome Rd., Suite 307',
+ '... got the right street address' );
+is( $ii->address->city, 'Manhasset', '... got the right city' );
+is( $ii->address->state, 'NY', '... got the right state' );
+is( $ii->address->zip_code, 11030, '... got the zip code' );
+
+is( $ii->get_employee_count, 3, '... got the right employee count' );
+
+# employee #1
+
+isa_ok( $ii->employees->[0], 'Employee' );
+isa_ok( $ii->employees->[0], 'Person' );
+
+is( $ii->employees->[0]->first_name, 'Jeremy',
+ '... got the right first name' );
+is( $ii->employees->[0]->last_name, 'Shao', '... got the right last name' );
+ok( !$ii->employees->[0]->has_middle_initial, '... no middle initial' );
+is( $ii->employees->[0]->middle_initial, undef,
+ '... got the right middle initial value' );
+is( $ii->employees->[0]->full_name,
+ 'Jeremy Shao, President / Senior Consultant',
+ '... got the right full name' );
+is( $ii->employees->[0]->title, 'President / Senior Consultant',
+ '... got the right title' );
+is( $ii->employees->[0]->employer, $ii, '... got the right company' );
+ok( isweak( $ii->employees->[0]->{employer} ),
+ '... the company is a weak-ref' );
+
+isa_ok( $ii->employees->[0]->address, 'Address' );
+is( $ii->employees->[0]->address->city, 'Manhasset',
+ '... got the right city' );
+is( $ii->employees->[0]->address->state, 'NY', '... got the right state' );
+
+# employee #2
+
+isa_ok( $ii->employees->[1], 'Employee' );
+isa_ok( $ii->employees->[1], 'Person' );
+
+is( $ii->employees->[1]->first_name, 'Tommy',
+ '... got the right first name' );
+is( $ii->employees->[1]->last_name, 'Lee', '... got the right last name' );
+ok( !$ii->employees->[1]->has_middle_initial, '... no middle initial' );
+is( $ii->employees->[1]->middle_initial, undef,
+ '... got the right middle initial value' );
+is( $ii->employees->[1]->full_name,
+ 'Tommy Lee, Vice President / Senior Developer',
+ '... got the right full name' );
+is( $ii->employees->[1]->title, 'Vice President / Senior Developer',
+ '... got the right title' );
+is( $ii->employees->[1]->employer, $ii, '... got the right company' );
+ok( isweak( $ii->employees->[1]->{employer} ),
+ '... the company is a weak-ref' );
+
+isa_ok( $ii->employees->[1]->address, 'Address' );
+is( $ii->employees->[1]->address->city, 'New York',
+ '... got the right city' );
+is( $ii->employees->[1]->address->state, 'NY', '... got the right state' );
+
+# employee #3
+
+isa_ok( $ii->employees->[2], 'Employee' );
+isa_ok( $ii->employees->[2], 'Person' );
+
+is( $ii->employees->[2]->first_name, 'Stevan',
+ '... got the right first name' );
+is( $ii->employees->[2]->last_name, 'Little', '... got the right last name' );
+ok( $ii->employees->[2]->has_middle_initial, '... got middle initial' );
+is( $ii->employees->[2]->middle_initial, 'C',
+ '... got the right middle initial value' );
+is( $ii->employees->[2]->full_name, 'Stevan C. Little, Senior Developer',
+ '... got the right full name' );
+is( $ii->employees->[2]->title, 'Senior Developer',
+ '... got the right title' );
+is( $ii->employees->[2]->employer, $ii, '... got the right company' );
+ok( isweak( $ii->employees->[2]->{employer} ),
+ '... the company is a weak-ref' );
+
+isa_ok( $ii->employees->[2]->address, 'Address' );
+is( $ii->employees->[2]->address->city, 'Madison', '... got the right city' );
+is( $ii->employees->[2]->address->state, 'CT', '... got the right state' );
+
+# create new company
+
+my $new_company
+ = Company->new( name => 'Infinity Interactive International' );
+isa_ok( $new_company, 'Company' );
+
+my $ii_employees = $ii->employees;
+foreach my $employee (@$ii_employees) {
+ is( $employee->employer, $ii, '... has the ii company' );
+}
+
+$new_company->employees($ii_employees);
+
+foreach my $employee ( @{ $new_company->employees } ) {
+ is( $employee->employer, $new_company,
+ '... has the different company now' );
+}
+
+## check some error conditions for the subtypes
+
+dies_ok {
+ Address->new( street => {} ),;
+}
+'... we die correctly with bad args';
+
+dies_ok {
+ Address->new( city => {} ),;
+}
+'... we die correctly with bad args';
+
+dies_ok {
+ Address->new( state => 'British Columbia' ),;
+}
+'... we die correctly with bad args';
+
+lives_ok {
+ Address->new( state => 'Connecticut' ),;
+}
+'... we live correctly with good args';
+
+dies_ok {
+ Address->new( zip_code => 'AF5J6$' ),;
+}
+'... we die correctly with bad args';
+
+lives_ok {
+ Address->new( zip_code => '06443' ),;
+}
+'... we live correctly with good args';
+
+dies_ok {
+ Company->new(),;
+}
+'... we die correctly without good args';
+
+lives_ok {
+ Company->new( name => 'Foo' ),;
+}
+'... we live correctly without good args';
+
+dies_ok {
+ Company->new( name => 'Foo', employees => [ Person->new ] ),;
+}
+'... we die correctly with good args';
+
+lives_ok {
+ Company->new( name => 'Foo', employees => [] ),;
+}
+'... we live correctly with good args';
+}
+
+
+
+
+1;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+use Test::Exception;
+$| = 1;
+
+
+
+# =begin testing SETUP
+BEGIN {
+ eval 'use HTTP::Headers; use Params::Coerce; use URI;';
+ if ($@) {
+ diag 'HTTP::Headers, Params::Coerce & URI required for this test';
+ ok(1);
+ exit 0;
+ }
+}
+
+
+
+# =begin testing SETUP
+{
+
+ package Request;
+ use Mouse;
+ use Mouse::Util::TypeConstraints;
+
+ use HTTP::Headers ();
+ use Params::Coerce ();
+ use URI ();
+
+ subtype 'My::Types::HTTP::Headers' => as class_type('HTTP::Headers');
+
+ coerce 'My::Types::HTTP::Headers'
+ => from 'ArrayRef'
+ => via { HTTP::Headers->new( @{$_} ) }
+ => from 'HashRef'
+ => via { HTTP::Headers->new( %{$_} ) };
+
+ subtype 'My::Types::URI' => as class_type('URI');
+
+ coerce 'My::Types::URI'
+ => from 'Object'
+ => via { $_->isa('URI')
+ ? $_
+ : Params::Coerce::coerce( 'URI', $_ ); }
+ => from 'Str'
+ => via { URI->new( $_, 'http' ) };
+
+ subtype 'Protocol'
+ => as 'Str'
+ => where { /^HTTP\/[0-9]\.[0-9]$/ };
+
+ has 'base' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
+ has 'uri' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
+ has 'method' => ( is => 'rw', isa => 'Str' );
+ has 'protocol' => ( is => 'rw', isa => 'Protocol' );
+ has 'headers' => (
+ is => 'rw',
+ isa => 'My::Types::HTTP::Headers',
+ coerce => 1,
+ default => sub { HTTP::Headers->new }
+ );
+}
+
+
+
+# =begin testing
+{
+my $r = Request->new;
+isa_ok( $r, 'Request' );
+
+{
+ my $header = $r->headers;
+ isa_ok( $header, 'HTTP::Headers' );
+
+ is( $r->headers->content_type, '',
+ '... got no content type in the header' );
+
+ $r->headers( { content_type => 'text/plain' } );
+
+ my $header2 = $r->headers;
+ isa_ok( $header2, 'HTTP::Headers' );
+ isnt( $header, $header2, '... created a new HTTP::Header object' );
+
+ is( $header2->content_type, 'text/plain',
+ '... got the right content type in the header' );
+
+ $r->headers( [ content_type => 'text/html' ] );
+
+ my $header3 = $r->headers;
+ isa_ok( $header3, 'HTTP::Headers' );
+ isnt( $header2, $header3, '... created a new HTTP::Header object' );
+
+ is( $header3->content_type, 'text/html',
+ '... got the right content type in the header' );
+
+ $r->headers( HTTP::Headers->new( content_type => 'application/pdf' ) );
+
+ my $header4 = $r->headers;
+ isa_ok( $header4, 'HTTP::Headers' );
+ isnt( $header3, $header4, '... created a new HTTP::Header object' );
+
+ is( $header4->content_type, 'application/pdf',
+ '... got the right content type in the header' );
+
+ dies_ok {
+ $r->headers('Foo');
+ }
+ '... dies when it gets bad params';
+}
+
+{
+ is( $r->protocol, undef, '... got nothing by default' );
+
+ lives_ok {
+ $r->protocol('HTTP/1.0');
+ }
+ '... set the protocol correctly';
+ is( $r->protocol, 'HTTP/1.0', '... got nothing by default' );
+
+ dies_ok {
+ $r->protocol('http/1.0');
+ }
+ '... the protocol died with bar params correctly';
+}
+
+{
+ $r->base('http://localhost/');
+ isa_ok( $r->base, 'URI' );
+
+ $r->uri('http://localhost/');
+ isa_ok( $r->uri, 'URI' );
+}
+}
+
+
+
+
+1;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+use Test::Exception;
+$| = 1;
+
+
+
+# =begin testing SETUP
+{
+
+ package Restartable;
+ use Mouse::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 Mouse::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 Mouse::Role;
+
+ with 'Restartable' => { -excludes => [ 'stop', 'start' ] };
+
+ sub stop {
+ my $self = shift;
+
+ $self->explode();
+ }
+
+ sub start {
+ my $self = shift;
+
+ $self->explode();
+ }
+}
+
+
+
+# =begin testing
+{
+{
+ my $unreliable = Mouse::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 = Mouse::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;
projects / gitmo/Mouse.git / commitdiff