From: gfx Date: Fri, 25 Sep 2009 07:34:34 +0000 (+0900) Subject: Move some test files X-Git-Tag: 0.35~22 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=179ac6cc0c1739d68f32ce43fafe59d342246bc6 Move some test files --- diff --git a/Makefile.PL b/Makefile.PL index 8344d3a..86154c9 100755 --- a/Makefile.PL +++ b/Makefile.PL @@ -15,6 +15,8 @@ test_requires 'Test::More' => 0.88; test_requires 'Test::Exception' => 0.27; test_requires 'Test::Output' => 0.16; +recommends 'MRO::Compat' if $] < 5.010; + if ($Module::Install::AUTHOR) { local @INC = ('lib', @INC); require 'lib/Mouse/Spec.pm'; @@ -51,8 +53,6 @@ sub create_moose_compatibility_test { '010-isa-or.t' => 'Mouse has a [BUG]', '044-attribute-metaclass.t' => 'Moose::Meta::Attribute does not have a "create"', '047-attribute-metaclass-role.t' => 'Moose::Meta::Attribute does not have a "create"', - '201-squirrel.t' => 'skip Squirrel', - '202-squirrel-role.t' => 'Squirrel is ...', '600-tiny-tiny.t' => "Moose doesn't support ::Tiny", '601-tiny-mouse.t' => "Moose doesn't support ::Tiny", '602-mouse-tiny.t' => "Moose doesn't support ::Tiny", @@ -66,7 +66,9 @@ sub create_moose_compatibility_test { wanted => sub { return unless -f $_; - return if /failing/; # skip tests in failing/ directories + return if /failing/; # skip tests in failing/ directories which are Moose specific + + return if /100_with_moose/; # tests with Moose my $basename = File::Basename::basename($_); return if $basename =~ /^\./; diff --git a/lib/Squirrel/Role.pm b/lib/Squirrel/Role.pm index 640c1c6..ce92b1e 100644 --- a/lib/Squirrel/Role.pm +++ b/lib/Squirrel/Role.pm @@ -28,7 +28,7 @@ __END__ =head1 NAME -Squirrel::Role - Use Mouse::Role, unless MooseRole is already loaded. (DEPRECATED) +Squirrel::Role - Use Mouse::Role, unless Moose::Role is already loaded. (DEPRECATED) =cut diff --git a/t/201-squirrel.t b/t/201-squirrel.t deleted file mode 100644 index daeed22..0000000 --- a/t/201-squirrel.t +++ /dev/null @@ -1,79 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More; -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; - - 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 { - plan skip_all => "Moose 0.68 required for this test" unless eval { require Moose && Moose->VERSION('0.68') }; - plan tests => 12; -} - -do { - package Bar; - use Squirrel; - - 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 " - 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'); - diff --git a/t/202-squirrel-role.t b/t/202-squirrel-role.t deleted file mode 100644 index 22eb9bf..0000000 --- a/t/202-squirrel-role.t +++ /dev/null @@ -1,68 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More; -use Scalar::Util 'blessed'; - -BEGIN { - $SIG{__WARN__} = sub { warn $_[0] if $_[0] !~ /Squirrel is deprecated/ }; -} - -do { - package Foo::Role; - use Squirrel::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 { - plan skip_all => "Moose 0.68 required for this test" unless eval { require Moose::Role && Moose::Role->VERSION('0.68') }; - plan tests => 6; -} - -do { - package Bar::Role; - use Squirrel::Role; - - has foo => ( - isa => "Int", - is => "rw", - ); - - no Squirrel::Role; -}; - -ok(!Foo::Role->can('has'), "Mouse::Role::has was unimported"); -SKIP: { - skip "ancient moose", 1 if $Moose::VERSION <= 0.50; - ok(!Bar::Role->can('has'), "Moose::Role::has was unimported"); -} - -eval " - 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'); - diff --git a/t/500_moose_extends_mouse.t b/t/500_moose_extends_mouse.t deleted file mode 100644 index bcb51dd..0000000 --- a/t/500_moose_extends_mouse.t +++ /dev/null @@ -1,123 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More; -use Test::Exception; -BEGIN { - plan skip_all => "Moose 0.68 required for this test" unless eval { require Moose && Moose->VERSION('0.68') }; - 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" ); -} diff --git a/t/501_moose_coerce_mouse.t b/t/501_moose_coerce_mouse.t deleted file mode 100644 index ce7ee0c..0000000 --- a/t/501_moose_coerce_mouse.t +++ /dev/null @@ -1,59 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More; -use Test::Exception; -BEGIN { - my $require_version = 0.68; - plan skip_all => "Moose $require_version required for this test" unless eval { require Moose && Moose->VERSION($require_version) }; - 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'); -}