#!/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;
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" );
"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";
}
Nothing here yet, but soon :)
=cut
+
+done_testing;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
#!/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
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
Foo->meta->make_immutable(debug => 0) unless $is_immutable;
}
-
-
+done_testing;
#!/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;
is( Foo->meta->get_method('DESTROY')->package_name, 'Foo',
'Foo has a DESTROY method in the Bar class (not inherited)' );
+
+done_testing;
#!/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;
-plan tests => 3;
{
package AClass;
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);
lives_ok { AClass->new(bar => 'bar') } '... no triggers called';
-
-
+done_testing;
#!/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
'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;
#!/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 ) = @_;
use Mouse;
extends qw(Foo);
-
+
__PACKAGE__->meta->make_immutable;
}
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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+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;
projects / gitmo/Mouse.git / commitdiff