From 8bf5e6931a1bd96df0cdb1ceb94bbb3e578a8126 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Wed, 4 Sep 2013 19:38:21 -0400 Subject: packaging --- .mailmap | 1 + .travis.yml | 14 ++++ dist.ini | 16 ++-- lib/MooseX/NonMoose.pm | 17 ++--- lib/MooseX/NonMoose/Meta/Role/Constructor.pm | 2 +- t/01-basic.t | 34 --------- t/02-methods.t | 27 ------- t/03-attrs.t | 38 ---------- t/04-multi-level.t | 57 -------------- t/05-moose.t | 53 ------------- t/06-disable.t | 35 --------- t/07-extends-moose-object.t | 33 -------- t/10-immutable.t | 45 ----------- t/11-constructor-name.t | 108 --------------------------- t/12-reinitialize.t | 32 -------- t/20-BUILD.t | 58 -------------- t/21-BUILDARGS.t | 40 ---------- t/22-replaced-constructor.t | 64 ---------------- t/23-FOREIGNBUILDARGS.t | 72 ------------------ t/24-nonmoose-moose-nonmoose.t | 85 --------------------- t/25-constructor-method-calls.t | 47 ------------ t/26-no-new-constructor-error.t | 43 ----------- t/30-only-metaclass-trait.t | 24 ------ t/31-moose-exporter.t | 77 ------------------- t/32-moosex-insideout.t | 81 -------------------- t/33-moosex-globref.t | 88 ---------------------- t/40-destructor.t | 30 -------- t/50-buggy-constructor-inlining.t | 37 --------- t/51-buggy-constructors.t | 94 ----------------------- t/52-hashref-constructor.t | 67 ----------------- t/60-extends-version.t | 21 ------ t/BUILD.t | 58 ++++++++++++++ t/BUILDARGS.t | 40 ++++++++++ t/FOREIGNBUILDARGS.t | 72 ++++++++++++++++++ t/attrs.t | 38 ++++++++++ t/basic.t | 34 +++++++++ t/buggy-constructor-inlining.t | 37 +++++++++ t/buggy-constructors.t | 94 +++++++++++++++++++++++ t/constructor-method-calls.t | 47 ++++++++++++ t/constructor-name.t | 108 +++++++++++++++++++++++++++ t/destructor.t | 30 ++++++++ t/disable.t | 35 +++++++++ t/extends-moose-object.t | 33 ++++++++ t/extends-version.t | 21 ++++++ t/hashref-constructor.t | 67 +++++++++++++++++ t/immutable.t | 45 +++++++++++ t/methods.t | 27 +++++++ t/moose-exporter.t | 77 +++++++++++++++++++ t/moose.t | 53 +++++++++++++ t/moosex-globref.t | 88 ++++++++++++++++++++++ t/moosex-insideout.t | 81 ++++++++++++++++++++ t/multi-level.t | 57 ++++++++++++++ t/no-new-constructor-error.t | 43 +++++++++++ t/nonmoose-moose-nonmoose.t | 85 +++++++++++++++++++++ t/only-metaclass-trait.t | 24 ++++++ t/reinitialize.t | 32 ++++++++ t/replaced-constructor.t | 64 ++++++++++++++++ weaver.ini | 33 -------- 58 files changed, 1423 insertions(+), 1440 deletions(-) create mode 100644 .mailmap create mode 100644 .travis.yml delete mode 100644 t/01-basic.t delete mode 100644 t/02-methods.t delete mode 100644 t/03-attrs.t delete mode 100644 t/04-multi-level.t delete mode 100644 t/05-moose.t delete mode 100644 t/06-disable.t delete mode 100644 t/07-extends-moose-object.t delete mode 100644 t/10-immutable.t delete mode 100644 t/11-constructor-name.t delete mode 100644 t/12-reinitialize.t delete mode 100644 t/20-BUILD.t delete mode 100644 t/21-BUILDARGS.t delete mode 100644 t/22-replaced-constructor.t delete mode 100644 t/23-FOREIGNBUILDARGS.t delete mode 100644 t/24-nonmoose-moose-nonmoose.t delete mode 100644 t/25-constructor-method-calls.t delete mode 100644 t/26-no-new-constructor-error.t delete mode 100644 t/30-only-metaclass-trait.t delete mode 100644 t/31-moose-exporter.t delete mode 100644 t/32-moosex-insideout.t delete mode 100644 t/33-moosex-globref.t delete mode 100644 t/40-destructor.t delete mode 100644 t/50-buggy-constructor-inlining.t delete mode 100644 t/51-buggy-constructors.t delete mode 100644 t/52-hashref-constructor.t delete mode 100644 t/60-extends-version.t create mode 100644 t/BUILD.t create mode 100644 t/BUILDARGS.t create mode 100644 t/FOREIGNBUILDARGS.t create mode 100644 t/attrs.t create mode 100644 t/basic.t create mode 100644 t/buggy-constructor-inlining.t create mode 100644 t/buggy-constructors.t create mode 100644 t/constructor-method-calls.t create mode 100644 t/constructor-name.t create mode 100644 t/destructor.t create mode 100644 t/disable.t create mode 100644 t/extends-moose-object.t create mode 100644 t/extends-version.t create mode 100644 t/hashref-constructor.t create mode 100644 t/immutable.t create mode 100644 t/methods.t create mode 100644 t/moose-exporter.t create mode 100644 t/moose.t create mode 100644 t/moosex-globref.t create mode 100644 t/moosex-insideout.t create mode 100644 t/multi-level.t create mode 100644 t/no-new-constructor-error.t create mode 100644 t/nonmoose-moose-nonmoose.t create mode 100644 t/only-metaclass-trait.t create mode 100644 t/reinitialize.t create mode 100644 t/replaced-constructor.t delete mode 100644 weaver.ini diff --git a/.mailmap b/.mailmap new file mode 100644 index 0000000..b6ec5fd --- /dev/null +++ b/.mailmap @@ -0,0 +1 @@ +Jesse Luehrs doy diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..655229f --- /dev/null +++ b/.travis.yml @@ -0,0 +1,14 @@ +language: perl +perl: + - "5.19" + - "5.18" + - "5.16" + - "5.14" + - "5.12" + - "5.10" +install: + - cpanm -q --notest Dist::Zilla || (cat /home/travis/.cpanm/build.log; false) + - dzil authordeps --missing | cpanm -q --notest || (cat /home/travis/.cpanm/build.log; false) + - dzil listdeps --author --missing | cpanm -q --notest || (cat /home/travis/.cpanm/build.log; false) +script: + - dzil test --all diff --git a/dist.ini b/dist.ini index 862627e..cc2fef7 100644 --- a/dist.ini +++ b/dist.ini @@ -1,14 +1,16 @@ name = MooseX-NonMoose -author = Jesse Luehrs +author = Jesse Luehrs license = Perl_5 copyright_holder = Jesse Luehrs [@DOY] +:version = 0.14 dist = MooseX-NonMoose +repository = github -[Prereqs] -Moose = 1.15 -List::MoreUtils = 0 - -[Prereqs / TestRequires] -Test::Fatal = 0 +[AutoPrereqs] +skip = ^BadFoo\d?\b +skip = ^Foo\b +skip = ^Bar\b +skip = ^NonMoose$ +skip = ^IO:: diff --git a/lib/MooseX/NonMoose.pm b/lib/MooseX/NonMoose.pm index 5a989e0..cd57406 100644 --- a/lib/MooseX/NonMoose.pm +++ b/lib/MooseX/NonMoose.pm @@ -114,9 +114,8 @@ normal Moose classes. =back -Please report any bugs through RT: email -C, or browse to -L. +Please report any bugs to GitHub Issues at +L. =head1 SEE ALSO @@ -141,21 +140,21 @@ You can also look for information at: =over 4 -=item * AnnoCPAN: Annotated CPAN documentation +=item * MetaCPAN -L +L -=item * CPAN Ratings +=item * Github -L +L =item * RT: CPAN's request tracker L -=item * Search CPAN +=item * CPAN Ratings -L +L =back diff --git a/lib/MooseX/NonMoose/Meta/Role/Constructor.pm b/lib/MooseX/NonMoose/Meta/Role/Constructor.pm index 272bc95..42602fa 100644 --- a/lib/MooseX/NonMoose/Meta/Role/Constructor.pm +++ b/lib/MooseX/NonMoose/Meta/Role/Constructor.pm @@ -1,5 +1,5 @@ package MooseX::NonMoose::Meta::Role::Constructor; -use Moose::Role; +use Moose::Role 1.15; # ABSTRACT: constructor method trait for L =head1 SYNOPSIS diff --git a/t/01-basic.t b/t/01-basic.t deleted file mode 100644 index 8995d6d..0000000 --- a/t/01-basic.t +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -package Foo; - -sub new { - my $class = shift; - bless { _class => $class }, $class; -} - -package Foo::Moose; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -package main; -my $foo = Foo->new; -my $foo_moose = Foo::Moose->new; -isa_ok($foo, 'Foo'); -is($foo->{_class}, 'Foo', 'Foo gets the correct class'); -isa_ok($foo_moose, 'Foo::Moose'); -isa_ok($foo_moose, 'Foo'); -isa_ok($foo_moose, 'Moose::Object'); -is($foo_moose->{_class}, 'Foo::Moose', 'Foo::Moose gets the correct class'); -my $meta = Foo::Moose->meta; -ok($meta->has_method('new'), 'Foo::Moose has its own constructor'); -my $cc_meta = $meta->constructor_class->meta; -isa_ok($cc_meta, 'Moose::Meta::Class'); -ok($cc_meta->does_role('MooseX::NonMoose::Meta::Role::Constructor'), - 'Foo::Moose gets its constructor from MooseX::NonMoose'); - -done_testing; diff --git a/t/02-methods.t b/t/02-methods.t deleted file mode 100644 index c02438c..0000000 --- a/t/02-methods.t +++ /dev/null @@ -1,27 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -package Foo; - -sub new { bless {}, shift } -sub foo { 'Foo' } -sub bar { 'Foo' } -sub baz { ref(shift) } - -package Foo::Moose; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -sub bar { 'Foo::Moose' } - -package main; - -my $foo_moose = Foo::Moose->new; -is($foo_moose->foo, 'Foo', 'Foo::Moose->foo'); -is($foo_moose->bar, 'Foo::Moose', 'Foo::Moose->bar'); -is($foo_moose->baz, 'Foo::Moose', 'Foo::Moose->baz'); - -done_testing; diff --git a/t/03-attrs.t b/t/03-attrs.t deleted file mode 100644 index 7451ddc..0000000 --- a/t/03-attrs.t +++ /dev/null @@ -1,38 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -package Foo; - -sub new { - my $class = shift; - bless { @_ }, $class; -} - -sub foo { - my $self = shift; - return $self->{foo} unless @_; - $self->{foo} = shift; -} - -package Foo::Moose; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -has bar => ( - is => 'rw', -); - -package main; - -my $foo_moose = Foo::Moose->new(foo => 'FOO', bar => 'BAR'); -is($foo_moose->foo, 'FOO', 'foo set in constructor'); -is($foo_moose->bar, 'BAR', 'bar set in constructor'); -$foo_moose->foo('BAZ'); -$foo_moose->bar('QUUX'); -is($foo_moose->foo, 'BAZ', 'foo set by accessor'); -is($foo_moose->bar, 'QUUX', 'bar set by accessor'); - -done_testing; diff --git a/t/04-multi-level.t b/t/04-multi-level.t deleted file mode 100644 index 5201c47..0000000 --- a/t/04-multi-level.t +++ /dev/null @@ -1,57 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -package Foo; - -sub new { - my $class = shift; - bless { foo => 'FOO' }, $class; -} - -sub foo { shift->{foo} } - -package Foo::Moose; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -has bar => ( - is => 'ro', - default => 'BAR', -); - -package Foo::Moose::Sub; -use Moose; -extends 'Foo::Moose'; - -has baz => ( - is => 'ro', - default => 'BAZ', -); - -package main; -my $foo_moose = Foo::Moose->new; -is($foo_moose->foo, 'FOO', 'Foo::Moose::foo'); -is($foo_moose->bar, 'BAR', 'Foo::Moose::bar'); -isnt(Foo::Moose->meta->get_method('new'), undef, - 'Foo::Moose gets its own constructor'); - -my $foo_moose_sub = Foo::Moose::Sub->new; -is($foo_moose_sub->foo, 'FOO', 'Foo::Moose::Sub::foo'); -is($foo_moose_sub->bar, 'BAR', 'Foo::Moose::Sub::bar'); -is($foo_moose_sub->baz, 'BAZ', 'Foo::Moose::Sub::baz'); -is(Foo::Moose::Sub->meta->get_method('new'), undef, - 'Foo::Moose::Sub just uses the constructor for Foo::Moose'); - -Foo::Moose->meta->make_immutable; -Foo::Moose::Sub->meta->make_immutable; -$foo_moose_sub = Foo::Moose::Sub->new; -is($foo_moose_sub->foo, 'FOO', 'Foo::Moose::Sub::foo (immutable)'); -is($foo_moose_sub->bar, 'BAR', 'Foo::Moose::Sub::bar (immutable)'); -is($foo_moose_sub->baz, 'BAZ', 'Foo::Moose::Sub::baz (immutable)'); -isnt(Foo::Moose::Sub->meta->get_method('new'), undef, - 'Foo::Moose::Sub has an inlined constructor'); - -done_testing; diff --git a/t/05-moose.t b/t/05-moose.t deleted file mode 100644 index e4f8d39..0000000 --- a/t/05-moose.t +++ /dev/null @@ -1,53 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -package Foo; -use Moose; - -has foo => ( - is => 'ro', - default => 'FOO', -); - -package Foo::Sub; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -package main; -my $foo_sub = Foo::Sub->new; -isa_ok($foo_sub, 'Foo'); -is($foo_sub->foo, 'FOO', 'inheritance works'); -ok(!Foo::Sub->meta->has_method('new'), - 'Foo::Sub doesn\'t have its own new method'); - -$_->meta->make_immutable for qw(Foo Foo::Sub); - -$foo_sub = Foo::Sub->new; -isa_ok($foo_sub, 'Foo'); -is($foo_sub->foo, 'FOO', 'inheritance works (immutable)'); -ok(Foo::Sub->meta->has_method('new'), - 'Foo::Sub has its own new method (immutable)'); - -package Foo::OtherSub; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -package main; -my $foo_othersub = Foo::OtherSub->new; -isa_ok($foo_othersub, 'Foo'); -is($foo_othersub->foo, 'FOO', 'inheritance works (immutable when extending)'); -ok(!Foo::OtherSub->meta->has_method('new'), - 'Foo::OtherSub doesn\'t have its own new method (immutable when extending)'); - -Foo::OtherSub->meta->make_immutable; -$foo_othersub = Foo::OtherSub->new; -isa_ok($foo_othersub, 'Foo'); -is($foo_othersub->foo, 'FOO', 'inheritance works (all immutable)'); -ok(Foo::OtherSub->meta->has_method('new'), - 'Foo::OtherSub has its own new method (all immutable)'); - -done_testing; diff --git a/t/06-disable.t b/t/06-disable.t deleted file mode 100644 index 73b9ed1..0000000 --- a/t/06-disable.t +++ /dev/null @@ -1,35 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -package Foo; - -sub new { - my $class = shift; - bless {}, $class; -} - -package Foo::Moose; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -package Foo::Moose2; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -package main; - -ok(Foo::Moose->meta->has_method('new'), 'Foo::Moose has a constructor'); -my $method = Foo::Moose->meta->get_method('new'); -Foo::Moose->meta->make_immutable; -isnt($method, Foo::Moose->meta->get_method('new'), - 'make_immutable replaced the constructor with an inlined version'); -my $method2 = Foo::Moose2->meta->get_method('new'); -Foo::Moose2->meta->make_immutable(inline_constructor => 0); -is($method2, Foo::Moose2->meta->get_method('new'), - 'make_immutable doesn\'t replace the constructor if we ask it not to'); - -done_testing; diff --git a/t/07-extends-moose-object.t b/t/07-extends-moose-object.t deleted file mode 100644 index 699dfe5..0000000 --- a/t/07-extends-moose-object.t +++ /dev/null @@ -1,33 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -{ - package Foo; - sub new { bless {}, shift } -} - -{ - package Foo::Sub; - use Moose; - use MooseX::NonMoose; - extends 'Foo'; -} - -{ - package Bar; - use Moose; -} - -{ - package Bar::Sub; - use Moose; - use MooseX::NonMoose; - extends 'Bar'; -} - -is_deeply(\@Foo::Sub::ISA, ['Foo', 'Moose::Object'], "Moose::Object was added"); -is_deeply(\@Bar::Sub::ISA, ['Bar'], "Moose::Object wasn't added"); - -done_testing; diff --git a/t/10-immutable.t b/t/10-immutable.t deleted file mode 100644 index 275b387..0000000 --- a/t/10-immutable.t +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -package Foo; - -sub new { - my $class = shift; - bless { @_ }, $class; -} - -sub foo { - my $self = shift; - return $self->{foo} unless @_; - $self->{foo} = shift; -} - -sub baz { 'Foo' } -sub quux { ref(shift) } - -package Foo::Moose; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -has bar => ( - is => 'rw', -); - -__PACKAGE__->meta->make_immutable; - -package main; - -my $foo_moose = Foo::Moose->new(foo => 'FOO', bar => 'BAR'); -is($foo_moose->foo, 'FOO', 'foo set in constructor'); -is($foo_moose->bar, 'BAR', 'bar set in constructor'); -$foo_moose->foo('BAZ'); -$foo_moose->bar('QUUX'); -is($foo_moose->foo, 'BAZ', 'foo set by accessor'); -is($foo_moose->bar, 'QUUX', 'bar set by accessor'); -is($foo_moose->baz, 'Foo', 'baz method'); -is($foo_moose->quux, 'Foo::Moose', 'quux method'); - -done_testing; diff --git a/t/11-constructor-name.t b/t/11-constructor-name.t deleted file mode 100644 index 4d790eb..0000000 --- a/t/11-constructor-name.t +++ /dev/null @@ -1,108 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Fatal; -use Test::Moose; - -{ - package Foo; - - sub create { - my $class = shift; - my %params = @_; - bless { foo => ($params{foo} || 'FOO') }, $class; - } - - sub foo { shift->{foo} } -} - -{ - package Foo::Sub; - use Moose; - use MooseX::NonMoose; - - extends 'Foo' => { -constructor_name => 'create' }; - - has bar => ( - is => 'ro', - isa => 'Str', - default => 'BAR', - ); -} - -with_immutable { - my $foo = Foo::Sub->create; - is($foo->foo, 'FOO', "nonmoose constructor called"); - is($foo->bar, 'BAR', "moose constructor called"); -} 'Foo::Sub'; - -{ - package Foo::BadSub; - use Moose; - use MooseX::NonMoose; - - ::like( - ::exception { - extends 'Foo' => { -constructor_name => 'something_else' }; - }, - qr/You specified 'something_else' as the constructor for Foo, but Foo has no method by that name/, - "specifying an incorrect constructor name dies" - ); -} - -{ - package Foo::Mixin; - - sub thing { - return shift->foo . 'BAZ'; - } -} - -{ - package Foo::Sub2; - use Moose; - use MooseX::NonMoose; - - extends 'Foo::Mixin', 'Foo' => { -constructor_name => 'create' }; - - has bar => ( - is => 'ro', - isa => 'Str', - default => 'BAR', - ); -} - -with_immutable { - my $foo = Foo::Sub2->create; - is($foo->foo, 'FOO', "nonmoose constructor called"); - is($foo->bar, 'BAR', "moose constructor called"); - is($foo->thing, 'FOOBAZ', "mixin still works"); -} 'Foo::Sub2'; - -{ - package Bar; - - sub make { - my $class = shift; - my %params = @_; - bless { baz => ($params{baz} || 'BAZ') }, $class; - } -} - -{ - package Foo::Bar::Sub; - use Moose; - use MooseX::NonMoose; - - ::like( - ::exception { - extends 'Bar' => { -constructor_name => 'make' }, - 'Foo' => { -constructor_name => 'create' }; - }, - qr/You have already specified Bar::make as the parent constructor; Foo::create cannot also be the constructor/, - "can't specify two parent constructors" - ); -} - -done_testing; diff --git a/t/12-reinitialize.t b/t/12-reinitialize.t deleted file mode 100644 index 5e4aa11..0000000 --- a/t/12-reinitialize.t +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Fatal; - -{ - package Foo; - sub new { bless {}, shift } -} - -{ - package Foo::Meta::Role; - use Moose::Role; -} - -{ - package Foo::Sub; - use Moose; - use MooseX::NonMoose; - extends 'Foo'; - Moose::Util::MetaRole::apply_metaroles( - for => __PACKAGE__, - class_metaroles => { - class => ['Foo::Meta::Role'], - }, - ); - ::is(::exception { __PACKAGE__->meta->make_immutable }, undef, - "can make_immutable after reinitialization"); -} - -done_testing; diff --git a/t/20-BUILD.t b/t/20-BUILD.t deleted file mode 100644 index d5cc68f..0000000 --- a/t/20-BUILD.t +++ /dev/null @@ -1,58 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -package Foo; - -sub new { - my $class = shift; - bless { foo => 'FOO' }, $class; -} - -package Foo::Moose; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -has class => ( - is => 'rw', -); - -has accum => ( - is => 'rw', - isa => 'Str', - default => '', -); - -sub BUILD { - my $self = shift; - $self->class(ref $self); - $self->accum($self->accum . 'a'); -} - -package Foo::Moose::Sub; -use Moose; -extends 'Foo::Moose'; - -has bar => ( - is => 'rw', -); - -sub BUILD { - my $self = shift; - $self->bar('BAR'); - $self->accum($self->accum . 'b'); -} - -package main; -my $foo_moose = Foo::Moose->new; -is($foo_moose->class, 'Foo::Moose', 'BUILD method called properly'); -is($foo_moose->accum, 'a', 'BUILD method called properly'); - -my $foo_moose_sub = Foo::Moose::Sub->new; -is($foo_moose_sub->class, 'Foo::Moose::Sub', 'parent BUILD method called'); -is($foo_moose_sub->bar, 'BAR', 'child BUILD method called'); -is($foo_moose_sub->accum, 'ab', 'BUILD methods called in the correct order'); - -done_testing; diff --git a/t/21-BUILDARGS.t b/t/21-BUILDARGS.t deleted file mode 100644 index 32bb72a..0000000 --- a/t/21-BUILDARGS.t +++ /dev/null @@ -1,40 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Moose; - -package Foo; - -sub new { - my $class = shift; - bless { name => $_[0] }, $class; -} - -sub name { shift->{name} } - -package Foo::Moose; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -has foo => ( - is => 'rw', -); - -sub BUILDARGS { - my $class = shift; - # remove the argument that's only for passing to the superclass constructor - shift; - return $class->SUPER::BUILDARGS(@_); -} - -package main; - -with_immutable { - my $foo = Foo::Moose->new('bar', foo => 'baz'); - is($foo->name, 'bar', 'superclass constructor gets the right args'); - is($foo->foo, 'baz', 'subclass constructor gets the right args'); -} 'Foo::Moose'; - -done_testing; diff --git a/t/22-replaced-constructor.t b/t/22-replaced-constructor.t deleted file mode 100644 index 3362bc2..0000000 --- a/t/22-replaced-constructor.t +++ /dev/null @@ -1,64 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -our $foo_constructed = 0; - -package Foo; - -sub new { - my $class = shift; - bless {}, $class; -} - -package Foo::Moose; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -after new => sub { - $main::foo_constructed = 1; -}; - -package Foo::Moose2; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -sub new { - my $class = shift; - $main::foo_constructed = 1; - return $class->meta->new_object(@_); -} - -package main; -my $method = Foo::Moose->meta->get_method('new'); -isa_ok($method, 'Class::MOP::Method::Wrapped'); -my $foo = Foo::Moose->new; -ok($foo_constructed, 'method modifier called for the constructor'); -$foo_constructed = 0; -{ - # we don't care about the warning that moose isn't going to inline our - # constructor - this is the behavior we're testing - local $SIG{__WARN__} = sub {}; - Foo::Moose->meta->make_immutable; -} -is($method, Foo::Moose->meta->get_method('new'), - 'make_immutable doesn\'t overwrite constructor with method modifiers'); -$foo = Foo::Moose->new; -ok($foo_constructed, 'method modifier called for the constructor (immutable)'); - -$foo_constructed = 0; -$method = Foo::Moose2->meta->get_method('new'); -$foo = Foo::Moose2->new; -ok($foo_constructed, 'custom constructor called'); -$foo_constructed = 0; -# still need to specify inline_constructor => 0 when overriding new manually -Foo::Moose2->meta->make_immutable(inline_constructor => 0); -is($method, Foo::Moose2->meta->get_method('new'), - 'make_immutable doesn\'t overwrite custom constructor'); -$foo = Foo::Moose2->new; -ok($foo_constructed, 'custom constructor called (immutable)'); - -done_testing; diff --git a/t/23-FOREIGNBUILDARGS.t b/t/23-FOREIGNBUILDARGS.t deleted file mode 100644 index 78c7fa9..0000000 --- a/t/23-FOREIGNBUILDARGS.t +++ /dev/null @@ -1,72 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Moose; - -package Foo; - -sub new { - my $class = shift; - bless { foo_base => $_[0] }, $class; -} - -sub foo_base { shift->{foo_base} } - -package Foo::Moose; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -has foo => ( - is => 'rw', -); - -sub FOREIGNBUILDARGS { - my $class = shift; - my %args = @_; - return "$args{foo}_base"; -} - -package Bar::Moose; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -has bar => ( - is => 'rw', -); - -sub FOREIGNBUILDARGS { - my $class = shift; - return "$_[0]_base"; -} - -sub BUILDARGS { - my $class = shift; - return { bar => shift }; -} - -package Baz::Moose; -use Moose; -extends 'Bar::Moose'; - -has baz => ( - is => 'rw', -); - -package main; - -with_immutable { - my $foo = Foo::Moose->new(foo => 'bar'); - is($foo->foo, 'bar', 'subclass constructor gets the right args'); - is($foo->foo_base, 'bar_base', 'subclass constructor gets the right args'); - my $bar = Bar::Moose->new('baz'); - is($bar->bar, 'baz', 'subclass constructor gets the right args'); - is($bar->foo_base, 'baz_base', 'subclass constructor gets the right args'); - my $baz = Baz::Moose->new('bazbaz'); - is($baz->bar, 'bazbaz', 'extensions of extensions of the nonmoose class respect BUILDARGS'); - is($baz->foo_base, 'bazbaz_base', 'extensions of extensions of the nonmoose class respect FOREIGNBUILDARGS'); -} qw(Foo::Moose Bar::Moose Baz::Moose); - -done_testing; diff --git a/t/24-nonmoose-moose-nonmoose.t b/t/24-nonmoose-moose-nonmoose.t deleted file mode 100644 index 3299547..0000000 --- a/t/24-nonmoose-moose-nonmoose.t +++ /dev/null @@ -1,85 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Moose; - -package Foo; - -sub new { - my $class = shift; - bless {@_}, $class; -} - -sub foo { shift->{name} } - -package Foo::Moose; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -has foo2 => ( - is => 'rw', - isa => 'Str', -); - -package Foo::Moose::Sub; -use base 'Foo::Moose'; - -package Bar; - -sub new { - my $class = shift; - bless {name => $_[0]}, $class; -} - -sub bar { shift->{name} } - -package Bar::Moose; -use Moose; -use MooseX::NonMoose; -extends 'Bar'; - -has bar2 => ( - is => 'rw', - isa => 'Str', -); - -sub FOREIGNBUILDARGS { - my $class = shift; - my %args = @_; - return $args{name}; -} - -package Bar::Moose::Sub; -use base 'Bar::Moose'; - -package main; - -with_immutable { - my $foo = Foo::Moose::Sub->new(name => 'foomoosesub', foo2 => 'FOO2'); - isa_ok($foo, 'Foo'); - isa_ok($foo, 'Foo::Moose'); - is($foo->foo, 'foomoosesub', 'got name from nonmoose constructor'); - is($foo->foo2, 'FOO2', 'got attribute value from moose constructor'); - $foo = Foo::Moose->new(name => 'foomoosesub', foo2 => 'FOO2'); - isa_ok($foo, 'Foo'); - isa_ok($foo, 'Foo::Moose'); - is($foo->foo, 'foomoosesub', 'got name from nonmoose constructor'); - is($foo->foo2, 'FOO2', 'got attribute value from moose constructor'); -} 'Foo::Moose'; - -with_immutable { - my $bar = Bar::Moose::Sub->new(name => 'barmoosesub', bar2 => 'BAR2'); - isa_ok($bar, 'Bar'); - isa_ok($bar, 'Bar::Moose'); - is($bar->bar, 'barmoosesub', 'got name from nonmoose constructor'); - is($bar->bar2, 'BAR2', 'got attribute value from moose constructor'); - $bar = Bar::Moose->new(name => 'barmoosesub', bar2 => 'BAR2'); - isa_ok($bar, 'Bar'); - isa_ok($bar, 'Bar::Moose'); - is($bar->bar, 'barmoosesub', 'got name from nonmoose constructor'); - is($bar->bar2, 'BAR2', 'got attribute value from moose constructor'); -} 'Bar::Moose'; - -done_testing; diff --git a/t/25-constructor-method-calls.t b/t/25-constructor-method-calls.t deleted file mode 100644 index 7187bb8..0000000 --- a/t/25-constructor-method-calls.t +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Moose; - -my ($foo, $foosub); -{ - package Foo; - - sub new { - my $class = shift; - my $obj = bless {}, $class; - $obj->init; - $obj; - } - - sub init { - $foo++ - } -} - -{ - package Foo::Sub; - use base 'Foo'; - - sub init { - $foosub++; - shift->SUPER::init; - } -} - -{ - package Foo::Sub::Sub; - use Moose; - use MooseX::NonMoose; - extends 'Foo::Sub'; -} - -with_immutable { - ($foo, $foosub) = (0, 0); - Foo::Sub::Sub->new; - is($foo, 1, "Foo::init called"); - is($foosub, 1, "Foo::Sub::init called"); -} 'Foo::Sub::Sub'; - -done_testing; diff --git a/t/26-no-new-constructor-error.t b/t/26-no-new-constructor-error.t deleted file mode 100644 index 2becbce..0000000 --- a/t/26-no-new-constructor-error.t +++ /dev/null @@ -1,43 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -{ - package NonMoose; - sub create { bless {}, shift } - sub DESTROY { } -} - -{ - package Child; - use Moose; - use MooseX::NonMoose; - extends 'NonMoose'; - { - my $warning; - local $SIG{__WARN__} = sub { $warning = $_[0] }; - __PACKAGE__->meta->make_immutable; - ::like( - $warning, - qr/Not inlining.*doesn't contain a constructor named 'new'/, - "warning when trying to make_immutable without a superclass 'new'" - ); - } -} - -{ - package ChildTwo; - use Moose; - use MooseX::NonMoose; - extends 'NonMoose'; - { - my $warning; - local $SIG{__WARN__} = sub { $warning = $_[0] }; - __PACKAGE__->meta->make_immutable(inline_constructor => 0); - ::is($warning, undef, - "no warning when trying to make_immutable(inline_constructor => 0) without a superclass 'new'"); - } -} - -done_testing; diff --git a/t/30-only-metaclass-trait.t b/t/30-only-metaclass-trait.t deleted file mode 100644 index c103067..0000000 --- a/t/30-only-metaclass-trait.t +++ /dev/null @@ -1,24 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -package Foo; - -sub new { bless {}, shift } - -package Foo::Moose; -use Moose -traits => 'MooseX::NonMoose::Meta::Role::Class'; -extends 'Foo'; - -package main; -ok(Foo::Moose->meta->has_method('new'), - 'using only the metaclass trait still installs the constructor'); -isa_ok(Foo::Moose->new, 'Moose::Object'); -isa_ok(Foo::Moose->new, 'Foo'); -my $method = Foo::Moose->meta->get_method('new'); -Foo::Moose->meta->make_immutable; -is(Foo::Moose->meta->get_method('new'), $method, - 'inlining doesn\'t happen when the constructor trait isn\'t used'); - -done_testing; diff --git a/t/31-moose-exporter.t b/t/31-moose-exporter.t deleted file mode 100644 index 13b556d..0000000 --- a/t/31-moose-exporter.t +++ /dev/null @@ -1,77 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -BEGIN { - require Moose; - - package Foo::Exporter::Class; - use Moose::Exporter; - Moose::Exporter->setup_import_methods(also => ['Moose']); - - sub init_meta { - shift; - my %options = @_; - Moose->init_meta(%options); - Moose::Util::MetaRole::apply_metaroles( - for => $options{for_class}, - class_metaroles => { - class => ['MooseX::NonMoose::Meta::Role::Class'], - }, - ); - return Class::MOP::class_of($options{for_class}); - } - - package Foo::Exporter::ClassAndConstructor; - use Moose::Exporter; - Moose::Exporter->setup_import_methods(also => ['Moose']); - - sub init_meta { - shift; - my %options = @_; - Moose->init_meta(%options); - Moose::Util::MetaRole::apply_metaroles( - for => $options{for_class}, - class_metaroles => { - class => ['MooseX::NonMoose::Meta::Role::Class'], - constructor => - ['MooseX::NonMoose::Meta::Role::Constructor'], - }, - ); - return Class::MOP::class_of($options{for_class}); - } - -} - -package Foo; - -sub new { bless {}, shift } - -package Foo::Moose; -BEGIN { Foo::Exporter::Class->import } -extends 'Foo'; - -package Foo::Moose2; -BEGIN { Foo::Exporter::ClassAndConstructor->import } -extends 'Foo'; - -package main; -ok(Foo::Moose->meta->has_method('new'), - 'using only the metaclass trait still installs the constructor'); -isa_ok(Foo::Moose->new, 'Moose::Object'); -isa_ok(Foo::Moose->new, 'Foo'); -my $method = Foo::Moose->meta->get_method('new'); -Foo::Moose->meta->make_immutable; -is(Foo::Moose->meta->get_method('new'), $method, - 'inlining doesn\'t happen when the constructor trait isn\'t used'); -ok(Foo::Moose2->meta->has_method('new'), - 'using only the metaclass trait still installs the constructor'); -isa_ok(Foo::Moose2->new, 'Moose::Object'); -isa_ok(Foo::Moose2->new, 'Foo'); -my $method2 = Foo::Moose2->meta->get_method('new'); -Foo::Moose2->meta->make_immutable; -isnt(Foo::Moose2->meta->get_method('new'), $method2, - 'inlining does happen when the constructor trait is used'); - -done_testing; diff --git a/t/32-moosex-insideout.t b/t/32-moosex-insideout.t deleted file mode 100644 index fcd3fd1..0000000 --- a/t/32-moosex-insideout.t +++ /dev/null @@ -1,81 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Moose; -BEGIN { - eval "use MooseX::InsideOut 0.100 ()"; - plan skip_all => "MooseX::InsideOut is required for this test" if $@; -} - -BEGIN { - require Moose; - - package Foo::Exporter; - use Moose::Exporter; - Moose::Exporter->setup_import_methods(also => ['Moose']); - - sub init_meta { - shift; - my %options = @_; - Moose->init_meta(%options); - Moose::Util::MetaRole::apply_metaroles( - for => $options{for_class}, - class_metaroles => { - class => ['MooseX::NonMoose::Meta::Role::Class'], - constructor => - ['MooseX::NonMoose::Meta::Role::Constructor'], - instance => - ['MooseX::InsideOut::Role::Meta::Instance'], - }, - ); - return Class::MOP::class_of($options{for_class}); - } -} - -package Foo; - -sub new { - my $class = shift; - bless [$_[0]], $class; -} - -sub foo { - my $self = shift; - $self->[0] = shift if @_; - $self->[0]; -} - -package Foo::Moose; -BEGIN { Foo::Exporter->import } -extends 'Foo'; - -has bar => ( - is => 'rw', - isa => 'Str', -); - -sub BUILDARGS { - my $self = shift; - shift; - return $self->SUPER::BUILDARGS(@_); -} - -package Foo::Moose::Sub; -use base 'Foo::Moose'; - -package main; - -with_immutable { - my $foo = Foo::Moose->new('FOO', bar => 'BAR'); - is($foo->foo, 'FOO', 'base class accessor works'); - is($foo->bar, 'BAR', 'subclass accessor works'); - $foo->foo('OOF'); - $foo->bar('RAB'); - is($foo->foo, 'OOF', 'base class accessor works (setting)'); - is($foo->bar, 'RAB', 'subclass accessor works (setting)'); - my $sub_foo = eval { Foo::Moose::Sub->new(FOO => bar => 'AHOY') }; - is(eval { $sub_foo->bar }, 'AHOY', 'subclass constructor works'); -} 'Foo::Moose'; - -done_testing; diff --git a/t/33-moosex-globref.t b/t/33-moosex-globref.t deleted file mode 100644 index 60bfa9c..0000000 --- a/t/33-moosex-globref.t +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Moose; -BEGIN { - eval "use MooseX::GlobRef ()"; - plan skip_all => "MooseX::GlobRef is required for this test" if $@; -} -# XXX: the way the IO modules are loaded means we can't just rely on cmop to -# load these properly/: -use IO::Handle; -use IO::File; - -BEGIN { - require Moose; - - package Foo::Exporter; - use Moose::Exporter; - Moose::Exporter->setup_import_methods(also => ['Moose']); - - sub init_meta { - shift; - my %options = @_; - Moose->init_meta(%options); - Moose::Util::MetaRole::apply_metaroles( - for => $options{for_class}, - class_metaroles => { - class => ['MooseX::NonMoose::Meta::Role::Class'], - constructor => - ['MooseX::NonMoose::Meta::Role::Constructor'], - instance => - ['MooseX::GlobRef::Role::Meta::Instance'], - }, - ); - return Class::MOP::class_of($options{for_class}); - } -} - -package IO::Handle::Moose; -BEGIN { Foo::Exporter->import } -extends 'IO::Handle'; - -has bar => ( - is => 'rw', - isa => 'Str', -); - -sub FOREIGNBUILDARGS { return } - -package IO::File::Moose; -BEGIN { Foo::Exporter->import } -extends 'IO::File'; - -has baz => ( - is => 'rw', - isa => 'Str', -); - -sub FOREIGNBUILDARGS { return } - -package main; - -with_immutable { - my $handle = IO::Handle::Moose->new(bar => 'BAR'); - is($handle->bar, 'BAR', 'moose accessor works properly'); - $handle->bar('RAB'); - is($handle->bar, 'RAB', 'moose accessor works properly (setting)'); -} 'IO::Handle::Moose'; - -with_immutable { - SKIP: { - my $fh = IO::File::Moose->new(baz => 'BAZ'); - open $fh, "+>", undef - or skip "couldn't open a temporary file", 3; - is($fh->baz, 'BAZ', "accessor works"); - $fh->baz('ZAB'); - is($fh->baz, 'ZAB', "accessor works (writing)"); - $fh->print("foo\n"); - print $fh "bar\n"; - $fh->seek(0, 0); - my $buf; - $fh->read($buf, 8); - is($buf, "foo\nbar\n", "filehandle still works as normal"); - } -} 'IO::File::Moose'; - -done_testing; diff --git a/t/40-destructor.t b/t/40-destructor.t deleted file mode 100644 index e9a2185..0000000 --- a/t/40-destructor.t +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Moose; - -my ($destroyed, $demolished); -package Foo; - -sub new { bless {}, shift } - -sub DESTROY { $destroyed++ } - -package Foo::Sub; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -sub DEMOLISH { $demolished++ } - -package main; - -with_immutable { - ($destroyed, $demolished) = (0, 0); - { Foo::Sub->new } - is($destroyed, 1, "non-Moose destructor called"); - is($demolished, 1, "Moose destructor called"); -} 'Foo::Sub'; - -done_testing; diff --git a/t/50-buggy-constructor-inlining.t b/t/50-buggy-constructor-inlining.t deleted file mode 100644 index bfb0689..0000000 --- a/t/50-buggy-constructor-inlining.t +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Moose; - -my ($Foo, $Bar, $Baz); -{ - package Foo; - sub new { $Foo++; bless {}, shift } -} - -{ - package Bar; - use Moose; - use MooseX::NonMoose; - extends 'Foo'; - sub BUILD { $Bar++ } - __PACKAGE__->meta->make_immutable; -} - -{ - package Baz; - use Moose; - extends 'Bar'; - sub BUILD { $Baz++ } -} - -with_immutable { - ($Foo, $Bar, $Baz) = (0, 0, 0); - Baz->new; - is($Foo, 1, "Foo->new is called once"); - is($Bar, 1, "Bar->BUILD is called once"); - is($Baz, 1, "Baz->BUILD is called once"); -} 'Baz'; - -done_testing; diff --git a/t/51-buggy-constructors.t b/t/51-buggy-constructors.t deleted file mode 100644 index bbe5127..0000000 --- a/t/51-buggy-constructors.t +++ /dev/null @@ -1,94 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Fatal; -use Test::Moose; - -{ - package Foo; - - sub new { bless {}, shift } -} - -{ - package Foo::Sub; - use Moose; - use MooseX::NonMoose; - - extends 'Foo'; -} - -with_immutable { - my $foo; - is(exception { $foo = Foo::Sub->new }, undef, - "subclassing nonmoose classes with correct constructors works"); - isa_ok($foo, 'Foo'); - isa_ok($foo, 'Foo::Sub'); -} 'Foo::Sub'; - -{ - package BadFoo; - - sub new { bless {} } -} - -{ - package BadFoo::Sub; - use Moose; - use MooseX::NonMoose; - - extends 'BadFoo'; -} - -with_immutable { - my $foo; - is(exception { $foo = BadFoo::Sub->new }, undef, - "subclassing nonmoose classes with incorrect constructors works"); - isa_ok($foo, 'BadFoo'); - isa_ok($foo, 'BadFoo::Sub'); -} 'BadFoo::Sub'; - -{ - package BadFoo2; - - sub new { {} } -} - -{ - package BadFoo2::Sub; - use Moose; - use MooseX::NonMoose; - - extends 'BadFoo2'; -} - -with_immutable { - my $foo; - like(exception { $foo = BadFoo2::Sub->new; }, - qr/\QThe constructor for BadFoo2 did not return a blessed instance/, - "subclassing nonmoose classes with incorrect constructors dies properly"); -} 'BadFoo2::Sub'; - -{ - package BadFoo3; - - sub new { bless {}, 'Something::Else::Entirely' } -} - -{ - package BadFoo3::Sub; - use Moose; - use MooseX::NonMoose; - - extends 'BadFoo3'; -} - -with_immutable { - my $foo; - like(exception { $foo = BadFoo3::Sub->new }, - qr/\QThe constructor for BadFoo3 returned an object whose class is not a parent of BadFoo3::Sub/, - "subclassing nonmoose classes with incorrect constructors dies properly"); -} 'BadFoo3::Sub'; - -done_testing; diff --git a/t/52-hashref-constructor.t b/t/52-hashref-constructor.t deleted file mode 100644 index 00deff0..0000000 --- a/t/52-hashref-constructor.t +++ /dev/null @@ -1,67 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Fatal; - -{ - package Foo; - - sub new { - my $class = shift; - bless { ref($_[0]) ? %{$_[0]} : @_ }, $class; - } - - sub foo { - my $self = shift; - $self->{foo}; - } -} - -{ - package Bar; - use Moose; - use MooseX::NonMoose; - - extends 'Foo'; - - has _bar => ( - init_arg => 'bar', - reader => 'bar', - ); - - __PACKAGE__->meta->make_immutable; -} - -{ - package Baz; - use Moose; - - extends 'Bar'; - - has _baz => ( - init_arg => 'baz', - reader => 'baz', - ); -} - -{ - my $baz; - is(exception { $baz = Baz->new( foo => 1, bar => 2, baz => 3 ) }, undef, - "constructor lives"); - is($baz->foo, 1, "foo set"); - is($baz->bar, 2, "bar set"); - is($baz->baz, 3, "baz set"); - -} - -{ - my $baz; - is(exception { $baz = Baz->new({foo => 1, bar => 2, baz => 3}) }, undef, - "constructor lives (hashref)"); - is($baz->foo, 1, "foo set (hashref)"); - is($baz->bar, 2, "bar set (hashref)"); - is($baz->baz, 3, "baz set (hashref)"); -} - -done_testing; diff --git a/t/60-extends-version.t b/t/60-extends-version.t deleted file mode 100644 index 4f607b8..0000000 --- a/t/60-extends-version.t +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Fatal; - -{ - package Foo; - our $VERSION = '0.02'; - sub new { bless {}, shift } -} - -{ - package Bar; - use Moose; - use MooseX::NonMoose; - ::is(::exception { extends 'Foo' => { -version => '0.02' } }, undef, - "specifying arguments to superclasses doesn't break"); -} - -done_testing; diff --git a/t/BUILD.t b/t/BUILD.t new file mode 100644 index 0000000..d5cc68f --- /dev/null +++ b/t/BUILD.t @@ -0,0 +1,58 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +package Foo; + +sub new { + my $class = shift; + bless { foo => 'FOO' }, $class; +} + +package Foo::Moose; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +has class => ( + is => 'rw', +); + +has accum => ( + is => 'rw', + isa => 'Str', + default => '', +); + +sub BUILD { + my $self = shift; + $self->class(ref $self); + $self->accum($self->accum . 'a'); +} + +package Foo::Moose::Sub; +use Moose; +extends 'Foo::Moose'; + +has bar => ( + is => 'rw', +); + +sub BUILD { + my $self = shift; + $self->bar('BAR'); + $self->accum($self->accum . 'b'); +} + +package main; +my $foo_moose = Foo::Moose->new; +is($foo_moose->class, 'Foo::Moose', 'BUILD method called properly'); +is($foo_moose->accum, 'a', 'BUILD method called properly'); + +my $foo_moose_sub = Foo::Moose::Sub->new; +is($foo_moose_sub->class, 'Foo::Moose::Sub', 'parent BUILD method called'); +is($foo_moose_sub->bar, 'BAR', 'child BUILD method called'); +is($foo_moose_sub->accum, 'ab', 'BUILD methods called in the correct order'); + +done_testing; diff --git a/t/BUILDARGS.t b/t/BUILDARGS.t new file mode 100644 index 0000000..32bb72a --- /dev/null +++ b/t/BUILDARGS.t @@ -0,0 +1,40 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Moose; + +package Foo; + +sub new { + my $class = shift; + bless { name => $_[0] }, $class; +} + +sub name { shift->{name} } + +package Foo::Moose; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +has foo => ( + is => 'rw', +); + +sub BUILDARGS { + my $class = shift; + # remove the argument that's only for passing to the superclass constructor + shift; + return $class->SUPER::BUILDARGS(@_); +} + +package main; + +with_immutable { + my $foo = Foo::Moose->new('bar', foo => 'baz'); + is($foo->name, 'bar', 'superclass constructor gets the right args'); + is($foo->foo, 'baz', 'subclass constructor gets the right args'); +} 'Foo::Moose'; + +done_testing; diff --git a/t/FOREIGNBUILDARGS.t b/t/FOREIGNBUILDARGS.t new file mode 100644 index 0000000..78c7fa9 --- /dev/null +++ b/t/FOREIGNBUILDARGS.t @@ -0,0 +1,72 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Moose; + +package Foo; + +sub new { + my $class = shift; + bless { foo_base => $_[0] }, $class; +} + +sub foo_base { shift->{foo_base} } + +package Foo::Moose; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +has foo => ( + is => 'rw', +); + +sub FOREIGNBUILDARGS { + my $class = shift; + my %args = @_; + return "$args{foo}_base"; +} + +package Bar::Moose; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +has bar => ( + is => 'rw', +); + +sub FOREIGNBUILDARGS { + my $class = shift; + return "$_[0]_base"; +} + +sub BUILDARGS { + my $class = shift; + return { bar => shift }; +} + +package Baz::Moose; +use Moose; +extends 'Bar::Moose'; + +has baz => ( + is => 'rw', +); + +package main; + +with_immutable { + my $foo = Foo::Moose->new(foo => 'bar'); + is($foo->foo, 'bar', 'subclass constructor gets the right args'); + is($foo->foo_base, 'bar_base', 'subclass constructor gets the right args'); + my $bar = Bar::Moose->new('baz'); + is($bar->bar, 'baz', 'subclass constructor gets the right args'); + is($bar->foo_base, 'baz_base', 'subclass constructor gets the right args'); + my $baz = Baz::Moose->new('bazbaz'); + is($baz->bar, 'bazbaz', 'extensions of extensions of the nonmoose class respect BUILDARGS'); + is($baz->foo_base, 'bazbaz_base', 'extensions of extensions of the nonmoose class respect FOREIGNBUILDARGS'); +} qw(Foo::Moose Bar::Moose Baz::Moose); + +done_testing; diff --git a/t/attrs.t b/t/attrs.t new file mode 100644 index 0000000..7451ddc --- /dev/null +++ b/t/attrs.t @@ -0,0 +1,38 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +package Foo; + +sub new { + my $class = shift; + bless { @_ }, $class; +} + +sub foo { + my $self = shift; + return $self->{foo} unless @_; + $self->{foo} = shift; +} + +package Foo::Moose; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +has bar => ( + is => 'rw', +); + +package main; + +my $foo_moose = Foo::Moose->new(foo => 'FOO', bar => 'BAR'); +is($foo_moose->foo, 'FOO', 'foo set in constructor'); +is($foo_moose->bar, 'BAR', 'bar set in constructor'); +$foo_moose->foo('BAZ'); +$foo_moose->bar('QUUX'); +is($foo_moose->foo, 'BAZ', 'foo set by accessor'); +is($foo_moose->bar, 'QUUX', 'bar set by accessor'); + +done_testing; diff --git a/t/basic.t b/t/basic.t new file mode 100644 index 0000000..8995d6d --- /dev/null +++ b/t/basic.t @@ -0,0 +1,34 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +package Foo; + +sub new { + my $class = shift; + bless { _class => $class }, $class; +} + +package Foo::Moose; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +package main; +my $foo = Foo->new; +my $foo_moose = Foo::Moose->new; +isa_ok($foo, 'Foo'); +is($foo->{_class}, 'Foo', 'Foo gets the correct class'); +isa_ok($foo_moose, 'Foo::Moose'); +isa_ok($foo_moose, 'Foo'); +isa_ok($foo_moose, 'Moose::Object'); +is($foo_moose->{_class}, 'Foo::Moose', 'Foo::Moose gets the correct class'); +my $meta = Foo::Moose->meta; +ok($meta->has_method('new'), 'Foo::Moose has its own constructor'); +my $cc_meta = $meta->constructor_class->meta; +isa_ok($cc_meta, 'Moose::Meta::Class'); +ok($cc_meta->does_role('MooseX::NonMoose::Meta::Role::Constructor'), + 'Foo::Moose gets its constructor from MooseX::NonMoose'); + +done_testing; diff --git a/t/buggy-constructor-inlining.t b/t/buggy-constructor-inlining.t new file mode 100644 index 0000000..bfb0689 --- /dev/null +++ b/t/buggy-constructor-inlining.t @@ -0,0 +1,37 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Moose; + +my ($Foo, $Bar, $Baz); +{ + package Foo; + sub new { $Foo++; bless {}, shift } +} + +{ + package Bar; + use Moose; + use MooseX::NonMoose; + extends 'Foo'; + sub BUILD { $Bar++ } + __PACKAGE__->meta->make_immutable; +} + +{ + package Baz; + use Moose; + extends 'Bar'; + sub BUILD { $Baz++ } +} + +with_immutable { + ($Foo, $Bar, $Baz) = (0, 0, 0); + Baz->new; + is($Foo, 1, "Foo->new is called once"); + is($Bar, 1, "Bar->BUILD is called once"); + is($Baz, 1, "Baz->BUILD is called once"); +} 'Baz'; + +done_testing; diff --git a/t/buggy-constructors.t b/t/buggy-constructors.t new file mode 100644 index 0000000..bbe5127 --- /dev/null +++ b/t/buggy-constructors.t @@ -0,0 +1,94 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Fatal; +use Test::Moose; + +{ + package Foo; + + sub new { bless {}, shift } +} + +{ + package Foo::Sub; + use Moose; + use MooseX::NonMoose; + + extends 'Foo'; +} + +with_immutable { + my $foo; + is(exception { $foo = Foo::Sub->new }, undef, + "subclassing nonmoose classes with correct constructors works"); + isa_ok($foo, 'Foo'); + isa_ok($foo, 'Foo::Sub'); +} 'Foo::Sub'; + +{ + package BadFoo; + + sub new { bless {} } +} + +{ + package BadFoo::Sub; + use Moose; + use MooseX::NonMoose; + + extends 'BadFoo'; +} + +with_immutable { + my $foo; + is(exception { $foo = BadFoo::Sub->new }, undef, + "subclassing nonmoose classes with incorrect constructors works"); + isa_ok($foo, 'BadFoo'); + isa_ok($foo, 'BadFoo::Sub'); +} 'BadFoo::Sub'; + +{ + package BadFoo2; + + sub new { {} } +} + +{ + package BadFoo2::Sub; + use Moose; + use MooseX::NonMoose; + + extends 'BadFoo2'; +} + +with_immutable { + my $foo; + like(exception { $foo = BadFoo2::Sub->new; }, + qr/\QThe constructor for BadFoo2 did not return a blessed instance/, + "subclassing nonmoose classes with incorrect constructors dies properly"); +} 'BadFoo2::Sub'; + +{ + package BadFoo3; + + sub new { bless {}, 'Something::Else::Entirely' } +} + +{ + package BadFoo3::Sub; + use Moose; + use MooseX::NonMoose; + + extends 'BadFoo3'; +} + +with_immutable { + my $foo; + like(exception { $foo = BadFoo3::Sub->new }, + qr/\QThe constructor for BadFoo3 returned an object whose class is not a parent of BadFoo3::Sub/, + "subclassing nonmoose classes with incorrect constructors dies properly"); +} 'BadFoo3::Sub'; + +done_testing; diff --git a/t/constructor-method-calls.t b/t/constructor-method-calls.t new file mode 100644 index 0000000..7187bb8 --- /dev/null +++ b/t/constructor-method-calls.t @@ -0,0 +1,47 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Moose; + +my ($foo, $foosub); +{ + package Foo; + + sub new { + my $class = shift; + my $obj = bless {}, $class; + $obj->init; + $obj; + } + + sub init { + $foo++ + } +} + +{ + package Foo::Sub; + use base 'Foo'; + + sub init { + $foosub++; + shift->SUPER::init; + } +} + +{ + package Foo::Sub::Sub; + use Moose; + use MooseX::NonMoose; + extends 'Foo::Sub'; +} + +with_immutable { + ($foo, $foosub) = (0, 0); + Foo::Sub::Sub->new; + is($foo, 1, "Foo::init called"); + is($foosub, 1, "Foo::Sub::init called"); +} 'Foo::Sub::Sub'; + +done_testing; diff --git a/t/constructor-name.t b/t/constructor-name.t new file mode 100644 index 0000000..4d790eb --- /dev/null +++ b/t/constructor-name.t @@ -0,0 +1,108 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Fatal; +use Test::Moose; + +{ + package Foo; + + sub create { + my $class = shift; + my %params = @_; + bless { foo => ($params{foo} || 'FOO') }, $class; + } + + sub foo { shift->{foo} } +} + +{ + package Foo::Sub; + use Moose; + use MooseX::NonMoose; + + extends 'Foo' => { -constructor_name => 'create' }; + + has bar => ( + is => 'ro', + isa => 'Str', + default => 'BAR', + ); +} + +with_immutable { + my $foo = Foo::Sub->create; + is($foo->foo, 'FOO', "nonmoose constructor called"); + is($foo->bar, 'BAR', "moose constructor called"); +} 'Foo::Sub'; + +{ + package Foo::BadSub; + use Moose; + use MooseX::NonMoose; + + ::like( + ::exception { + extends 'Foo' => { -constructor_name => 'something_else' }; + }, + qr/You specified 'something_else' as the constructor for Foo, but Foo has no method by that name/, + "specifying an incorrect constructor name dies" + ); +} + +{ + package Foo::Mixin; + + sub thing { + return shift->foo . 'BAZ'; + } +} + +{ + package Foo::Sub2; + use Moose; + use MooseX::NonMoose; + + extends 'Foo::Mixin', 'Foo' => { -constructor_name => 'create' }; + + has bar => ( + is => 'ro', + isa => 'Str', + default => 'BAR', + ); +} + +with_immutable { + my $foo = Foo::Sub2->create; + is($foo->foo, 'FOO', "nonmoose constructor called"); + is($foo->bar, 'BAR', "moose constructor called"); + is($foo->thing, 'FOOBAZ', "mixin still works"); +} 'Foo::Sub2'; + +{ + package Bar; + + sub make { + my $class = shift; + my %params = @_; + bless { baz => ($params{baz} || 'BAZ') }, $class; + } +} + +{ + package Foo::Bar::Sub; + use Moose; + use MooseX::NonMoose; + + ::like( + ::exception { + extends 'Bar' => { -constructor_name => 'make' }, + 'Foo' => { -constructor_name => 'create' }; + }, + qr/You have already specified Bar::make as the parent constructor; Foo::create cannot also be the constructor/, + "can't specify two parent constructors" + ); +} + +done_testing; diff --git a/t/destructor.t b/t/destructor.t new file mode 100644 index 0000000..e9a2185 --- /dev/null +++ b/t/destructor.t @@ -0,0 +1,30 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Moose; + +my ($destroyed, $demolished); +package Foo; + +sub new { bless {}, shift } + +sub DESTROY { $destroyed++ } + +package Foo::Sub; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +sub DEMOLISH { $demolished++ } + +package main; + +with_immutable { + ($destroyed, $demolished) = (0, 0); + { Foo::Sub->new } + is($destroyed, 1, "non-Moose destructor called"); + is($demolished, 1, "Moose destructor called"); +} 'Foo::Sub'; + +done_testing; diff --git a/t/disable.t b/t/disable.t new file mode 100644 index 0000000..73b9ed1 --- /dev/null +++ b/t/disable.t @@ -0,0 +1,35 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +package Foo; + +sub new { + my $class = shift; + bless {}, $class; +} + +package Foo::Moose; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +package Foo::Moose2; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +package main; + +ok(Foo::Moose->meta->has_method('new'), 'Foo::Moose has a constructor'); +my $method = Foo::Moose->meta->get_method('new'); +Foo::Moose->meta->make_immutable; +isnt($method, Foo::Moose->meta->get_method('new'), + 'make_immutable replaced the constructor with an inlined version'); +my $method2 = Foo::Moose2->meta->get_method('new'); +Foo::Moose2->meta->make_immutable(inline_constructor => 0); +is($method2, Foo::Moose2->meta->get_method('new'), + 'make_immutable doesn\'t replace the constructor if we ask it not to'); + +done_testing; diff --git a/t/extends-moose-object.t b/t/extends-moose-object.t new file mode 100644 index 0000000..699dfe5 --- /dev/null +++ b/t/extends-moose-object.t @@ -0,0 +1,33 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +{ + package Foo; + sub new { bless {}, shift } +} + +{ + package Foo::Sub; + use Moose; + use MooseX::NonMoose; + extends 'Foo'; +} + +{ + package Bar; + use Moose; +} + +{ + package Bar::Sub; + use Moose; + use MooseX::NonMoose; + extends 'Bar'; +} + +is_deeply(\@Foo::Sub::ISA, ['Foo', 'Moose::Object'], "Moose::Object was added"); +is_deeply(\@Bar::Sub::ISA, ['Bar'], "Moose::Object wasn't added"); + +done_testing; diff --git a/t/extends-version.t b/t/extends-version.t new file mode 100644 index 0000000..4f607b8 --- /dev/null +++ b/t/extends-version.t @@ -0,0 +1,21 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Fatal; + +{ + package Foo; + our $VERSION = '0.02'; + sub new { bless {}, shift } +} + +{ + package Bar; + use Moose; + use MooseX::NonMoose; + ::is(::exception { extends 'Foo' => { -version => '0.02' } }, undef, + "specifying arguments to superclasses doesn't break"); +} + +done_testing; diff --git a/t/hashref-constructor.t b/t/hashref-constructor.t new file mode 100644 index 0000000..00deff0 --- /dev/null +++ b/t/hashref-constructor.t @@ -0,0 +1,67 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Fatal; + +{ + package Foo; + + sub new { + my $class = shift; + bless { ref($_[0]) ? %{$_[0]} : @_ }, $class; + } + + sub foo { + my $self = shift; + $self->{foo}; + } +} + +{ + package Bar; + use Moose; + use MooseX::NonMoose; + + extends 'Foo'; + + has _bar => ( + init_arg => 'bar', + reader => 'bar', + ); + + __PACKAGE__->meta->make_immutable; +} + +{ + package Baz; + use Moose; + + extends 'Bar'; + + has _baz => ( + init_arg => 'baz', + reader => 'baz', + ); +} + +{ + my $baz; + is(exception { $baz = Baz->new( foo => 1, bar => 2, baz => 3 ) }, undef, + "constructor lives"); + is($baz->foo, 1, "foo set"); + is($baz->bar, 2, "bar set"); + is($baz->baz, 3, "baz set"); + +} + +{ + my $baz; + is(exception { $baz = Baz->new({foo => 1, bar => 2, baz => 3}) }, undef, + "constructor lives (hashref)"); + is($baz->foo, 1, "foo set (hashref)"); + is($baz->bar, 2, "bar set (hashref)"); + is($baz->baz, 3, "baz set (hashref)"); +} + +done_testing; diff --git a/t/immutable.t b/t/immutable.t new file mode 100644 index 0000000..275b387 --- /dev/null +++ b/t/immutable.t @@ -0,0 +1,45 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +package Foo; + +sub new { + my $class = shift; + bless { @_ }, $class; +} + +sub foo { + my $self = shift; + return $self->{foo} unless @_; + $self->{foo} = shift; +} + +sub baz { 'Foo' } +sub quux { ref(shift) } + +package Foo::Moose; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +has bar => ( + is => 'rw', +); + +__PACKAGE__->meta->make_immutable; + +package main; + +my $foo_moose = Foo::Moose->new(foo => 'FOO', bar => 'BAR'); +is($foo_moose->foo, 'FOO', 'foo set in constructor'); +is($foo_moose->bar, 'BAR', 'bar set in constructor'); +$foo_moose->foo('BAZ'); +$foo_moose->bar('QUUX'); +is($foo_moose->foo, 'BAZ', 'foo set by accessor'); +is($foo_moose->bar, 'QUUX', 'bar set by accessor'); +is($foo_moose->baz, 'Foo', 'baz method'); +is($foo_moose->quux, 'Foo::Moose', 'quux method'); + +done_testing; diff --git a/t/methods.t b/t/methods.t new file mode 100644 index 0000000..c02438c --- /dev/null +++ b/t/methods.t @@ -0,0 +1,27 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +package Foo; + +sub new { bless {}, shift } +sub foo { 'Foo' } +sub bar { 'Foo' } +sub baz { ref(shift) } + +package Foo::Moose; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +sub bar { 'Foo::Moose' } + +package main; + +my $foo_moose = Foo::Moose->new; +is($foo_moose->foo, 'Foo', 'Foo::Moose->foo'); +is($foo_moose->bar, 'Foo::Moose', 'Foo::Moose->bar'); +is($foo_moose->baz, 'Foo::Moose', 'Foo::Moose->baz'); + +done_testing; diff --git a/t/moose-exporter.t b/t/moose-exporter.t new file mode 100644 index 0000000..13b556d --- /dev/null +++ b/t/moose-exporter.t @@ -0,0 +1,77 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +BEGIN { + require Moose; + + package Foo::Exporter::Class; + use Moose::Exporter; + Moose::Exporter->setup_import_methods(also => ['Moose']); + + sub init_meta { + shift; + my %options = @_; + Moose->init_meta(%options); + Moose::Util::MetaRole::apply_metaroles( + for => $options{for_class}, + class_metaroles => { + class => ['MooseX::NonMoose::Meta::Role::Class'], + }, + ); + return Class::MOP::class_of($options{for_class}); + } + + package Foo::Exporter::ClassAndConstructor; + use Moose::Exporter; + Moose::Exporter->setup_import_methods(also => ['Moose']); + + sub init_meta { + shift; + my %options = @_; + Moose->init_meta(%options); + Moose::Util::MetaRole::apply_metaroles( + for => $options{for_class}, + class_metaroles => { + class => ['MooseX::NonMoose::Meta::Role::Class'], + constructor => + ['MooseX::NonMoose::Meta::Role::Constructor'], + }, + ); + return Class::MOP::class_of($options{for_class}); + } + +} + +package Foo; + +sub new { bless {}, shift } + +package Foo::Moose; +BEGIN { Foo::Exporter::Class->import } +extends 'Foo'; + +package Foo::Moose2; +BEGIN { Foo::Exporter::ClassAndConstructor->import } +extends 'Foo'; + +package main; +ok(Foo::Moose->meta->has_method('new'), + 'using only the metaclass trait still installs the constructor'); +isa_ok(Foo::Moose->new, 'Moose::Object'); +isa_ok(Foo::Moose->new, 'Foo'); +my $method = Foo::Moose->meta->get_method('new'); +Foo::Moose->meta->make_immutable; +is(Foo::Moose->meta->get_method('new'), $method, + 'inlining doesn\'t happen when the constructor trait isn\'t used'); +ok(Foo::Moose2->meta->has_method('new'), + 'using only the metaclass trait still installs the constructor'); +isa_ok(Foo::Moose2->new, 'Moose::Object'); +isa_ok(Foo::Moose2->new, 'Foo'); +my $method2 = Foo::Moose2->meta->get_method('new'); +Foo::Moose2->meta->make_immutable; +isnt(Foo::Moose2->meta->get_method('new'), $method2, + 'inlining does happen when the constructor trait is used'); + +done_testing; diff --git a/t/moose.t b/t/moose.t new file mode 100644 index 0000000..e4f8d39 --- /dev/null +++ b/t/moose.t @@ -0,0 +1,53 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +package Foo; +use Moose; + +has foo => ( + is => 'ro', + default => 'FOO', +); + +package Foo::Sub; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +package main; +my $foo_sub = Foo::Sub->new; +isa_ok($foo_sub, 'Foo'); +is($foo_sub->foo, 'FOO', 'inheritance works'); +ok(!Foo::Sub->meta->has_method('new'), + 'Foo::Sub doesn\'t have its own new method'); + +$_->meta->make_immutable for qw(Foo Foo::Sub); + +$foo_sub = Foo::Sub->new; +isa_ok($foo_sub, 'Foo'); +is($foo_sub->foo, 'FOO', 'inheritance works (immutable)'); +ok(Foo::Sub->meta->has_method('new'), + 'Foo::Sub has its own new method (immutable)'); + +package Foo::OtherSub; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +package main; +my $foo_othersub = Foo::OtherSub->new; +isa_ok($foo_othersub, 'Foo'); +is($foo_othersub->foo, 'FOO', 'inheritance works (immutable when extending)'); +ok(!Foo::OtherSub->meta->has_method('new'), + 'Foo::OtherSub doesn\'t have its own new method (immutable when extending)'); + +Foo::OtherSub->meta->make_immutable; +$foo_othersub = Foo::OtherSub->new; +isa_ok($foo_othersub, 'Foo'); +is($foo_othersub->foo, 'FOO', 'inheritance works (all immutable)'); +ok(Foo::OtherSub->meta->has_method('new'), + 'Foo::OtherSub has its own new method (all immutable)'); + +done_testing; diff --git a/t/moosex-globref.t b/t/moosex-globref.t new file mode 100644 index 0000000..60bfa9c --- /dev/null +++ b/t/moosex-globref.t @@ -0,0 +1,88 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Moose; +BEGIN { + eval "use MooseX::GlobRef ()"; + plan skip_all => "MooseX::GlobRef is required for this test" if $@; +} +# XXX: the way the IO modules are loaded means we can't just rely on cmop to +# load these properly/: +use IO::Handle; +use IO::File; + +BEGIN { + require Moose; + + package Foo::Exporter; + use Moose::Exporter; + Moose::Exporter->setup_import_methods(also => ['Moose']); + + sub init_meta { + shift; + my %options = @_; + Moose->init_meta(%options); + Moose::Util::MetaRole::apply_metaroles( + for => $options{for_class}, + class_metaroles => { + class => ['MooseX::NonMoose::Meta::Role::Class'], + constructor => + ['MooseX::NonMoose::Meta::Role::Constructor'], + instance => + ['MooseX::GlobRef::Role::Meta::Instance'], + }, + ); + return Class::MOP::class_of($options{for_class}); + } +} + +package IO::Handle::Moose; +BEGIN { Foo::Exporter->import } +extends 'IO::Handle'; + +has bar => ( + is => 'rw', + isa => 'Str', +); + +sub FOREIGNBUILDARGS { return } + +package IO::File::Moose; +BEGIN { Foo::Exporter->import } +extends 'IO::File'; + +has baz => ( + is => 'rw', + isa => 'Str', +); + +sub FOREIGNBUILDARGS { return } + +package main; + +with_immutable { + my $handle = IO::Handle::Moose->new(bar => 'BAR'); + is($handle->bar, 'BAR', 'moose accessor works properly'); + $handle->bar('RAB'); + is($handle->bar, 'RAB', 'moose accessor works properly (setting)'); +} 'IO::Handle::Moose'; + +with_immutable { + SKIP: { + my $fh = IO::File::Moose->new(baz => 'BAZ'); + open $fh, "+>", undef + or skip "couldn't open a temporary file", 3; + is($fh->baz, 'BAZ', "accessor works"); + $fh->baz('ZAB'); + is($fh->baz, 'ZAB', "accessor works (writing)"); + $fh->print("foo\n"); + print $fh "bar\n"; + $fh->seek(0, 0); + my $buf; + $fh->read($buf, 8); + is($buf, "foo\nbar\n", "filehandle still works as normal"); + } +} 'IO::File::Moose'; + +done_testing; diff --git a/t/moosex-insideout.t b/t/moosex-insideout.t new file mode 100644 index 0000000..fcd3fd1 --- /dev/null +++ b/t/moosex-insideout.t @@ -0,0 +1,81 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Moose; +BEGIN { + eval "use MooseX::InsideOut 0.100 ()"; + plan skip_all => "MooseX::InsideOut is required for this test" if $@; +} + +BEGIN { + require Moose; + + package Foo::Exporter; + use Moose::Exporter; + Moose::Exporter->setup_import_methods(also => ['Moose']); + + sub init_meta { + shift; + my %options = @_; + Moose->init_meta(%options); + Moose::Util::MetaRole::apply_metaroles( + for => $options{for_class}, + class_metaroles => { + class => ['MooseX::NonMoose::Meta::Role::Class'], + constructor => + ['MooseX::NonMoose::Meta::Role::Constructor'], + instance => + ['MooseX::InsideOut::Role::Meta::Instance'], + }, + ); + return Class::MOP::class_of($options{for_class}); + } +} + +package Foo; + +sub new { + my $class = shift; + bless [$_[0]], $class; +} + +sub foo { + my $self = shift; + $self->[0] = shift if @_; + $self->[0]; +} + +package Foo::Moose; +BEGIN { Foo::Exporter->import } +extends 'Foo'; + +has bar => ( + is => 'rw', + isa => 'Str', +); + +sub BUILDARGS { + my $self = shift; + shift; + return $self->SUPER::BUILDARGS(@_); +} + +package Foo::Moose::Sub; +use base 'Foo::Moose'; + +package main; + +with_immutable { + my $foo = Foo::Moose->new('FOO', bar => 'BAR'); + is($foo->foo, 'FOO', 'base class accessor works'); + is($foo->bar, 'BAR', 'subclass accessor works'); + $foo->foo('OOF'); + $foo->bar('RAB'); + is($foo->foo, 'OOF', 'base class accessor works (setting)'); + is($foo->bar, 'RAB', 'subclass accessor works (setting)'); + my $sub_foo = eval { Foo::Moose::Sub->new(FOO => bar => 'AHOY') }; + is(eval { $sub_foo->bar }, 'AHOY', 'subclass constructor works'); +} 'Foo::Moose'; + +done_testing; diff --git a/t/multi-level.t b/t/multi-level.t new file mode 100644 index 0000000..5201c47 --- /dev/null +++ b/t/multi-level.t @@ -0,0 +1,57 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +package Foo; + +sub new { + my $class = shift; + bless { foo => 'FOO' }, $class; +} + +sub foo { shift->{foo} } + +package Foo::Moose; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +has bar => ( + is => 'ro', + default => 'BAR', +); + +package Foo::Moose::Sub; +use Moose; +extends 'Foo::Moose'; + +has baz => ( + is => 'ro', + default => 'BAZ', +); + +package main; +my $foo_moose = Foo::Moose->new; +is($foo_moose->foo, 'FOO', 'Foo::Moose::foo'); +is($foo_moose->bar, 'BAR', 'Foo::Moose::bar'); +isnt(Foo::Moose->meta->get_method('new'), undef, + 'Foo::Moose gets its own constructor'); + +my $foo_moose_sub = Foo::Moose::Sub->new; +is($foo_moose_sub->foo, 'FOO', 'Foo::Moose::Sub::foo'); +is($foo_moose_sub->bar, 'BAR', 'Foo::Moose::Sub::bar'); +is($foo_moose_sub->baz, 'BAZ', 'Foo::Moose::Sub::baz'); +is(Foo::Moose::Sub->meta->get_method('new'), undef, + 'Foo::Moose::Sub just uses the constructor for Foo::Moose'); + +Foo::Moose->meta->make_immutable; +Foo::Moose::Sub->meta->make_immutable; +$foo_moose_sub = Foo::Moose::Sub->new; +is($foo_moose_sub->foo, 'FOO', 'Foo::Moose::Sub::foo (immutable)'); +is($foo_moose_sub->bar, 'BAR', 'Foo::Moose::Sub::bar (immutable)'); +is($foo_moose_sub->baz, 'BAZ', 'Foo::Moose::Sub::baz (immutable)'); +isnt(Foo::Moose::Sub->meta->get_method('new'), undef, + 'Foo::Moose::Sub has an inlined constructor'); + +done_testing; diff --git a/t/no-new-constructor-error.t b/t/no-new-constructor-error.t new file mode 100644 index 0000000..2becbce --- /dev/null +++ b/t/no-new-constructor-error.t @@ -0,0 +1,43 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +{ + package NonMoose; + sub create { bless {}, shift } + sub DESTROY { } +} + +{ + package Child; + use Moose; + use MooseX::NonMoose; + extends 'NonMoose'; + { + my $warning; + local $SIG{__WARN__} = sub { $warning = $_[0] }; + __PACKAGE__->meta->make_immutable; + ::like( + $warning, + qr/Not inlining.*doesn't contain a constructor named 'new'/, + "warning when trying to make_immutable without a superclass 'new'" + ); + } +} + +{ + package ChildTwo; + use Moose; + use MooseX::NonMoose; + extends 'NonMoose'; + { + my $warning; + local $SIG{__WARN__} = sub { $warning = $_[0] }; + __PACKAGE__->meta->make_immutable(inline_constructor => 0); + ::is($warning, undef, + "no warning when trying to make_immutable(inline_constructor => 0) without a superclass 'new'"); + } +} + +done_testing; diff --git a/t/nonmoose-moose-nonmoose.t b/t/nonmoose-moose-nonmoose.t new file mode 100644 index 0000000..3299547 --- /dev/null +++ b/t/nonmoose-moose-nonmoose.t @@ -0,0 +1,85 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Moose; + +package Foo; + +sub new { + my $class = shift; + bless {@_}, $class; +} + +sub foo { shift->{name} } + +package Foo::Moose; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +has foo2 => ( + is => 'rw', + isa => 'Str', +); + +package Foo::Moose::Sub; +use base 'Foo::Moose'; + +package Bar; + +sub new { + my $class = shift; + bless {name => $_[0]}, $class; +} + +sub bar { shift->{name} } + +package Bar::Moose; +use Moose; +use MooseX::NonMoose; +extends 'Bar'; + +has bar2 => ( + is => 'rw', + isa => 'Str', +); + +sub FOREIGNBUILDARGS { + my $class = shift; + my %args = @_; + return $args{name}; +} + +package Bar::Moose::Sub; +use base 'Bar::Moose'; + +package main; + +with_immutable { + my $foo = Foo::Moose::Sub->new(name => 'foomoosesub', foo2 => 'FOO2'); + isa_ok($foo, 'Foo'); + isa_ok($foo, 'Foo::Moose'); + is($foo->foo, 'foomoosesub', 'got name from nonmoose constructor'); + is($foo->foo2, 'FOO2', 'got attribute value from moose constructor'); + $foo = Foo::Moose->new(name => 'foomoosesub', foo2 => 'FOO2'); + isa_ok($foo, 'Foo'); + isa_ok($foo, 'Foo::Moose'); + is($foo->foo, 'foomoosesub', 'got name from nonmoose constructor'); + is($foo->foo2, 'FOO2', 'got attribute value from moose constructor'); +} 'Foo::Moose'; + +with_immutable { + my $bar = Bar::Moose::Sub->new(name => 'barmoosesub', bar2 => 'BAR2'); + isa_ok($bar, 'Bar'); + isa_ok($bar, 'Bar::Moose'); + is($bar->bar, 'barmoosesub', 'got name from nonmoose constructor'); + is($bar->bar2, 'BAR2', 'got attribute value from moose constructor'); + $bar = Bar::Moose->new(name => 'barmoosesub', bar2 => 'BAR2'); + isa_ok($bar, 'Bar'); + isa_ok($bar, 'Bar::Moose'); + is($bar->bar, 'barmoosesub', 'got name from nonmoose constructor'); + is($bar->bar2, 'BAR2', 'got attribute value from moose constructor'); +} 'Bar::Moose'; + +done_testing; diff --git a/t/only-metaclass-trait.t b/t/only-metaclass-trait.t new file mode 100644 index 0000000..c103067 --- /dev/null +++ b/t/only-metaclass-trait.t @@ -0,0 +1,24 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +package Foo; + +sub new { bless {}, shift } + +package Foo::Moose; +use Moose -traits => 'MooseX::NonMoose::Meta::Role::Class'; +extends 'Foo'; + +package main; +ok(Foo::Moose->meta->has_method('new'), + 'using only the metaclass trait still installs the constructor'); +isa_ok(Foo::Moose->new, 'Moose::Object'); +isa_ok(Foo::Moose->new, 'Foo'); +my $method = Foo::Moose->meta->get_method('new'); +Foo::Moose->meta->make_immutable; +is(Foo::Moose->meta->get_method('new'), $method, + 'inlining doesn\'t happen when the constructor trait isn\'t used'); + +done_testing; diff --git a/t/reinitialize.t b/t/reinitialize.t new file mode 100644 index 0000000..5e4aa11 --- /dev/null +++ b/t/reinitialize.t @@ -0,0 +1,32 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Fatal; + +{ + package Foo; + sub new { bless {}, shift } +} + +{ + package Foo::Meta::Role; + use Moose::Role; +} + +{ + package Foo::Sub; + use Moose; + use MooseX::NonMoose; + extends 'Foo'; + Moose::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { + class => ['Foo::Meta::Role'], + }, + ); + ::is(::exception { __PACKAGE__->meta->make_immutable }, undef, + "can make_immutable after reinitialization"); +} + +done_testing; diff --git a/t/replaced-constructor.t b/t/replaced-constructor.t new file mode 100644 index 0000000..3362bc2 --- /dev/null +++ b/t/replaced-constructor.t @@ -0,0 +1,64 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +our $foo_constructed = 0; + +package Foo; + +sub new { + my $class = shift; + bless {}, $class; +} + +package Foo::Moose; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +after new => sub { + $main::foo_constructed = 1; +}; + +package Foo::Moose2; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +sub new { + my $class = shift; + $main::foo_constructed = 1; + return $class->meta->new_object(@_); +} + +package main; +my $method = Foo::Moose->meta->get_method('new'); +isa_ok($method, 'Class::MOP::Method::Wrapped'); +my $foo = Foo::Moose->new; +ok($foo_constructed, 'method modifier called for the constructor'); +$foo_constructed = 0; +{ + # we don't care about the warning that moose isn't going to inline our + # constructor - this is the behavior we're testing + local $SIG{__WARN__} = sub {}; + Foo::Moose->meta->make_immutable; +} +is($method, Foo::Moose->meta->get_method('new'), + 'make_immutable doesn\'t overwrite constructor with method modifiers'); +$foo = Foo::Moose->new; +ok($foo_constructed, 'method modifier called for the constructor (immutable)'); + +$foo_constructed = 0; +$method = Foo::Moose2->meta->get_method('new'); +$foo = Foo::Moose2->new; +ok($foo_constructed, 'custom constructor called'); +$foo_constructed = 0; +# still need to specify inline_constructor => 0 when overriding new manually +Foo::Moose2->meta->make_immutable(inline_constructor => 0); +is($method, Foo::Moose2->meta->get_method('new'), + 'make_immutable doesn\'t overwrite custom constructor'); +$foo = Foo::Moose2->new; +ok($foo_constructed, 'custom constructor called (immutable)'); + +done_testing; diff --git a/weaver.ini b/weaver.ini deleted file mode 100644 index c1382a5..0000000 --- a/weaver.ini +++ /dev/null @@ -1,33 +0,0 @@ -[@CorePrep] - -[Name] -[Version] - -[Region / prelude] - -[Generic / SYNOPSIS] -[Generic / DESCRIPTION] -[Generic / OVERVIEW] - -[Collect / ATTRIBUTES] -command = attr - -[Collect / METHODS] -command = method - -[Collect / FUNCTIONS] -command = func - -[Leftovers] - -[Region / postlude] - -[Generic / BUGS] - -[Generic / SEEALSO] -header = SEE ALSO - -[Generic / SUPPORT] - -[Authors] -[Legal] -- cgit v1.2.3