#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 29;
+use Test::More;
use Test::Exception;
use Scalar::Util 'isweak';
-
{
package Foo;
use Mouse;
ok(isweak($foo->{foo_weak}), '... it is a weak reference');
}
-
-
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 57;
+use Test::More;
use Test::Exception;
use Scalar::Util 'isweak';
-
{
package Foo;
use Mouse;
is_deeply( \%hash, { foo => 1, bar => 2 }, "list context");
}
-
-
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 15;
+use Test::More;
use Test::Exception;
-
{
package Foo;
use Mouse;
Foo->new;
} qr/^Attribute \(bar\) is required/, '... must supply all the required attribute';
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 16;
+use Test::More;
use Test::Exception;
-
{
package Foo::Meta::Attribute;
use Mouse;
isa_ok($foo_attr_type_constraint, 'Mouse::Meta::TypeConstraint');
is($foo_attr_type_constraint->name, 'Foo', '... got the right type constraint name');
-
- is($foo_attr_type_constraint->parent, 'Object', '... got the right type constraint parent name');
+ is($foo_attr_type_constraint->parent->name, 'Object', '... got the right type constraint parent name');
}
{
package Bar::Meta::Attribute;
use Mouse;
- #extends 'Class::MOP::Attribute';
- extends 'Foo::Meta::Attribute';
+ extends 'Mouse::Meta::Attribute';
package Bar;
use Mouse;
isa_ok($bar_attr, 'Mouse::Meta::Attribute');
}
-
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 18;
+use Test::More;
use Test::Exception;
-
{
package Foo;
use Mouse;
Bar->new(baz => {})
} '... didnt create a new Bar with baz as a HASH ref';
-
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 11;
+use Test::More;
use Test::Exception;
-
{
package Customer;
use Mouse;
is_deeply [ $autoderef->bar ], [ 1, 2, 3 ], '... auto-dereffed correctly';
}
+
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 2;
+use Test::More;
use Test::Exception;
$r->headers;
} '... this coerces and passes the type constraint even with lazy';
-
-
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use lib 't/lib';
-
-use Test::More tests => 12;
+use Test::More;
use Test::Exception;
use Test::Mouse;
-use MooseCompat;
{
package My::Attribute::Trait;
ok(!$gorch_attr->has_applied_traits, '... no traits applied');
is($gorch_attr->applied_traits, undef, '... no traits applied');
-
-
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use lib 't/lib';
-
-use Test::More tests => 7;
+use Test::More;
use Test::Exception;
use Test::Mouse;
does_ok($c->meta->get_attribute('bar'), 'My::Attribute::Trait');
is($c->meta->get_attribute('bar')->_is_metadata, 'ro', '... got the right metaclass customization');
-
-
-
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 4;
+use Test::More;
use Test::Exception;
is( $foo->foo, "blah", "field is set via setter" );
}
+
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 11;
+use Test::More;
use Test::Exception;
-
{
package Fake::DateTime;
isa_ok( $mtg->closing_date, 'Fake::DateTime' );
}
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
#!/usr/bin/env perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 5;
+use Test::More;
{
package My::Attribute::Trait;
ok(!$other_attr->can('enam'), "the method was not installed under the other class' alias");
ok(!$other_attr->can('reversed_name'), "the method was not installed under the original name when that was excluded");
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 4;
+use Test::More;
use Test::Exception;
{
isa_ok($foo->bar->baz, 'Baz');
is($foo->bar->baz->hello, 'World', '... this all worked fine');
-
+done_testing;
#!/usr/bin/perl
-BEGIN{ $ENV{MOUSE_VERBOSE} = 1 }
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+
use strict;
use warnings;
-use Test::More tests => 2;
+use Test::More;
use Mouse ();
use Mouse::Meta::Class;
$warn = '';
$meta->add_attribute('bar', is => 'bare');
is $warn, '', 'add attribute with no methods and is => "bare"';
+
+done_testing;
--- /dev/null
+#!/usr/bin/env perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+use strict;
+use warnings;
+use Test::More;
+$TODO = q{Mouse is not yet completed};
+
+use Test::Requires {
+ 'Test::Output' => '0.01', # skip all if not installed
+};
+
+{
+ package Foo;
+ use Mouse;
+
+ sub get_a { }
+ sub set_b { }
+ sub has_c { }
+ sub clear_d { }
+ sub e { }
+}
+
+my $foo_meta = Foo->meta;
+stderr_like(sub { $foo_meta->add_attribute(a => (reader => 'get_a')) },
+ qr/^You are overwriting a locally defined method \(get_a\) with an accessor/, 'reader overriding gives proper warning');
+stderr_like(sub { $foo_meta->add_attribute(b => (writer => 'set_b')) },
+ qr/^You are overwriting a locally defined method \(set_b\) with an accessor/, 'writer overriding gives proper warning');
+stderr_like(sub { $foo_meta->add_attribute(c => (predicate => 'has_c')) },
+ qr/^You are overwriting a locally defined method \(has_c\) with an accessor/, 'predicate overriding gives proper warning');
+stderr_like(sub { $foo_meta->add_attribute(d => (clearer => 'clear_d')) },
+ qr/^You are overwriting a locally defined method \(clear_d\) with an accessor/, 'clearer overriding gives proper warning');
+stderr_like(sub { $foo_meta->add_attribute(e => (is => 'rw')) },
+ qr/^You are overwriting a locally defined method \(e\) with an accessor/, 'accessor overriding gives proper warning');
+
+stderr_like(sub { $foo_meta->add_attribute(has => (is => 'rw')) },
+ qr/^You are overwriting a locally defined function \(has\) with an accessor/, 'function overriding gives proper warning');
+
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 14;
+use Test::More;
use Test::Exception;
lives_ok {
is_deeply [$o->h_ro], [], 'uninitialized HashRef attribute/ro in list context';
} 'testing';
+
+done_testing;
use strict;
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use warnings;
-use Test::More tests => 12;
+use Test::More;
+use Test::Mouse;
{
package Foo;
default => 1,
);
+ # Assigning types to these non-alpha attrs exposed a bug in Mouse.
has '@type' => (
+ isa => 'Str',
required => 0,
reader => 'get_at_type',
- default => 2,
+ writer => 'set_at_type',
+ default => 'at type',
);
has 'has spaces' => (
+ isa => 'Int',
required => 0,
reader => 'get_hs',
default => 42,
);
+ has '!req' => (
+ required => 1,
+ reader => 'req'
+ );
+
no Mouse;
}
-{
- my $foo = Foo->new;
-
+with_immutable {
ok( Foo->meta->has_attribute($_), "Foo has '$_' attribute" )
for 'type', '@type', 'has spaces';
- is( $foo->get_type, 1, q{'type' attribute default is 1} );
- is( $foo->get_at_type, 2, q{'@type' attribute default is 1} );
- is( $foo->get_hs, 42, q{'has spaces' attribute default is 42} );
+ my $foo = Foo->new( '!req' => 42 );
+
+ is( $foo->get_type, 1, q{'type' attribute default is 1} );
+ is( $foo->get_at_type, 'at type', q{'@type' attribute default is 1} );
+ is( $foo->get_hs, 42, q{'has spaces' attribute default is 42} );
- Foo->meta->make_immutable, redo if Foo->meta->is_mutable;
+ $foo = Foo->new(
+ type => 'foo',
+ '@type' => 'bar',
+ 'has spaces' => 200,
+ '!req' => 84,
+ );
+
+ isa_ok( $foo, 'Foo' );
+ is( $foo->get_at_type, 'bar', q{reader for '@type'} );
+ is( $foo->get_hs, 200, q{reader for 'has spaces'} );
+
+ $foo->set_at_type(99);
+ is( $foo->get_at_type, 99, q{writer for '@type' worked} );
}
+'Foo';
+
+done_testing;
--- /dev/null
+#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+{
+ package Bar;
+ use Mouse;
+
+ sub baz { 'Bar::baz' }
+ sub gorch { 'Bar::gorch' }
+
+ package Foo;
+ use Mouse;
+
+ has 'bar' => (
+ is => 'ro',
+ isa => 'Bar',
+ lazy => 1,
+ default => sub { Bar->new },
+ handles => [qw[ baz gorch ]]
+ );
+
+ package Foo::Extended;
+ use Mouse;
+
+ extends 'Foo';
+
+ has 'test' => (
+ is => 'rw',
+ isa => 'Bool',
+ default => sub { 0 },
+ );
+
+ around 'bar' => sub {
+ my $next = shift;
+ my $self = shift;
+
+ $self->test(1);
+ $self->$next();
+ };
+}
+
+my $foo = Foo::Extended->new;
+isa_ok($foo, 'Foo::Extended');
+isa_ok($foo, 'Foo');
+
+ok(!$foo->test, '... the test value has not been changed');
+
+is($foo->baz, 'Bar::baz', '... got the right delegated method');
+
+ok($foo->test, '... the test value has now been changed');
+
+done_testing;
--- /dev/null
+#!/usr/bin/env perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+use strict;
+use warnings;
+use Test::More;
+
+{
+ package Foo;
+ use Mouse;
+
+ sub aliased {
+ my $self = shift;
+ $_[1] = $_[0];
+ }
+}
+
+{
+ package HasFoo;
+ use Mouse;
+
+ has foo => (
+ is => 'ro',
+ isa => 'Foo',
+ handles => {
+ foo_aliased => 'aliased',
+ foo_aliased_curried => ['aliased', 'bar'],
+ }
+ );
+}
+
+my $hasfoo = HasFoo->new(foo => Foo->new);
+my $x;
+$hasfoo->foo->aliased('foo', $x);
+is($x, 'foo', "direct aliasing works");
+undef $x;
+$hasfoo->foo_aliased('foo', $x);
+is($x, 'foo', "delegated aliasing works");
+undef $x;
+$hasfoo->foo_aliased_curried($x);
+is($x, 'bar', "delegated aliasing with currying works");
+
+done_testing;
--- /dev/null
+#!/usr/bin/env perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+use strict;
+use warnings;
+use Test::More;
+use Test::Mouse;
+use B;
+
+{
+ package Foo;
+ use Mouse;
+
+ has foo => (is => 'ro', default => 100);
+
+ sub bar { 100 }
+}
+
+with_immutable {
+ my $foo = Foo->new;
+ for my $meth (qw(foo bar)) {
+ my $val = $foo->$meth;
+ my $b = B::svref_2object(\$val);
+ my $flags = $b->FLAGS;
+ ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int");
+ ok(!($flags & B::SVf_POK), "not a string");
+ }
+} 'Foo';
+
+{
+ package Bar;
+ use Mouse;
+
+ has foo => (is => 'ro', lazy => 1, default => 100);
+
+ sub bar { 100 }
+}
+
+with_immutable {
+ my $bar = Bar->new;
+ for my $meth (qw(foo bar)) {
+ my $val = $bar->$meth;
+ my $b = B::svref_2object(\$val);
+ my $flags = $b->FLAGS;
+ ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int");
+ ok(!($flags & B::SVf_POK), "not a string");
+ }
+} 'Bar';
+
+{
+ package Baz;
+ use Mouse;
+
+ has foo => (is => 'ro', isa => 'Int', lazy => 1, default => 100);
+
+ sub bar { 100 }
+}
+
+with_immutable {
+ my $baz = Baz->new;
+ for my $meth (qw(foo bar)) {
+ my $val = $baz->$meth;
+ my $b = B::svref_2object(\$val);
+ my $flags = $b->FLAGS;
+ ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int");
+ ok(!($flags & B::SVf_POK), "not a string");
+ }
+} 'Baz';
+
+{
+ package Foo2;
+ use Mouse;
+
+ has foo => (is => 'ro', default => 10.5);
+
+ sub bar { 10.5 }
+}
+
+with_immutable {
+ my $foo2 = Foo2->new;
+ for my $meth (qw(foo bar)) {
+ my $val = $foo2->$meth;
+ my $b = B::svref_2object(\$val);
+ my $flags = $b->FLAGS;
+ ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num");
+ ok(!($flags & B::SVf_POK), "not a string");
+ }
+} 'Foo2';
+
+{
+ package Bar2;
+ use Mouse;
+
+ has foo => (is => 'ro', lazy => 1, default => 10.5);
+
+ sub bar { 10.5 }
+}
+
+with_immutable {
+ my $bar2 = Bar2->new;
+ for my $meth (qw(foo bar)) {
+ my $val = $bar2->$meth;
+ my $b = B::svref_2object(\$val);
+ my $flags = $b->FLAGS;
+ ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num");
+ ok(!($flags & B::SVf_POK), "not a string");
+ }
+} 'Bar2';
+
+{
+ package Baz2;
+ use Mouse;
+
+ has foo => (is => 'ro', isa => 'Num', lazy => 1, default => 10.5);
+
+ sub bar { 10.5 }
+}
+
+with_immutable {
+ my $baz2 = Baz2->new;
+ for my $meth (qw(foo bar)) {
+ my $val = $baz2->$meth;
+ my $b = B::svref_2object(\$val);
+ my $flags = $b->FLAGS;
+ ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num");
+ ok(!($flags & B::SVf_POK), "not a string");
+ }
+} 'Baz2';
+
+done_testing;
--- /dev/null
+#!/usr/bin/env perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+use strict;
+use warnings;
+use Test::More;
+use Test::Mouse;
+
+{
+ package Foo;
+ use Mouse;
+
+ has foo => (
+ is => 'ro',
+ isa => 'Maybe[Int]',
+ default => undef,
+ predicate => 'has_foo',
+ );
+}
+
+with_immutable {
+ is(Foo->new->foo, undef);
+ ok(Foo->new->has_foo);
+} 'Foo';
+
+done_testing;
projects / gitmo/Mouse.git / commitdiff