From 60c5f48aff6a579ce22bd4b4245f7be346609901 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Tue, 15 Jun 2010 01:36:37 -0500 Subject: convert to new dzil stuff --- t/000-load.t | 9 ---- t/001-basic.t | 32 ----------- t/002-methods.t | 25 --------- t/003-attrs.t | 36 ------------- t/004-multi-level.t | 55 ------------------- t/005-moose.t | 51 ------------------ t/006-disable.t | 33 ------------ t/01-basic.t | 32 +++++++++++ t/010-immutable.t | 43 --------------- t/02-methods.t | 25 +++++++++ t/020-BUILD.t | 56 -------------------- t/021-BUILDARGS.t | 39 -------------- t/022-replaced-constructor.t | 62 ---------------------- t/023-FOREIGNBUILDARGS.t | 79 ---------------------------- t/024-nonmoose-moose-nonmoose.t | 105 ------------------------------------- t/025-constructor-method-calls.t | 47 ----------------- t/03-attrs.t | 36 +++++++++++++ t/030-only-metaclass-trait.t | 22 -------- t/031-moose-exporter.t | 71 ------------------------- t/032-moosex-insideout.t | 85 ------------------------------ t/033-moosex-globref.t | 99 ---------------------------------- t/04-multi-level.t | 55 +++++++++++++++++++ t/040-destructor.t | 29 ---------- t/05-moose.t | 51 ++++++++++++++++++ t/06-disable.t | 33 ++++++++++++ t/10-immutable.t | 43 +++++++++++++++ t/100-buggy-constructor-inlining.t | 45 ---------------- t/101-buggy-constructors.t | 98 ---------------------------------- t/20-BUILD.t | 56 ++++++++++++++++++++ t/21-BUILDARGS.t | 39 ++++++++++++++ t/22-replaced-constructor.t | 62 ++++++++++++++++++++++ t/23-FOREIGNBUILDARGS.t | 79 ++++++++++++++++++++++++++++ t/24-nonmoose-moose-nonmoose.t | 105 +++++++++++++++++++++++++++++++++++++ t/25-constructor-method-calls.t | 47 +++++++++++++++++ t/30-only-metaclass-trait.t | 22 ++++++++ t/31-moose-exporter.t | 71 +++++++++++++++++++++++++ t/32-moosex-insideout.t | 85 ++++++++++++++++++++++++++++++ t/33-moosex-globref.t | 99 ++++++++++++++++++++++++++++++++++ t/40-destructor.t | 29 ++++++++++ t/50-buggy-constructor-inlining.t | 45 ++++++++++++++++ t/51-buggy-constructors.t | 98 ++++++++++++++++++++++++++++++++++ 41 files changed, 1112 insertions(+), 1121 deletions(-) delete mode 100644 t/000-load.t delete mode 100644 t/001-basic.t delete mode 100644 t/002-methods.t delete mode 100644 t/003-attrs.t delete mode 100644 t/004-multi-level.t delete mode 100644 t/005-moose.t delete mode 100644 t/006-disable.t create mode 100644 t/01-basic.t delete mode 100644 t/010-immutable.t create mode 100644 t/02-methods.t delete mode 100644 t/020-BUILD.t delete mode 100644 t/021-BUILDARGS.t delete mode 100644 t/022-replaced-constructor.t delete mode 100644 t/023-FOREIGNBUILDARGS.t delete mode 100644 t/024-nonmoose-moose-nonmoose.t delete mode 100644 t/025-constructor-method-calls.t create mode 100644 t/03-attrs.t delete mode 100644 t/030-only-metaclass-trait.t delete mode 100644 t/031-moose-exporter.t delete mode 100644 t/032-moosex-insideout.t delete mode 100644 t/033-moosex-globref.t create mode 100644 t/04-multi-level.t delete mode 100644 t/040-destructor.t create mode 100644 t/05-moose.t create mode 100644 t/06-disable.t create mode 100644 t/10-immutable.t delete mode 100644 t/100-buggy-constructor-inlining.t delete mode 100644 t/101-buggy-constructors.t create mode 100644 t/20-BUILD.t create mode 100644 t/21-BUILDARGS.t create mode 100644 t/22-replaced-constructor.t create mode 100644 t/23-FOREIGNBUILDARGS.t create mode 100644 t/24-nonmoose-moose-nonmoose.t create mode 100644 t/25-constructor-method-calls.t create mode 100644 t/30-only-metaclass-trait.t create mode 100644 t/31-moose-exporter.t create mode 100644 t/32-moosex-insideout.t create mode 100644 t/33-moosex-globref.t create mode 100644 t/40-destructor.t create mode 100644 t/50-buggy-constructor-inlining.t create mode 100644 t/51-buggy-constructors.t (limited to 't') diff --git a/t/000-load.t b/t/000-load.t deleted file mode 100644 index 03ac467..0000000 --- a/t/000-load.t +++ /dev/null @@ -1,9 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 1; - -package Foo; -use Moose; -::use_ok('MooseX::NonMoose') - or ::BAIL_OUT("couldn't load MooseX::NonMoose"); diff --git a/t/001-basic.t b/t/001-basic.t deleted file mode 100644 index a448abf..0000000 --- a/t/001-basic.t +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 9; - -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'); diff --git a/t/002-methods.t b/t/002-methods.t deleted file mode 100644 index 03b8101..0000000 --- a/t/002-methods.t +++ /dev/null @@ -1,25 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 3; - -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'); diff --git a/t/003-attrs.t b/t/003-attrs.t deleted file mode 100644 index 6b25849..0000000 --- a/t/003-attrs.t +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 4; - -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'); diff --git a/t/004-multi-level.t b/t/004-multi-level.t deleted file mode 100644 index 4cd0465..0000000 --- a/t/004-multi-level.t +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 11; - -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'); diff --git a/t/005-moose.t b/t/005-moose.t deleted file mode 100644 index 33a14b1..0000000 --- a/t/005-moose.t +++ /dev/null @@ -1,51 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 12; - -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)'); diff --git a/t/006-disable.t b/t/006-disable.t deleted file mode 100644 index 6d652ab..0000000 --- a/t/006-disable.t +++ /dev/null @@ -1,33 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 3; - -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'); diff --git a/t/01-basic.t b/t/01-basic.t new file mode 100644 index 0000000..a448abf --- /dev/null +++ b/t/01-basic.t @@ -0,0 +1,32 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 9; + +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'); diff --git a/t/010-immutable.t b/t/010-immutable.t deleted file mode 100644 index 36430eb..0000000 --- a/t/010-immutable.t +++ /dev/null @@ -1,43 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 6; - -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'); diff --git a/t/02-methods.t b/t/02-methods.t new file mode 100644 index 0000000..03b8101 --- /dev/null +++ b/t/02-methods.t @@ -0,0 +1,25 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 3; + +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'); diff --git a/t/020-BUILD.t b/t/020-BUILD.t deleted file mode 100644 index 81de930..0000000 --- a/t/020-BUILD.t +++ /dev/null @@ -1,56 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 5; - -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'); diff --git a/t/021-BUILDARGS.t b/t/021-BUILDARGS.t deleted file mode 100644 index d6aa973..0000000 --- a/t/021-BUILDARGS.t +++ /dev/null @@ -1,39 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 4; - -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; - -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->meta->make_immutable; -$foo = Foo::Moose->new('bar', foo => 'baz'); -is($foo->name, 'bar', 'superclass constructor gets the right args (immutable)'); -is($foo->foo, 'baz', 'subclass constructor gets the right args (immutable)'); diff --git a/t/022-replaced-constructor.t b/t/022-replaced-constructor.t deleted file mode 100644 index c7b2e44..0000000 --- a/t/022-replaced-constructor.t +++ /dev/null @@ -1,62 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 7; - -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)'); diff --git a/t/023-FOREIGNBUILDARGS.t b/t/023-FOREIGNBUILDARGS.t deleted file mode 100644 index 43529dd..0000000 --- a/t/023-FOREIGNBUILDARGS.t +++ /dev/null @@ -1,79 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 12; - -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; - -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'); -Foo::Moose->meta->make_immutable; -Bar::Moose->meta->make_immutable; -Baz::Moose->meta->make_immutable; -$foo = Foo::Moose->new(foo => 'bar'); -is($foo->foo, 'bar', 'subclass constructor gets the right args (immutable)'); -is($foo->foo_base, 'bar_base', 'subclass constructor gets the right args (immutable)'); -$bar = Bar::Moose->new('baz'); -is($bar->bar, 'baz', 'subclass constructor gets the right args (immutable)'); -is($bar->foo_base, 'baz_base', 'subclass constructor gets the right args (immutable)'); -$baz = Baz::Moose->new('bazbaz'); -is($baz->bar, 'bazbaz', 'extensions of extensions of the nonmoose class respect BUILDARGS (immutable)'); -is($baz->foo_base, 'bazbaz_base', 'extensions of extensions of the nonmoose class respect FOREIGNBUILDARGS (immutable)'); diff --git a/t/024-nonmoose-moose-nonmoose.t b/t/024-nonmoose-moose-nonmoose.t deleted file mode 100644 index faa6f6f..0000000 --- a/t/024-nonmoose-moose-nonmoose.t +++ /dev/null @@ -1,105 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 32; - -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; -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->meta->make_immutable; -$foo = Foo::Moose::Sub->new(name => 'foomoosesub', foo2 => 'FOO2'); -isa_ok($foo, 'Foo'); -isa_ok($foo, 'Foo::Moose'); -TODO: { -local $TODO = 'nonmoose-moose-nonmoose inheritance doesn\'t quite work'; -is($foo->foo, 'foomoosesub', 'got name from nonmoose constructor (immutable)'); -} -is($foo->foo2, 'FOO2', 'got attribute value from moose constructor (immutable)'); -$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 (immutable)'); -is($foo->foo2, 'FOO2', 'got attribute value from moose constructor (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->meta->make_immutable; -$bar = Bar::Moose::Sub->new(name => 'barmoosesub', bar2 => 'BAR2'); -isa_ok($bar, 'Bar'); -isa_ok($bar, 'Bar::Moose'); -TODO: { -local $TODO = 'nonmoose-moose-nonmoose inheritance doesn\'t quite work'; -is($bar->bar, 'barmoosesub', 'got name from nonmoose constructor (immutable)'); -} -is($bar->bar2, 'BAR2', 'got attribute value from moose constructor (immutable)'); -$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 (immutable)'); -is($bar->bar2, 'BAR2', 'got attribute value from moose constructor (immutable)'); diff --git a/t/025-constructor-method-calls.t b/t/025-constructor-method-calls.t deleted file mode 100644 index 7806b44..0000000 --- a/t/025-constructor-method-calls.t +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Moose qw(with_immutable); - -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/03-attrs.t b/t/03-attrs.t new file mode 100644 index 0000000..6b25849 --- /dev/null +++ b/t/03-attrs.t @@ -0,0 +1,36 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 4; + +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'); diff --git a/t/030-only-metaclass-trait.t b/t/030-only-metaclass-trait.t deleted file mode 100644 index 07be5d8..0000000 --- a/t/030-only-metaclass-trait.t +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 4; - -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'); diff --git a/t/031-moose-exporter.t b/t/031-moose-exporter.t deleted file mode 100644 index 8fbfbae..0000000 --- a/t/031-moose-exporter.t +++ /dev/null @@ -1,71 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 8; - -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_metaclass_roles( - for_class => $options{for_class}, - metaclass_roles => ['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_metaclass_roles( - for_class => $options{for_class}, - metaclass_roles => ['MooseX::NonMoose::Meta::Role::Class'], - constructor_class_roles => - ['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'); diff --git a/t/032-moosex-insideout.t b/t/032-moosex-insideout.t deleted file mode 100644 index 128c437..0000000 --- a/t/032-moosex-insideout.t +++ /dev/null @@ -1,85 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -BEGIN { - eval "use MooseX::InsideOut 0.100 ()"; - plan skip_all => "MooseX::InsideOut is required for this test" if $@; - plan tests => 10; -} - -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_metaclass_roles( - for_class => $options{for_class}, - metaclass_roles => ['MooseX::NonMoose::Meta::Role::Class'], - constructor_class_roles => - ['MooseX::NonMoose::Meta::Role::Constructor'], - instance_metaclass_roles => - ['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; -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->meta->make_immutable; -$foo = Foo::Moose->new('FOO', bar => 'BAR'); -is($foo->foo, 'FOO', 'base class accessor works (immutable)'); -is($foo->bar, 'BAR', 'subclass accessor works (immutable)'); -$foo->foo('OOF'); -$foo->bar('RAB'); -is($foo->foo, 'OOF', 'base class accessor works (setting) (immutable)'); -is($foo->bar, 'RAB', 'subclass accessor works (setting) (immutable)'); -my $sub_foo_immutable = eval { Foo::Moose::Sub->new(FOO => bar => 'AHOY') }; -is(eval { $sub_foo_immutable->bar }, 'AHOY', - 'subclass constructor works (immutable)'); diff --git a/t/033-moosex-globref.t b/t/033-moosex-globref.t deleted file mode 100644 index be8c26b..0000000 --- a/t/033-moosex-globref.t +++ /dev/null @@ -1,99 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -BEGIN { - eval "use MooseX::GlobRef ()"; - plan skip_all => "MooseX::GlobRef is required for this test" if $@; - plan tests => 10; -} -# 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_metaclass_roles( - for_class => $options{for_class}, - metaclass_roles => ['MooseX::NonMoose::Meta::Role::Class'], - constructor_class_roles => - ['MooseX::NonMoose::Meta::Role::Constructor'], - instance_metaclass_roles => - ['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; -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->meta->make_immutable; -$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)'); - -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->meta->make_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"); -} diff --git a/t/04-multi-level.t b/t/04-multi-level.t new file mode 100644 index 0000000..4cd0465 --- /dev/null +++ b/t/04-multi-level.t @@ -0,0 +1,55 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 11; + +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'); diff --git a/t/040-destructor.t b/t/040-destructor.t deleted file mode 100644 index f2c88be..0000000 --- a/t/040-destructor.t +++ /dev/null @@ -1,29 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 4; - -my $destroyed = 0; -my $demolished = 0; -package Foo; - -sub new { bless {}, shift } - -sub DESTROY { $destroyed++ } - -package Foo::Sub; -use Moose; -use MooseX::NonMoose; -extends 'Foo'; - -sub DEMOLISH { $demolished++ } - -package main; -{ Foo::Sub->new } -is($destroyed, 1, "non-Moose destructor called"); -is($demolished, 1, "Moose destructor called"); -Foo::Sub->meta->make_immutable; -($destroyed, $demolished) = (0, 0); -{ Foo::Sub->new } -is($destroyed, 1, "non-Moose destructor called (immutable)"); -is($demolished, 1, "Moose destructor called (immutable)"); diff --git a/t/05-moose.t b/t/05-moose.t new file mode 100644 index 0000000..33a14b1 --- /dev/null +++ b/t/05-moose.t @@ -0,0 +1,51 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 12; + +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)'); diff --git a/t/06-disable.t b/t/06-disable.t new file mode 100644 index 0000000..6d652ab --- /dev/null +++ b/t/06-disable.t @@ -0,0 +1,33 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 3; + +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'); diff --git a/t/10-immutable.t b/t/10-immutable.t new file mode 100644 index 0000000..36430eb --- /dev/null +++ b/t/10-immutable.t @@ -0,0 +1,43 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 6; + +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'); diff --git a/t/100-buggy-constructor-inlining.t b/t/100-buggy-constructor-inlining.t deleted file mode 100644 index 591fae0..0000000 --- a/t/100-buggy-constructor-inlining.t +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 6; - -my ($Foo, $Bar, $Baz) = (0, 0, 0); -{ - 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++ } -} - -Baz->new; -{ local $TODO = "need to call custom constructor for other classes, not Moose::Object->new"; -is($Foo, 1, "Foo->new is called"); -} -{ local $TODO = "need to call non-Moose constructor, not superclass constructor"; -is($Bar, 0, "Bar->new is not called"); -} -is($Baz, 1, "Baz->new is called"); - -Baz->meta->make_immutable; -($Foo, $Bar, $Baz) = (0, 0, 0); - -Baz->new; -is($Foo, 1, "Foo->new is called"); -{ local $TODO = "need to call non-Moose constructor, not superclass constructor"; -is($Bar, 0, "Bar->new is not called"); -} -is($Baz, 1, "Baz->new is called"); diff --git a/t/101-buggy-constructors.t b/t/101-buggy-constructors.t deleted file mode 100644 index 066498d..0000000 --- a/t/101-buggy-constructors.t +++ /dev/null @@ -1,98 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Exception; -use Test::Moose; - -{ - package Foo; - - sub new { bless {}, shift } -} - -{ - package Foo::Sub; - use Moose; - use MooseX::NonMoose; - - extends 'Foo'; -} - -with_immutable { - my $foo; - lives_ok { - $foo = Foo::Sub->new; - } "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; - lives_ok { - $foo = BadFoo::Sub->new; - } "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; - throws_ok { - $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; - throws_ok { - $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/20-BUILD.t b/t/20-BUILD.t new file mode 100644 index 0000000..81de930 --- /dev/null +++ b/t/20-BUILD.t @@ -0,0 +1,56 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 5; + +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'); diff --git a/t/21-BUILDARGS.t b/t/21-BUILDARGS.t new file mode 100644 index 0000000..d6aa973 --- /dev/null +++ b/t/21-BUILDARGS.t @@ -0,0 +1,39 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 4; + +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; + +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->meta->make_immutable; +$foo = Foo::Moose->new('bar', foo => 'baz'); +is($foo->name, 'bar', 'superclass constructor gets the right args (immutable)'); +is($foo->foo, 'baz', 'subclass constructor gets the right args (immutable)'); diff --git a/t/22-replaced-constructor.t b/t/22-replaced-constructor.t new file mode 100644 index 0000000..c7b2e44 --- /dev/null +++ b/t/22-replaced-constructor.t @@ -0,0 +1,62 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 7; + +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)'); diff --git a/t/23-FOREIGNBUILDARGS.t b/t/23-FOREIGNBUILDARGS.t new file mode 100644 index 0000000..43529dd --- /dev/null +++ b/t/23-FOREIGNBUILDARGS.t @@ -0,0 +1,79 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 12; + +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; + +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'); +Foo::Moose->meta->make_immutable; +Bar::Moose->meta->make_immutable; +Baz::Moose->meta->make_immutable; +$foo = Foo::Moose->new(foo => 'bar'); +is($foo->foo, 'bar', 'subclass constructor gets the right args (immutable)'); +is($foo->foo_base, 'bar_base', 'subclass constructor gets the right args (immutable)'); +$bar = Bar::Moose->new('baz'); +is($bar->bar, 'baz', 'subclass constructor gets the right args (immutable)'); +is($bar->foo_base, 'baz_base', 'subclass constructor gets the right args (immutable)'); +$baz = Baz::Moose->new('bazbaz'); +is($baz->bar, 'bazbaz', 'extensions of extensions of the nonmoose class respect BUILDARGS (immutable)'); +is($baz->foo_base, 'bazbaz_base', 'extensions of extensions of the nonmoose class respect FOREIGNBUILDARGS (immutable)'); diff --git a/t/24-nonmoose-moose-nonmoose.t b/t/24-nonmoose-moose-nonmoose.t new file mode 100644 index 0000000..faa6f6f --- /dev/null +++ b/t/24-nonmoose-moose-nonmoose.t @@ -0,0 +1,105 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 32; + +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; +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->meta->make_immutable; +$foo = Foo::Moose::Sub->new(name => 'foomoosesub', foo2 => 'FOO2'); +isa_ok($foo, 'Foo'); +isa_ok($foo, 'Foo::Moose'); +TODO: { +local $TODO = 'nonmoose-moose-nonmoose inheritance doesn\'t quite work'; +is($foo->foo, 'foomoosesub', 'got name from nonmoose constructor (immutable)'); +} +is($foo->foo2, 'FOO2', 'got attribute value from moose constructor (immutable)'); +$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 (immutable)'); +is($foo->foo2, 'FOO2', 'got attribute value from moose constructor (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->meta->make_immutable; +$bar = Bar::Moose::Sub->new(name => 'barmoosesub', bar2 => 'BAR2'); +isa_ok($bar, 'Bar'); +isa_ok($bar, 'Bar::Moose'); +TODO: { +local $TODO = 'nonmoose-moose-nonmoose inheritance doesn\'t quite work'; +is($bar->bar, 'barmoosesub', 'got name from nonmoose constructor (immutable)'); +} +is($bar->bar2, 'BAR2', 'got attribute value from moose constructor (immutable)'); +$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 (immutable)'); +is($bar->bar2, 'BAR2', 'got attribute value from moose constructor (immutable)'); diff --git a/t/25-constructor-method-calls.t b/t/25-constructor-method-calls.t new file mode 100644 index 0000000..7806b44 --- /dev/null +++ b/t/25-constructor-method-calls.t @@ -0,0 +1,47 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Moose qw(with_immutable); + +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/30-only-metaclass-trait.t b/t/30-only-metaclass-trait.t new file mode 100644 index 0000000..07be5d8 --- /dev/null +++ b/t/30-only-metaclass-trait.t @@ -0,0 +1,22 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 4; + +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'); diff --git a/t/31-moose-exporter.t b/t/31-moose-exporter.t new file mode 100644 index 0000000..8fbfbae --- /dev/null +++ b/t/31-moose-exporter.t @@ -0,0 +1,71 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 8; + +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_metaclass_roles( + for_class => $options{for_class}, + metaclass_roles => ['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_metaclass_roles( + for_class => $options{for_class}, + metaclass_roles => ['MooseX::NonMoose::Meta::Role::Class'], + constructor_class_roles => + ['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'); diff --git a/t/32-moosex-insideout.t b/t/32-moosex-insideout.t new file mode 100644 index 0000000..128c437 --- /dev/null +++ b/t/32-moosex-insideout.t @@ -0,0 +1,85 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +BEGIN { + eval "use MooseX::InsideOut 0.100 ()"; + plan skip_all => "MooseX::InsideOut is required for this test" if $@; + plan tests => 10; +} + +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_metaclass_roles( + for_class => $options{for_class}, + metaclass_roles => ['MooseX::NonMoose::Meta::Role::Class'], + constructor_class_roles => + ['MooseX::NonMoose::Meta::Role::Constructor'], + instance_metaclass_roles => + ['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; +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->meta->make_immutable; +$foo = Foo::Moose->new('FOO', bar => 'BAR'); +is($foo->foo, 'FOO', 'base class accessor works (immutable)'); +is($foo->bar, 'BAR', 'subclass accessor works (immutable)'); +$foo->foo('OOF'); +$foo->bar('RAB'); +is($foo->foo, 'OOF', 'base class accessor works (setting) (immutable)'); +is($foo->bar, 'RAB', 'subclass accessor works (setting) (immutable)'); +my $sub_foo_immutable = eval { Foo::Moose::Sub->new(FOO => bar => 'AHOY') }; +is(eval { $sub_foo_immutable->bar }, 'AHOY', + 'subclass constructor works (immutable)'); diff --git a/t/33-moosex-globref.t b/t/33-moosex-globref.t new file mode 100644 index 0000000..be8c26b --- /dev/null +++ b/t/33-moosex-globref.t @@ -0,0 +1,99 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +BEGIN { + eval "use MooseX::GlobRef ()"; + plan skip_all => "MooseX::GlobRef is required for this test" if $@; + plan tests => 10; +} +# 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_metaclass_roles( + for_class => $options{for_class}, + metaclass_roles => ['MooseX::NonMoose::Meta::Role::Class'], + constructor_class_roles => + ['MooseX::NonMoose::Meta::Role::Constructor'], + instance_metaclass_roles => + ['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; +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->meta->make_immutable; +$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)'); + +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->meta->make_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"); +} diff --git a/t/40-destructor.t b/t/40-destructor.t new file mode 100644 index 0000000..f2c88be --- /dev/null +++ b/t/40-destructor.t @@ -0,0 +1,29 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 4; + +my $destroyed = 0; +my $demolished = 0; +package Foo; + +sub new { bless {}, shift } + +sub DESTROY { $destroyed++ } + +package Foo::Sub; +use Moose; +use MooseX::NonMoose; +extends 'Foo'; + +sub DEMOLISH { $demolished++ } + +package main; +{ Foo::Sub->new } +is($destroyed, 1, "non-Moose destructor called"); +is($demolished, 1, "Moose destructor called"); +Foo::Sub->meta->make_immutable; +($destroyed, $demolished) = (0, 0); +{ Foo::Sub->new } +is($destroyed, 1, "non-Moose destructor called (immutable)"); +is($demolished, 1, "Moose destructor called (immutable)"); diff --git a/t/50-buggy-constructor-inlining.t b/t/50-buggy-constructor-inlining.t new file mode 100644 index 0000000..591fae0 --- /dev/null +++ b/t/50-buggy-constructor-inlining.t @@ -0,0 +1,45 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 6; + +my ($Foo, $Bar, $Baz) = (0, 0, 0); +{ + 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++ } +} + +Baz->new; +{ local $TODO = "need to call custom constructor for other classes, not Moose::Object->new"; +is($Foo, 1, "Foo->new is called"); +} +{ local $TODO = "need to call non-Moose constructor, not superclass constructor"; +is($Bar, 0, "Bar->new is not called"); +} +is($Baz, 1, "Baz->new is called"); + +Baz->meta->make_immutable; +($Foo, $Bar, $Baz) = (0, 0, 0); + +Baz->new; +is($Foo, 1, "Foo->new is called"); +{ local $TODO = "need to call non-Moose constructor, not superclass constructor"; +is($Bar, 0, "Bar->new is not called"); +} +is($Baz, 1, "Baz->new is called"); diff --git a/t/51-buggy-constructors.t b/t/51-buggy-constructors.t new file mode 100644 index 0000000..066498d --- /dev/null +++ b/t/51-buggy-constructors.t @@ -0,0 +1,98 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Exception; +use Test::Moose; + +{ + package Foo; + + sub new { bless {}, shift } +} + +{ + package Foo::Sub; + use Moose; + use MooseX::NonMoose; + + extends 'Foo'; +} + +with_immutable { + my $foo; + lives_ok { + $foo = Foo::Sub->new; + } "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; + lives_ok { + $foo = BadFoo::Sub->new; + } "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; + throws_ok { + $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; + throws_ok { + $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; -- cgit v1.2.3