From: Fuji, Goro <gfuji@cpan.org>
Date: Sat, 25 Sep 2010 04:48:43 +0000 (+0900)
Subject: Reorganize t/300_immutable/
X-Git-Tag: 0.72~24
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=16504b1548c2c3b2570a46b1864287f50d49faf2;p=gitmo%2FMouse.git

Reorganize t/300_immutable/
---

diff --git a/t/300_immutable/001_immutable_moose.t b/t/300_immutable/001_immutable_moose.t
index 2d72554..a9e0434 100644
--- a/t/300_immutable/001_immutable_moose.t
+++ b/t/300_immutable/001_immutable_moose.t
@@ -1,16 +1,16 @@
 #!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
 
 use strict;
 use warnings;
 
-use Test::More tests => 15;
+use Test::More;
 use Test::Exception;
 
-use Test::Mouse;
 use Mouse::Meta::Role;
 
-use lib 't/lib';
-use MooseCompat;
 
 {
     package FooRole;
@@ -44,10 +44,8 @@ use MooseCompat;
     is( Foo->new->bazes, 'many bazes',
         "correct value for 'bazes' before inlining constructor" );
     lives_ok { $meta->make_immutable } "Foo is imutable";
-
     lives_ok { $meta->identifier } "->identifier on metaclass lives";
-    dies_ok { $meta->add_role($foo_role) } "Add Role is locked";
-
+    #dies_ok { $meta->add_role($foo_role) } "Add Role is locked";
     lives_ok { Foo->new } "Inlined constructor works with lazy_build";
     is( Foo->new->foos, 'many foos',
         "correct value for 'foos'  after inlining constructor" );
@@ -55,11 +53,8 @@ use MooseCompat;
         "correct value for 'bars'  after inlining constructor" );
     is( Foo->new->bazes, 'many bazes',
         "correct value for 'bazes' after inlining constructor" );
-    SKIP: {
-        skip "Mouse doesn't supports make_mutable", 2;
-        lives_ok { $meta->make_mutable } "Foo is mutable";
-        lives_ok { $meta->add_role($foo_role) } "Add Role is unlocked";
-    };
+    lives_ok { $meta->make_mutable } "Foo is mutable";
+    #lives_ok { $meta->add_role($foo_role) } "Add Role is unlocked";
 
 }
 
@@ -92,3 +87,5 @@ lives_ok { Baz->meta->make_immutable }
 Nothing here yet, but soon :)
 
 =cut
+
+done_testing;
diff --git a/t/300_immutable/002_apply_roles_to_immutable.t b/t/300_immutable/002_apply_roles_to_immutable.t
new file mode 100644
index 0000000..e003a42
--- /dev/null
+++ b/t/300_immutable/002_apply_roles_to_immutable.t
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+
+{
+    package My::Role;
+    use Mouse::Role;
+
+    around 'baz' => sub {
+        my $next = shift;
+        'My::Role::baz(' . $next->(@_) . ')';
+    };
+}
+
+{
+    package Foo;
+    use Mouse;
+
+    sub baz { 'Foo::baz' }
+
+    __PACKAGE__->meta->make_immutable(debug => 0);
+}
+
+my $foo = Foo->new;
+isa_ok($foo, 'Foo');
+
+is($foo->baz, 'Foo::baz', '... got the right value');
+
+lives_ok {
+    My::Role->meta->apply($foo)
+} '... successfully applied the role to immutable instance';
+
+is($foo->baz, 'My::Role::baz(Foo::baz)', '... got the right value');
+
+done_testing;
diff --git a/t/300_immutable/003_immutable_meta_class.t b/t/300_immutable/003_immutable_meta_class.t
new file mode 100644
index 0000000..3728be1
--- /dev/null
+++ b/t/300_immutable/003_immutable_meta_class.t
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+
+{
+    package My::Meta;
+
+    use Mouse;
+
+    extends 'Mouse::Meta::Class';
+
+    has 'meta_size' => (
+        is  => 'rw',
+        isa => 'Int',
+    );
+}
+
+lives_ok {
+    My::Meta->meta()->make_immutable(debug => 0)
+} '... can make a meta class immutable';
+
+done_testing;
diff --git a/t/300_immutable/004_inlined_constructors_n_types.t b/t/300_immutable/004_inlined_constructors_n_types.t
index afee861..93967aa 100644
--- a/t/300_immutable/004_inlined_constructors_n_types.t
+++ b/t/300_immutable/004_inlined_constructors_n_types.t
@@ -1,9 +1,12 @@
 #!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
 
 use strict;
 use warnings;
 
