summaryrefslogtreecommitdiffstats
path: root/t
diff options
context:
space:
mode:
Diffstat (limited to 't')
-rw-r--r--t/031-moose-exporter.t71
-rw-r--r--t/032-moosex-insideout.t77
-rw-r--r--t/033-moosex-globref.t99
3 files changed, 247 insertions, 0 deletions
diff --git a/t/031-moose-exporter.t b/t/031-moose-exporter.t
new file mode 100644
index 0000000..8fbfbae
--- /dev/null
+++ b/t/031-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/032-moosex-insideout.t b/t/032-moosex-insideout.t
new file mode 100644
index 0000000..ea78cf8
--- /dev/null
+++ b/t/032-moosex-insideout.t
@@ -0,0 +1,77 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+BEGIN {
+ eval "use MooseX::InsideOut ()";
+ plan skip_all => "MooseX::InsideOut is required for this test" if $@;
+ plan tests => 8;
+}
+
+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 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)');
+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)');
diff --git a/t/033-moosex-globref.t b/t/033-moosex-globref.t
new file mode 100644
index 0000000..6a8b4f6
--- /dev/null
+++ b/t/033-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", 4;
+ 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", 4;
+ 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");
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-29 15:33:53 +0000