From: gfx <gfuji@cpan.org>
Date: Wed, 30 Sep 2009 11:31:44 +0000 (+0900)
Subject: Copy two test files from Moose
X-Git-Tag: 0.37_01~18
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1ca8d984eebed4163f3fa3b892bee910f93a6d7b;p=gitmo%2FMouse.git

Copy two test files from Moose
---

diff --git a/t/300_immutable/004_inlined_constructors_n_types.t b/t/300_immutable/004_inlined_constructors_n_types.t
new file mode 100755
index 0000000..afee861
--- /dev/null
+++ b/t/300_immutable/004_inlined_constructors_n_types.t
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 10;
+use Test::Exception;
+
+=pod
+
+This tests to make sure that the inlined constructor
+has all the type constraints in order, even in the
+cases when there is no type constraint available, such
+as with a Class::MOP::Attribute object.
+
+=cut
+
+{
+    package Foo;
+    use Mouse;
+    use Mouse::Util::TypeConstraints;
+
+    coerce 'Int' => from 'Str' => via { length $_ ? $_ : 69 };
+
+    has 'foo' => (is => 'rw', isa => 'Int');
+    has 'baz' => (is => 'rw', isa => 'Int');
+    has 'zot' => (is => 'rw', isa => 'Int', init_arg => undef);
+    has 'moo' => (is => 'rw', isa => 'Int', coerce => 1, default => '', required => 1);
+    has 'boo' => (is => 'rw', isa => 'Int', coerce => 1, builder => '_build_boo', required => 1);
+
+    sub _build_boo { '' }
+
+    Foo->meta->add_attribute(
+        Mouse::Meta::Attribute->new(
+            'bar' => (
+                accessor => 'bar',
+            )
+        )
+    );
+}
+
+for (1..2) {
+    my $is_immutable   = Foo->meta->is_immutable;
+    my $mutable_string = $is_immutable ? 'immutable' : 'mutable';
+    lives_ok {
+        my $f = Foo->new(foo => 10, bar => "Hello World", baz => 10, zot => 4);
+        is($f->moo, 69, "Type coercion works as expected on default ($mutable_string)");
+        is($f->boo, 69, "Type coercion works as expected on builder ($mutable_string)");
+    } "... this passes the constuctor correctly ($mutable_string)";
+
+    lives_ok {
+        Foo->new(foo => 10, bar => "Hello World", baz => 10, zot => "not an int");
+    } "... the constructor doesn't care about 'zot' ($mutable_string)";
+
+    dies_ok {
+        Foo->new(foo => "Hello World", bar => 100, baz => "Hello World");
+    } "... this fails the constuctor correctly ($mutable_string)";
+
+    Foo->meta->make_immutable(debug => 0) unless $is_immutable;
+}
+
+
+
diff --git a/t/300_immutable/005_multiple_demolish_inline.t b/t/300_immutable/005_multiple_demolish_inline.t
new file mode 100755
index 0000000..7b70107
--- /dev/null
+++ b/t/300_immutable/005_multiple_demolish_inline.t
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+use Test::Exception;
+
+
+
+{
+    package Foo;
+    use Mouse;
+
+    has 'foo' => (is => 'rw', isa => 'Int');
+
+    sub DEMOLISH { }
+}
+
+{
+    package Bar;
+    use Mouse;
+
+    extends qw(Foo);
+    has 'bar' => (is => 'rw', isa => 'Int');
+
+    sub DEMOLISH { }
+}
+
+lives_ok {
+    Bar->new();
+} 'Bar->new()';
+
+lives_ok {
+    Bar->meta->make_immutable;
+} 'Bar->meta->make_immutable';
+
+is( Bar->meta->get_method('DESTROY')->package_name, 'Bar',
+    'Bar has a DESTROY method in the Bar class (not inherited)' );
+
+lives_ok {
+    Foo->meta->make_immutable;
+} 'Foo->meta->make_immutable';
+
+is( Foo->meta->get_method('DESTROY')->package_name, 'Foo',
+    'Foo has a DESTROY method in the Bar class (not inherited)' );