-use Test::More tests => 10;
+use Test::More;
 use Test::Exception;
 
 =pod
@@ -11,7 +14,7 @@ use Test::Exception;
 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.
+as with a Mouse::Meta::Attribute object.
 
 =cut
 
@@ -59,5 +62,4 @@ for (1..2) {
     Foo->meta->make_immutable(debug => 0) unless $is_immutable;
 }
 
-
-
+done_testing;
diff --git a/t/300_immutable/005_multiple_demolish_inline.t b/t/300_immutable/005_multiple_demolish_inline.t
index 7b70107..a6d2f29 100644
--- a/t/300_immutable/005_multiple_demolish_inline.t
+++ b/t/300_immutable/005_multiple_demolish_inline.t
@@ -1,13 +1,15 @@
 #!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
 
 use strict;
 use warnings;
 
-use Test::More tests => 5;
+use Test::More;
 use Test::Exception;
 
 
-
 {
     package Foo;
     use Mouse;
@@ -44,3 +46,5 @@ lives_ok {
 
 is( Foo->meta->get_method('DESTROY')->package_name, 'Foo',
     'Foo has a DESTROY method in the Bar class (not inherited)' );
+
+done_testing;
diff --git a/t/300_immutable/007_immutable_trigger_from_constructor.t b/t/300_immutable/007_immutable_trigger_from_constructor.t
index 0ddcc5f..6e5cdb1 100644
--- a/t/300_immutable/007_immutable_trigger_from_constructor.t
+++ b/t/300_immutable/007_immutable_trigger_from_constructor.t
@@ -1,4 +1,7 @@
 #!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
 
 use strict;
 use warnings;
@@ -6,7 +9,6 @@ use warnings;
 use Test::More;
 use Test::Exception;
 
-plan tests => 3;
 
 {
     package AClass;
@@ -16,12 +18,12 @@ plan tests => 3;
     has 'foo' => (is => 'rw', isa => 'Maybe[Str]', trigger => sub {
         die "Pulling the Foo trigger\n"
     });
-    
-    has 'bar' => (is => 'rw', isa => 'Maybe[Str]');    
-    
+
+    has 'bar' => (is => 'rw', isa => 'Maybe[Str]');
+
     has 'baz' => (is => 'rw', isa => 'Maybe[Str]', trigger => sub {
         die "Pulling the Baz trigger\n"
-    });    
+    });
 
     __PACKAGE__->meta->make_immutable; #(debug => 1);
 
@@ -36,5 +38,4 @@ like ($@, qr/^Pulling the Baz trigger/, "trigger from immutable constructor");
 
 lives_ok { AClass->new(bar => 'bar') } '... no triggers called';
 
-
-
+done_testing;
diff --git a/t/300_immutable/008_immutable_constructor_error.t b/t/300_immutable/008_immutable_constructor_error.t
index d4af493..521d2f4 100644
--- a/t/300_immutable/008_immutable_constructor_error.t
+++ b/t/300_immutable/008_immutable_constructor_error.t
@@ -1,13 +1,15 @@
 #!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
 
 use strict;
 use warnings;
 
-use Test::More tests => 2;
+use Test::More;
 use Test::Exception;
 
 
-
 =pod
 
 This tests to make sure that we provide the same error messages from
@@ -30,4 +32,7 @@ throws_ok { Foo->new($scalar) } qr/\QSingle parameters to new() must be a HASH r
           'Non-ref provided to immutable constructor gives useful error message';
 throws_ok { Foo->new(\$scalar) } qr/\QSingle parameters to new() must be a HASH ref/,
           'Scalar ref provided to immutable constructor gives useful error message';
+throws_ok { Foo->new(undef) } qr/\QSingle parameters to new() must be a HASH ref/,
+          'undef provided to immutable constructor gives useful error message';
 
+done_testing;
diff --git a/t/300_immutable/009_buildargs.t b/t/300_immutable/009_buildargs.t
index 5f9a10a..b1e433b 100644
--- a/t/300_immutable/009_buildargs.t
+++ b/t/300_immutable/009_buildargs.t
@@ -1,16 +1,19 @@
 #!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
 
 use strict;
 use warnings;
 
-use Test::More tests => 14;
+use Test::More;
 
 {
     package Foo;
     use Mouse;
 
     has bar => ( is => "rw" );
-    has baz => ( is => "rw" );    
+    has baz => ( is => "rw" );
 
     sub BUILDARGS {
         my ( $self, @args ) = @_;
@@ -24,7 +27,7 @@ use Test::More tests => 14;
     use Mouse;
 
     extends qw(Foo);
-    
+
     __PACKAGE__->meta->make_immutable;
 }
 
@@ -32,12 +35,16 @@ foreach my $class qw(Foo Bar) {
     is( $class->new->bar, undef, "no args" );
     is( $class->new( bar => 42 )->bar, 42, "normal args" );
     is( $class->new( 37 )->bar, 37, "single arg" );
-    my $o = $class->new(bar => 42, baz => 47);
-    is($o->bar, 42, '... got the right bar');
-    is($o->baz, 47, '... got the right bar');
-    my $ob = $class->new(42, baz => 47);
-    is($ob->bar, 42, '... got the right bar');
-    is($ob->baz, 47, '... got the right bar');
+    {
+        my $o = $class->new(bar => 42, baz => 47);
+        is($o->bar, 42, '... got the right bar');
+        is($o->baz, 47, '... got the right bar');
+    }
+    {
+        my $o = $class->new(42, baz => 47);
+        is($o->bar, 42, '... got the right bar');
+        is($o->baz, 47, '... got the right bar');
+    }
 }
 
-
+done_testing;
diff --git a/t/300_immutable/012_default_values.t b/t/300_immutable/012_default_values.t
new file mode 100644
index 0000000..aca9bf8
--- /dev/null
+++ b/t/300_immutable/012_default_values.t
@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+{
+
+    package Foo;
+    use Mouse;
+
+    has 'foo' => ( is => 'rw', default => q{'} );
+    has 'bar' => ( is => 'rw', default => q{\\} );
+    has 'baz' => ( is => 'rw', default => q{"} );
+    has 'buz' => ( is => 'rw', default => q{"'\\} );
+    has 'faz' => ( is => 'rw', default => qq{\0} );
+
+    ::lives_ok {  __PACKAGE__->meta->make_immutable }
+        'no errors making a package immutable when it has default values that could break quoting';
+}
+
+my $foo = Foo->new;
+is( $foo->foo, q{'},
+    'default value for foo attr' );
+is( $foo->bar, q{\\},
+    'default value for bar attr' );
+is( $foo->baz, q{"},
+    'default value for baz attr' );
+is( $foo->buz, q{"'\\},
+    'default value for buz attr' );
+is( $foo->faz, qq{\0},
+    'default value for faz attr' );
+
+
+# Lazy attrs were never broken, but it doesn't hurt to test that they
+# won't be broken by any future changes.
+{
+
+    package Bar;
+    use Mouse;
+
+    has 'foo' => ( is => 'rw', default => q{'}, lazy => 1 );
+    has 'bar' => ( is => 'rw', default => q{\\}, lazy => 1 );
+    has 'baz' => ( is => 'rw', default => q{"}, lazy => 1 );
+    has 'buz' => ( is => 'rw', default => q{"'\\}, lazy => 1 );
+    has 'faz' => ( is => 'rw', default => qq{\0}, lazy => 1 );
+
+    ::lives_ok {  __PACKAGE__->meta->make_immutable }
+        'no errors making a package immutable when it has lazy default values that could break quoting';
+}
+
+my $bar = Bar->new;
+is( $bar->foo, q{'},
+    'default value for foo attr' );
+is( $bar->bar, q{\\},
+    'default value for bar attr' );
+is( $bar->baz, q{"},
+    'default value for baz attr' );
+is( $bar->buz, q{"'\\},
+    'default value for buz attr' );
+is( $bar->faz, qq{\0},
+    'default value for faz attr' );
+
+done_testing;
diff --git a/t/300_immutable/013_immutable_roundtrip.t b/t/300_immutable/013_immutable_roundtrip.t
new file mode 100644
index 0000000..04a4b24
--- /dev/null
+++ b/t/300_immutable/013_immutable_roundtrip.t
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Test::Requires {
+    'Test::Output' => '0.01', # skip all if not installed
+};
+
+{
+    package Foo;
+    use Mouse;
+    __PACKAGE__->meta->make_immutable;
+}
+
+{
+    package Bar;
+    use Mouse;
+
+    extends 'Foo';
+
+    __PACKAGE__->meta->make_immutable;
+    __PACKAGE__->meta->make_mutable;
+
+
+    # This actually is testing for a bug in Mouse::Meta that cause
+    # Mouse::Meta::Method to spit out a warning when it
+    # shouldn't have done so. The bug was fixed in CMOP 0.75.
+    ::stderr_unlike(
+        sub { Bar->meta->make_immutable },
+        qr/Not inlining a constructor/,
+        'no warning that Bar may not have an inlined constructor'
+    );
+}
+
+done_testing;
diff --git a/t/300_immutable/014_immutable_metaclass_with_traits.t b/t/300_immutable/014_immutable_metaclass_with_traits.t
new file mode 100644
index 0000000..708dbcd
--- /dev/null
+++ b/t/300_immutable/014_immutable_metaclass_with_traits.t
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+use strict;
+use warnings;
+use Test::More;
+
+{
+    package FooTrait;
+    use Mouse::Role;
+}
+{
+    package Foo;
+    use Mouse -traits => ['FooTrait'];
+}
+
+is(Mouse::Util::class_of('Foo'), Foo->meta,
+    "class_of and ->meta are the same on Foo");
+my $meta = Foo->meta;
+is(Mouse::Util::class_of($meta), $meta->meta,
+    "class_of and ->meta are the same on Foo's metaclass");
+isa_ok(Mouse::Util::class_of($meta), 'Mouse::Meta::Class');
+isa_ok($meta->meta, 'Mouse::Meta::Class');
+ok($meta->is_mutable, "class is mutable");
+ok(Mouse::Util::class_of($meta)->is_mutable, "metaclass is mutable");
+ok($meta->meta->does_role('FooTrait'), "does the trait");
+Foo->meta->make_immutable;
+is(Mouse::Util::class_of('Foo'), Foo->meta,
+    "class_of and ->meta are the same on Foo (immutable)");
+$meta = Foo->meta;
+isa_ok($meta->meta, 'Mouse::Meta::Class');
+ok($meta->is_immutable, "class is immutable");
+{ local $TODO = 'Mouse dos not support $meta->meta->is_immutable';
+ok($meta->meta->is_immutable, "metaclass is immutable (immutable class)");
+}
+is(Mouse::Util::class_of($meta), $meta->meta,
+    "class_of and ->meta are the same on Foo's metaclass (immutable)");
+isa_ok(Mouse::Util::class_of($meta), 'Mouse::Meta::Class');
+ok($meta->meta->does_role('FooTrait'), "still does the trait after immutable");
+
+done_testing;
diff --git a/t/300_immutable/016_inline_fallbacks.t b/t/300_immutable/016_inline_fallbacks.t
new file mode 100644
index 0000000..8a5635b
--- /dev/null
+++ b/t/300_immutable/016_inline_fallbacks.t
@@ -0,0 +1,73 @@
+use strict;
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+use warnings;
+use Test::More;
+
+{
+    package Foo;
+    use Mouse;
+    has foo => (is => 'ro');
+}
+
+{
+    package Foo::Sub;
+    use Mouse;
+    extends 'Foo';
+    has bar => (is => 'ro');
+}
+
+{
+    my $foo = Foo::Sub->new(foo => 12, bar => 25);
+    is($foo->foo, 12, 'got right value for foo');
+    is($foo->bar, 25, 'got right value for bar');
+}
+
+Foo->meta->make_immutable;
+
+{
+    package Foo::Sub2;
+    use Mouse;
+    extends 'Foo';
+    has baz => (is => 'ro');
+    # not making immutable, inheriting Foo's inlined constructor
+}
+
+{
+    my $foo = Foo::Sub2->new(foo => 42, baz => 27);
+    is($foo->foo, 42, 'got right value for foo');
+    is($foo->baz, 27, 'got right value for baz');
+}
+
+my $BAR = 0;
+{
+    package Bar;
+    use Mouse;
+}
+
+{
+    package Bar::Sub;
+    use Mouse;
+    extends 'Bar';
+    sub DEMOLISH { $BAR++ }
+}
+
+Bar::Sub->new;
+is($BAR, 1, 'DEMOLISH in subclass was called');
+$BAR = 0;
+
+Bar->meta->make_immutable;
+
+{
+    package Bar::Sub2;
+    use Mouse;
+    extends 'Bar';
+    sub DEMOLISH { $BAR++ }
+    # not making immutable, inheriting Bar's inlined destructor
+}
+
+Bar::Sub2->new;
+is($BAR, 1, 'DEMOLISH in subclass was called');
+
+done_testing;