0.33_02
* Make sure to work on 5.6.2
+ * Remove testing modules from inc/
+
0.33_01 Thu Sep 24 16:16:57 2009
* Implement traits => [...] in has() (gfx)
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Mouse::Spec;
+
+use Scalar::Util 'blessed';
+
+# Don't spew deprecation warnings onto the user's screen
+BEGIN {
+ $SIG{__WARN__} = sub { warn $_[0] if $_[0] !~ /Squirrel is deprecated/ };
+}
+
+do {
+ package Foo;
+ use Squirrel; # load Mouse
+
+ has foo => (
+ isa => "Int",
+ is => "rw",
+ );
+
+ no Squirrel;
+};
+
+# note that 'Foo' is defined before this, to prevent Moose being loaded from
+# affecting its definition
+BEGIN {
+ eval{ require Moose && Moose->VERSION(Mouse::Spec->MooseVersion) };
+ plan skip_all => "Moose $Mouse::Spec::MooseVersion required for this test" if $@;
+ plan tests => 12;
+}
+
+do {
+ package Bar;
+ use Squirrel; # load Moose
+
+ has foo => (
+ isa => "Int",
+ is => "rw",
+ );
+
+ no Squirrel;
+};
+
+my $foo = Foo->new(foo => 3);
+isa_ok($foo, "Foo");
+isa_ok($foo, "Mouse::Object");
+is($foo->foo, 3, "accessor");
+
+my $bar = Bar->new(foo => 3);
+isa_ok($bar, "Bar");
+isa_ok($bar, "Moose::Object");
+is($bar->foo, 3, "accessor");
+
+ok(!Foo->can('has'), "Mouse::has was unimported");
+ok(!Bar->can('has'), "Moose::has was unimported");
+
+eval q{
+ package Foo;
+ use Squirrel;
+
+ has bar => (is => 'rw');
+ __PACKAGE__->meta->make_immutable;
+
+ package Bar;
+ use Squirrel;
+
+ has bar => (is => 'rw');
+ __PACKAGE__->meta->make_immutable;
+};
+warn $@ if $@;
+
+is(blessed(Foo->meta->get_attribute('foo')), 'Mouse::Meta::Attribute');
+is(blessed(Foo->meta->get_attribute('bar')), 'Mouse::Meta::Attribute', 'Squirrel is consistent if Moose was loaded between imports');
+
+is(blessed(Bar->meta->get_attribute('foo')), 'Moose::Meta::Attribute');
+is(blessed(Bar->meta->get_attribute('bar')), 'Moose::Meta::Attribute');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Mouse::Spec;
+
+use Scalar::Util 'blessed';
+
+BEGIN {
+ $SIG{__WARN__} = sub { warn $_[0] if $_[0] !~ /Squirrel is deprecated/ };
+}
+
+do {
+ package Foo::Role;
+ use Squirrel::Role; # loa Mouse::Role
+
+ has foo => (
+ isa => "Int",
+ is => "rw",
+ );
+
+ no Squirrel::Role;
+};
+
+# note that 'Foo' is defined before this, to prevent Moose being loaded from
+# affecting its definition
+
+BEGIN {
+ eval{ require Moose::Role && Moose::Role->VERSION(Mouse::Spec->MooseVersion) };
+ plan skip_all => "Moose $Mouse::Spec::MooseVersion required for this test" if $@;
+ plan tests => 6;
+}
+
+do {
+ package Bar::Role;
+ use Squirrel::Role; # load Moose::Role
+
+ has foo => (
+ isa => "Int",
+ is => "rw",
+ );
+
+ no Squirrel::Role;
+};
+
+ok(!Foo::Role->can('has'), "Mouse::Role::has was unimported");
+ok(!Bar::Role->can('has'), "Moose::Role::has was unimported");
+
+eval q{
+ package Foo::Role;
+ use Squirrel::Role;
+
+ has bar => (is => 'rw');
+
+ package Bar::Role;
+ use Squirrel::Role;
+
+ has bar => (is => 'rw');
+};
+
+isa_ok(Foo::Role->meta, 'Mouse::Meta::Role');
+isa_ok(Foo::Role->meta, 'Mouse::Meta::Role');
+
+isa_ok(Bar::Role->meta, 'Moose::Meta::Role');
+isa_ok(Bar::Role->meta, 'Moose::Meta::Role');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Mouse::Spec;
+BEGIN {
+ eval{ require Moose && Moose->VERSION(Mouse::Spec->MooseVersion) };
+ plan skip_all => "Moose $Mouse::Spec::MooseVersion required for this test" if $@;
+ plan tests => 27;
+}
+
+use Test::Exception;
+
+{
+ package Foo;
+ use Mouse;
+
+ has foo => (
+ isa => "Int",
+ is => "rw",
+ );
+
+ package Bar;
+ use Moose;
+
+ ::lives_ok { extends qw(Foo) } "extend Mouse class with Moose";
+
+ ::lives_ok {
+ has bar => (
+ isa => "Str",
+ is => "rw",
+ );
+ } "new attr in subclass";
+
+ package Gorch;
+ use Moose;
+
+ ::lives_ok { extends qw(Foo) } "extend Mouse class with Moose";
+
+ {
+ local our $TODO = "Moose not yet aware of Mouse meta";
+ ::lives_ok {
+ has '+foo' => (
+ default => 3,
+ );
+ } "clone and inherit attr in subclass";
+ }
+
+ package Quxx;
+ use Mouse;
+
+ has quxx => (
+ is => "rw",
+ default => "lala",
+ );
+
+ package Zork;
+ use Moose;
+
+ ::lives_ok { extends qw(Quxx) } "extend Mouse class with Moose";
+
+ has zork => (
+ is => "rw",
+ default => 42,
+ );
+}
+
+can_ok( Bar => "new" );
+
+my $bar = eval { Bar->new };
+
+ok( $bar, "got an object" );
+isa_ok( $bar, "Bar" );
+isa_ok( $bar, "Foo" );
+
+can_ok( $bar, qw(foo bar) );
+
+is( eval { $bar->foo }, undef, "no default value" );
+is( eval { $bar->bar }, undef, "no default value" );
+
+{
+ local $TODO = "Moose not yet aware of Mouse meta";
+
+ is_deeply(
+ [ sort map { $_->name } Bar->meta->get_all_attributes ],
+ [ sort qw(foo bar) ],
+ "attributes",
+ );
+
+ is( eval { Gorch->new->foo }, 3, "cloned and inherited attr's default" );
+}
+
+can_ok( Zork => "new" );
+
+{
+ my $zork = eval { Zork->new };
+
+ ok( $zork, "got an object" );
+ isa_ok( $zork, "Zork" );
+ isa_ok( $zork, "Quxx" );
+
+ can_ok( $zork, qw(quxx zork) );
+
+ local $TODO = "Constructor needs to know default values of attrs from both";
+ is( eval { $bar->quxx }, "lala", "default value" );
+ is( eval { $bar->zork }, 42, "default value" );
+}
+
+{
+ my $zork = eval { Zork->new( zork => "diff", quxx => "blah" ) };
+
+ ok( $zork, "got an object" );
+ isa_ok( $zork, "Zork" );
+ isa_ok( $zork, "Quxx" );
+
+ can_ok( $zork, qw(quxx zork) );
+
+ local $TODO = "Constructor needs to know init args of attrs from both";
+ is( eval { $bar->quxx }, "blah", "constructor param" );
+ is( eval { $bar->zork }, "diff", "constructor param" );
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Mouse::Spec;
+BEGIN {
+ eval{ require Moose && Moose->VERSION(Mouse::Spec->MooseVersion) };
+ plan skip_all => "Moose $Mouse::Spec::MooseVersion required for this test" if $@;
+ plan tests => 5;
+}
+
+use Test::Exception;
+
+{
+ package Headers;
+ use Mouse;
+ has 'foo' => ( is => 'rw' );
+}
+{
+ package Response;
+ use Mouse;
+ use Mouse::Util::TypeConstraints;
+
+ type 'HeadersType' => where { defined $_ && eval { $_->isa('Headers') } };
+ coerce 'HeadersType' =>
+ from 'HashRef' => via {
+ Headers->new(%{ $_ });
+ },
+ ;
+
+ has headers => (
+ is => 'rw',
+ isa => 'HeadersType',
+ coerce => 1,
+ );
+}
+{
+ package Mosponse;
+ use Moose;
+ extends qw(Response);
+ ::lives_ok { extends qw(Response) } "extend Mouse class with Moose";
+}
+
+{
+ my $r = Mosponse->new(headers => { foo => 'bar' });
+ isa_ok($r->headers, 'Headers');
+ lives_and {
+ is $r->headers->foo, 'bar';
+ };
+}
+
+{
+ my $r = Mosponse->new;
+ $r->headers({foo => 'yay'});
+ isa_ok($r->headers, 'Headers');
+ is($r->headers->foo, 'yay');
+}
use strict;
use warnings;
use Mouse ();
-use Test::More tests => 20;
+use Test::More tests => 19;
use Test::Exception;
# error handling
);
} qr/You must pass a HASH ref of methods/;
-
-throws_ok {
- Mouse::Meta::Class->create()
-} qr/You must pass a package name/;
-
# normal cases
isa_ok(Mouse::Meta::Class->create("FooBar"), "Mouse::Meta::Class");
is FooBar->meta->name, "FooBar";
projects / gitmo/Mouse.git / commitdiff