diff options
author | Jesse Luehrs <doy@tozt.net> | 2011-04-29 18:05:42 -0500 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2011-04-29 18:05:42 -0500 |
commit | ffa87f12e2999ab231c79bd1c87276cd22cf3385 (patch) | |
tree | 86df8f938d40925c91494609993fb62f951a9714 /t | |
parent | dcbef0c5087b132303acb7d57184aeb84ff6cce0 (diff) | |
download | moosex-nonmoose-ffa87f12e2999ab231c79bd1c87276cd22cf3385.tar.gz moosex-nonmoose-ffa87f12e2999ab231c79bd1c87276cd22cf3385.zip |
allow this to work with arbitrarily named constructors
Diffstat (limited to 't')
-rw-r--r-- | t/11-constructor-name.t | 108 | ||||
-rw-r--r-- | t/26-no-new-constructor-error.t | 7 |
2 files changed, 113 insertions, 2 deletions
diff --git a/t/11-constructor-name.t b/t/11-constructor-name.t new file mode 100644 index 0000000..4d790eb --- /dev/null +++ b/t/11-constructor-name.t @@ -0,0 +1,108 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Fatal; +use Test::Moose; + +{ + package Foo; + + sub create { + my $class = shift; + my %params = @_; + bless { foo => ($params{foo} || 'FOO') }, $class; + } + + sub foo { shift->{foo} } +} + +{ + package Foo::Sub; + use Moose; + use MooseX::NonMoose; + + extends 'Foo' => { -constructor_name => 'create' }; + + has bar => ( + is => 'ro', + isa => 'Str', + default => 'BAR', + ); +} + +with_immutable { + my $foo = Foo::Sub->create; + is($foo->foo, 'FOO', "nonmoose constructor called"); + is($foo->bar, 'BAR', "moose constructor called"); +} 'Foo::Sub'; + +{ + package Foo::BadSub; + use Moose; + use MooseX::NonMoose; + + ::like( + ::exception { + extends 'Foo' => { -constructor_name => 'something_else' }; + }, + qr/You specified 'something_else' as the constructor for Foo, but Foo has no method by that name/, + "specifying an incorrect constructor name dies" + ); +} + +{ + package Foo::Mixin; + + sub thing { + return shift->foo . 'BAZ'; + } +} + +{ + package Foo::Sub2; + use Moose; + use MooseX::NonMoose; + + extends 'Foo::Mixin', 'Foo' => { -constructor_name => 'create' }; + + has bar => ( + is => 'ro', + isa => 'Str', + default => 'BAR', + ); +} + +with_immutable { + my $foo = Foo::Sub2->create; + is($foo->foo, 'FOO', "nonmoose constructor called"); + is($foo->bar, 'BAR', "moose constructor called"); + is($foo->thing, 'FOOBAZ', "mixin still works"); +} 'Foo::Sub2'; + +{ + package Bar; + + sub make { + my $class = shift; + my %params = @_; + bless { baz => ($params{baz} || 'BAZ') }, $class; + } +} + +{ + package Foo::Bar::Sub; + use Moose; + use MooseX::NonMoose; + + ::like( + ::exception { + extends 'Bar' => { -constructor_name => 'make' }, + 'Foo' => { -constructor_name => 'create' }; + }, + qr/You have already specified Bar::make as the parent constructor; Foo::create cannot also be the constructor/, + "can't specify two parent constructors" + ); +} + +done_testing; diff --git a/t/26-no-new-constructor-error.t b/t/26-no-new-constructor-error.t index 4dbc944..2becbce 100644 --- a/t/26-no-new-constructor-error.t +++ b/t/26-no-new-constructor-error.t @@ -18,8 +18,11 @@ use Test::More; my $warning; local $SIG{__WARN__} = sub { $warning = $_[0] }; __PACKAGE__->meta->make_immutable; - ::like($warning, qr/Not inlining.*doesn't contain a 'new' method/, - "warning when trying to make_immutable without a superclass 'new'"); + ::like( + $warning, + qr/Not inlining.*doesn't contain a constructor named 'new'/, + "warning when trying to make_immutable without a superclass 'new'" + ); } } |