r46109 - in /branches/upstream/libmouse-perl/current: ./ lib/ lib/Mouse/ lib/Mouse/Meta/ lib/Mouse/Meta/Method/ lib/Mouse/Meta/Role/ lib/Mouse/Util/ t/001_mouse/ t/010_basics/ t/040_type_constraints/ t/800_shikabased/
ghostbar at users.alioth.debian.org
ghostbar at users.alioth.debian.org
Tue Oct 20 10:41:33 UTC 2009
Author: ghostbar
Date: Tue Oct 20 10:41:28 2009
New Revision: 46109
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=46109
Log:
[svn-upgrade] Integrating new upstream version, libmouse-perl (0.40)
Added:
branches/upstream/libmouse-perl/current/t/001_mouse/057_subtype_without_where.t (with props)
branches/upstream/libmouse-perl/current/t/040_type_constraints/005_util_type_coercion.t (with props)
branches/upstream/libmouse-perl/current/t/040_type_constraints/007_util_more_type_coercion.t (with props)
Removed:
branches/upstream/libmouse-perl/current/t/001_mouse/038-main.t
branches/upstream/libmouse-perl/current/t/010_basics/016_load_into_main.t
Modified:
branches/upstream/libmouse-perl/current/Changes
branches/upstream/libmouse-perl/current/MANIFEST
branches/upstream/libmouse-perl/current/MANIFEST.SKIP
branches/upstream/libmouse-perl/current/META.yml
branches/upstream/libmouse-perl/current/lib/Mouse.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Exporter.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Class.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Accessor.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Destructor.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Composite.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Method.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/TypeConstraint.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Object.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Util/TypeConstraints.pm
branches/upstream/libmouse-perl/current/t/001_mouse/039-subtype.t
branches/upstream/libmouse-perl/current/t/800_shikabased/001-coerce.t
branches/upstream/libmouse-perl/current/t/800_shikabased/002-coerce_multi_class.t
Modified: branches/upstream/libmouse-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/Changes?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/Changes (original)
+++ branches/upstream/libmouse-perl/current/Changes Tue Oct 20 10:41:28 2009
@@ -1,4 +1,10 @@
Revision history for Mouse
+
+0.40 Mon Oct 19 18:30:32 2009
+ * Mouse::Meta::TypeConstraint
+ - Fix a subtyping issue (Thanks miyagawa san)
+ * Mouse/Mouse::Role
+ - Now export their sugars to the "main" package
0.39 Tue Oct 13 16:42:31 2009
* Fix RT #50421 (Thanks Michael G Schwern)
Modified: branches/upstream/libmouse-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/MANIFEST?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/MANIFEST (original)
+++ branches/upstream/libmouse-perl/current/MANIFEST Tue Oct 20 10:41:28 2009
@@ -96,7 +96,6 @@
t/001_mouse/035-apply-roles-to-roles.t
t/001_mouse/036-with-method-alias.t
t/001_mouse/037-dont-load-test-exception.t
-t/001_mouse/038-main.t
t/001_mouse/039-subtype.t
t/001_mouse/040-existing-subclass.t
t/001_mouse/041-enum.t
@@ -114,6 +113,7 @@
t/001_mouse/054-anon-leak.t
t/001_mouse/055-exporter.t
t/001_mouse/056-role-combine.t
+t/001_mouse/057_subtype_without_where.t
t/001_mouse/100-meta-class.t
t/001_mouse/101-meta-attribute.t
t/001_mouse/301-bugs-non-mouse.t
@@ -139,7 +139,6 @@
t/010_basics/013_create.t
t/010_basics/014_create_anon.t
t/010_basics/015_buildargs.t
-t/010_basics/016_load_into_main.t
t/010_basics/017_error_handling.t
t/010_basics/019-destruction.t
t/020_attributes/002_attribute_writer_generation.t
@@ -186,6 +185,8 @@
t/030_roles/041_empty_method_modifiers_meta_bug.t
t/030_roles/042_compose_overloading.t
t/040_type_constraints/003_util_std_type_constraints.t
+t/040_type_constraints/005_util_type_coercion.t
+t/040_type_constraints/007_util_more_type_coercion.t
t/040_type_constraints/009_union_types_and_coercions.t
t/040_type_constraints/015_enum.t
t/040_type_constraints/017_subtyping_union_types.t
Modified: branches/upstream/libmouse-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/MANIFEST.SKIP?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/MANIFEST.SKIP (original)
+++ branches/upstream/libmouse-perl/current/MANIFEST.SKIP Tue Oct 20 10:41:28 2009
@@ -37,6 +37,7 @@
# Moose specific tests
xt/compatibility
+xt/external
t/.*/failing
^TODO$
Modified: branches/upstream/libmouse-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/META.yml?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/META.yml (original)
+++ branches/upstream/libmouse-perl/current/META.yml Tue Oct 20 10:41:28 2009
@@ -25,4 +25,4 @@
perl: 5.6.2
resources:
license: http://dev.perl.org/licenses/
-version: 0.39
+version: 0.40
Modified: branches/upstream/libmouse-perl/current/lib/Mouse.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse.pm Tue Oct 20 10:41:28 2009
@@ -3,7 +3,7 @@
use Mouse::Exporter; # enables strict and warnings
-our $VERSION = '0.39';
+our $VERSION = '0.40';
use Carp qw(confess);
use Scalar::Util qw(blessed);
@@ -160,7 +160,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 SYNOPSIS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Exporter.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Exporter.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Exporter.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Exporter.pm Tue Oct 20 10:41:28 2009
@@ -161,11 +161,6 @@
$^H |= _strict_bits; # strict->import;
${^WARNING_BITS} = $warnings::Bits{all}; # warnings->import;
- if($into eq 'main' && !$spec->{_export_to_main}){
- warn qq{$package does not export its sugar to the 'main' package.\n};
- return;
- }
-
if($spec->{INIT_META}){
foreach my $init_meta(@{$spec->{INIT_META}}){
$into->$init_meta(for_class => $into);
@@ -243,7 +238,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 SYNOPSIS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm Tue Oct 20 10:41:28 2009
@@ -464,7 +464,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 METHODS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Class.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Class.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Class.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Class.pm Tue Oct 20 10:41:28 2009
@@ -43,6 +43,13 @@
}
sub roles { $_[0]->{roles} }
+
+sub calculate_all_roles {
+ my $self = shift;
+ my %seen;
+ return grep { !$seen{ $_->name }++ }
+ map { $_->calculate_all_roles } @{ $self->roles };
+}
sub superclasses {
my $self = shift;
@@ -474,7 +481,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 METHODS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method.pm Tue Oct 20 10:41:28 2009
@@ -31,7 +31,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Accessor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Accessor.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Accessor.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Accessor.pm Tue Oct 20 10:41:28 2009
@@ -194,7 +194,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm Tue Oct 20 10:41:28 2009
@@ -191,7 +191,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Destructor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Destructor.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Destructor.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Destructor.pm Tue Oct 20 10:41:28 2009
@@ -55,7 +55,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm Tue Oct 20 10:41:28 2009
@@ -326,7 +326,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm Tue Oct 20 10:41:28 2009
@@ -34,6 +34,13 @@
}
sub get_roles { $_[0]->{roles} }
+
+sub calculate_all_roles {
+ my $self = shift;
+ my %seen;
+ return grep { !$seen{ $_->name }++ }
+ ($self, map { $_->calculate_all_roles } @{ $self->get_roles });
+}
sub get_required_method_list{
return @{ $_[0]->{required_methods} };
@@ -316,7 +323,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Composite.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Composite.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Composite.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Composite.pm Tue Oct 20 10:41:28 2009
@@ -120,7 +120,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Method.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Method.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Method.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Method.pm Tue Oct 20 10:41:28 2009
@@ -13,7 +13,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/TypeConstraint.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/TypeConstraint.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/TypeConstraint.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/TypeConstraint.pm Tue Oct 20 10:41:28 2009
@@ -101,11 +101,11 @@
my @checks;
for(my $parent = $self->parent; defined $parent; $parent = $parent->parent){
if($parent->{hand_optimized_type_constraint}){
- push @checks, $parent->{hand_optimized_type_constraint};
+ unshift @checks, $parent->{hand_optimized_type_constraint};
last; # a hand optimized constraint must include all the parents
}
elsif($parent->{constraint}){
- push @checks, $parent->{constraint};
+ unshift @checks, $parent->{constraint};
}
}
@@ -249,7 +249,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 DESCRIPTION
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Object.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Object.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Object.pm Tue Oct 20 10:41:28 2009
@@ -95,7 +95,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 METHODS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm Tue Oct 20 10:41:28 2009
@@ -1,7 +1,7 @@
package Mouse::Role;
use Mouse::Exporter; # enables strict and warnings
-our $VERSION = '0.39';
+our $VERSION = '0.40';
use Carp qw(confess);
use Scalar::Util qw(blessed);
@@ -143,7 +143,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 SYNOPSIS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm Tue Oct 20 10:41:28 2009
@@ -2,7 +2,7 @@
use strict;
use warnings;
-our $VERSION = '0.39';
+our $VERSION = '0.40';
our $MouseVersion = $VERSION;
our $MooseVersion = '0.90';
@@ -19,7 +19,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 SYNOPSIS
@@ -41,7 +41,7 @@
Any MOP has no attributes, so
C<< $metaclass->meta->make_immutable() >> does not yet work as you expect.
-=head3 C<Mouse::Meta::Instance>
+=head3 Mouse::Meta::Instance
Meta instance mechanism is not implemented.
@@ -49,7 +49,7 @@
Role exclusion, C<exclude()>, is not implemented.
-=head3 C<-traits> and C<-metaclass> in Mouse::Exporter
+=head3 -traits and -metaclass in Mouse::Exporter
C<< use Mouse -traits => ... >> and C<< use Mouse -metaclass => ... >> are not
yet implemented.
@@ -130,5 +130,11 @@
L<Mouse>
+L<Moose>
+
+L<Moose::Manual>
+
+L<Moose::Cookbook>
+
=cut
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm Tue Oct 20 10:41:28 2009
@@ -34,7 +34,6 @@
# The ':meta' group is 'use metaclass' for Mouse
meta => [qw(does meta dump _MOUSE_VERBOSE)],
},
- _export_to_main => 1,
);
# aliases as public APIs
@@ -354,7 +353,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head1 IMPLEMENTATIONS FOR
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Util/TypeConstraints.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Util/TypeConstraints.pm?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Util/TypeConstraints.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Util/TypeConstraints.pm Tue Oct 20 10:41:28 2009
@@ -14,8 +14,6 @@
type subtype coerce class_type role_type enum
find_type_constraint
)],
-
- _export_to_main => 1,
);
my %TYPE;
@@ -425,7 +423,7 @@
=head1 VERSION
-This document describes Mouse version 0.39
+This document describes Mouse version 0.40
=head2 SYNOPSIS
Modified: branches/upstream/libmouse-perl/current/t/001_mouse/039-subtype.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/t/001_mouse/039-subtype.t?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/t/001_mouse/039-subtype.t (original)
+++ branches/upstream/libmouse-perl/current/t/001_mouse/039-subtype.t Tue Oct 20 10:41:28 2009
@@ -1,7 +1,7 @@
#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 7;
+use Test::More tests => 11;
use Test::Exception;
use Mouse::Util::TypeConstraints;
@@ -16,10 +16,16 @@
=> where { length $_ }
=> message { "The string is empty!" };
+ subtype 'MyClass'
+ => as 'Object'
+ => where { $_->isa(__PACKAGE__) };
+
has name => (
is => 'ro',
isa => 'NonemptyStr',
);
+
+
};
ok(My::Class->new(name => 'foo'));
@@ -35,3 +41,10 @@
ok!$st->check(undef);
ok!$st->check('');
+lives_and{
+ my $tc = find_type_constraint('MyClass');
+ ok $tc->check(My::Class->new());
+ ok!$tc->check('My::Class');
+ ok!$tc->check([]);
+ ok!$tc->check(undef);
+};
Added: branches/upstream/libmouse-perl/current/t/001_mouse/057_subtype_without_where.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/t/001_mouse/057_subtype_without_where.t?rev=46109&op=file
==============================================================================
--- branches/upstream/libmouse-perl/current/t/001_mouse/057_subtype_without_where.t (added)
+++ branches/upstream/libmouse-perl/current/t/001_mouse/057_subtype_without_where.t Tue Oct 20 10:41:28 2009
@@ -1,0 +1,49 @@
+#!/usr/bin/perl -w
+use Test::More tests => 4;
+use Test::Exception;
+
+use Mouse::Util::TypeConstraints;
+
+{
+ package Class;
+ sub new {
+ my $class = shift;
+ return bless { @_ }, $class;
+ }
+}
+
+subtype 'Class',
+ as 'Object',
+ where { $_->isa('Class') };
+
+subtype 'C', as 'Class'; # subtyping without "where"
+
+coerce 'C',
+ from 'Str',
+ via { Class->new(content => $_) },
+ from 'HashRef',
+ via { Class->new(content => $_->{content}) };
+
+{
+ package A;
+ use Mouse;
+
+ has foo => (
+ is => 'ro',
+ isa => 'C',
+ coerce => 1,
+ requried => 1,
+ );
+}
+
+lives_and{
+ my $a = A->new(foo => 'foobar');
+ isa_ok $a->foo, 'Class';
+ is $a->foo->{content}, 'foobar';
+};
+
+lives_and{
+ my $a = A->new(foo => { content => 42 });
+ isa_ok $a->foo, 'Class';
+ is $a->foo->{content}, 42;
+};
Propchange: branches/upstream/libmouse-perl/current/t/001_mouse/057_subtype_without_where.t
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libmouse-perl/current/t/040_type_constraints/005_util_type_coercion.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/t/040_type_constraints/005_util_type_coercion.t?rev=46109&op=file
==============================================================================
--- branches/upstream/libmouse-perl/current/t/040_type_constraints/005_util_type_coercion.t (added)
+++ branches/upstream/libmouse-perl/current/t/040_type_constraints/005_util_type_coercion.t Tue Oct 20 10:41:28 2009
@@ -1,0 +1,108 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8; # tests => 26;
+use Test::Exception;
+
+use lib 't/lib';
+use Test::Mouse;
+
+BEGIN {
+ use_ok('Mouse::Util::TypeConstraints');
+}
+
+{
+ package HTTPHeader;
+ use Mouse;
+
+ has 'array' => (is => 'ro');
+ has 'hash' => (is => 'ro');
+}
+
+subtype Header =>
+ => as Object
+ => where { $_->isa('HTTPHeader') };
+
+coerce Header
+ => from ArrayRef
+ => via { HTTPHeader->new(array => $_[0]) }
+ => from HashRef
+ => via { HTTPHeader->new(hash => $_[0]) };
+
+
+Mouse::Util::TypeConstraints->export_type_constraints_as_functions();
+
+my $header = HTTPHeader->new();
+isa_ok($header, 'HTTPHeader');
+
+ok(Header($header), '... this passed the type test');
+ok(!Header([]), '... this did not pass the type test');
+ok(!Header({}), '... this did not pass the type test');
+
+my $anon_type = subtype Object => where { $_->isa('HTTPHeader') };
+
+lives_ok {
+ coerce $anon_type
+ => from ArrayRef
+ => via { HTTPHeader->new(array => $_[0]) }
+ => from HashRef
+ => via { HTTPHeader->new(hash => $_[0]) };
+} 'coercion of anonymous subtype succeeds';
+
+=pod
+
+foreach my $coercion (
+ find_type_constraint('Header')->coercion,
+ $anon_type->coercion
+ ) {
+ isa_ok($coercion, 'Mouse::Meta::TypeCoercion');
+
+ {
+ my $coerced = $coercion->coerce([ 1, 2, 3 ]);
+ isa_ok($coerced, 'HTTPHeader');
+
+ is_deeply(
+ $coerced->array(),
+ [ 1, 2, 3 ],
+ '... got the right array');
+ is($coerced->hash(), undef, '... nothing assigned to the hash');
+ }
+
+ {
+ my $coerced = $coercion->coerce({ one => 1, two => 2, three => 3 });
+ isa_ok($coerced, 'HTTPHeader');
+
+ is_deeply(
+ $coerced->hash(),
+ { one => 1, two => 2, three => 3 },
+ '... got the right hash');
+ is($coerced->array(), undef, '... nothing assigned to the array');
+ }
+
+ {
+ my $scalar_ref = \(my $var);
+ my $coerced = $coercion->coerce($scalar_ref);
+ is($coerced, $scalar_ref, '... got back what we put in');
+ }
+
+ {
+ my $coerced = $coercion->coerce("Foo");
+ is($coerced, "Foo", '... got back what we put in');
+ }
+}
+
+=cut
+
+subtype 'StrWithTrailingX'
+ => as 'Str'
+ => where { /X$/ };
+
+coerce 'StrWithTrailingX'
+ => from 'Str'
+ => via { $_ . 'X' };
+
+my $tc = find_type_constraint('StrWithTrailingX');
+is($tc->coerce("foo"), "fooX", "coerce when needed");
+is($tc->coerce("fooX"), "fooX", "do not coerce when unneeded");
Propchange: branches/upstream/libmouse-perl/current/t/040_type_constraints/005_util_type_coercion.t
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libmouse-perl/current/t/040_type_constraints/007_util_more_type_coercion.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/t/040_type_constraints/007_util_more_type_coercion.t?rev=46109&op=file
==============================================================================
--- branches/upstream/libmouse-perl/current/t/040_type_constraints/007_util_more_type_coercion.t (added)
+++ branches/upstream/libmouse-perl/current/t/040_type_constraints/007_util_more_type_coercion.t Tue Oct 20 10:41:28 2009
@@ -1,0 +1,117 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 25;
+use Test::Exception;
+
+
+
+{
+ package HTTPHeader;
+ use Mouse;
+ use Mouse::Util::TypeConstraints;
+
+ coerce 'HTTPHeader'
+ => from ArrayRef
+ => via { HTTPHeader->new(array => $_[0]) };
+
+ coerce 'HTTPHeader'
+ => from HashRef
+ => via { HTTPHeader->new(hash => $_[0]) };
+
+ has 'array' => (is => 'ro');
+ has 'hash' => (is => 'ro');
+
+ package Engine;
+ use strict;
+ use warnings;
+ use Mouse;
+
+ has 'header' => (is => 'rw', isa => 'HTTPHeader', coerce => 1);
+}
+
+{
+ my $engine = Engine->new();
+ isa_ok($engine, 'Engine');
+
+ # try with arrays
+
+ lives_ok {
+ $engine->header([ 1, 2, 3 ]);
+ } '... type was coerced without incident';
+ isa_ok($engine->header, 'HTTPHeader');
+
+ is_deeply(
+ $engine->header->array,
+ [ 1, 2, 3 ],
+ '... got the right array value of the header');
+ ok(!defined($engine->header->hash), '... no hash value set');
+
+ # try with hash
+
+ lives_ok {
+ $engine->header({ one => 1, two => 2, three => 3 });
+ } '... type was coerced without incident';
+ isa_ok($engine->header, 'HTTPHeader');
+
+ is_deeply(
+ $engine->header->hash,
+ { one => 1, two => 2, three => 3 },
+ '... got the right hash value of the header');
+ ok(!defined($engine->header->array), '... no array value set');
+
+ dies_ok {
+ $engine->header("Foo");
+ } '... dies with the wrong type, even after coercion';
+
+ lives_ok {
+ $engine->header(HTTPHeader->new);
+ } '... lives with the right type, even after coercion';
+}
+
+{
+ my $engine = Engine->new(header => [ 1, 2, 3 ]);
+ isa_ok($engine, 'Engine');
+
+ isa_ok($engine->header, 'HTTPHeader');
+
+ is_deeply(
+ $engine->header->array,
+ [ 1, 2, 3 ],
+ '... got the right array value of the header');
+ ok(!defined($engine->header->hash), '... no hash value set');
+}
+
+{
+ my $engine = Engine->new(header => { one => 1, two => 2, three => 3 });
+ isa_ok($engine, 'Engine');
+
+ isa_ok($engine->header, 'HTTPHeader');
+
+ is_deeply(
+ $engine->header->hash,
+ { one => 1, two => 2, three => 3 },
+ '... got the right hash value of the header');
+ ok(!defined($engine->header->array), '... no array value set');
+}
+
+{
+ my $engine = Engine->new(header => HTTPHeader->new());
+ isa_ok($engine, 'Engine');
+
+ isa_ok($engine->header, 'HTTPHeader');
+
+ ok(!defined($engine->header->hash), '... no hash value set');
+ ok(!defined($engine->header->array), '... no array value set');
+}
+
+dies_ok {
+ Engine->new(header => 'Foo');
+} '... dies correctly with bad params';
+
+dies_ok {
+ Engine->new(header => \(my $var));
+} '... dies correctly with bad params';
+
Propchange: branches/upstream/libmouse-perl/current/t/040_type_constraints/007_util_more_type_coercion.t
------------------------------------------------------------------------------
svn:executable = *
Modified: branches/upstream/libmouse-perl/current/t/800_shikabased/001-coerce.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/t/800_shikabased/001-coerce.t?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/t/800_shikabased/001-coerce.t (original)
+++ branches/upstream/libmouse-perl/current/t/800_shikabased/001-coerce.t Tue Oct 20 10:41:28 2009
@@ -13,7 +13,7 @@
use Mouse;
use Mouse::Util::TypeConstraints;
- subtype 'HeadersType' => as 'Object' => where { defined $_ && eval { $_->isa('Headers') } };
+ subtype 'HeadersType' => as 'Object' => where { $_->isa('Headers') };
coerce 'HeadersType' =>
from 'ScalarRef' => via {
Headers->new();
Modified: branches/upstream/libmouse-perl/current/t/800_shikabased/002-coerce_multi_class.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/t/800_shikabased/002-coerce_multi_class.t?rev=46109&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/t/800_shikabased/002-coerce_multi_class.t (original)
+++ branches/upstream/libmouse-perl/current/t/800_shikabased/002-coerce_multi_class.t Tue Oct 20 10:41:28 2009
@@ -18,7 +18,7 @@
use Mouse;
use Mouse::Util::TypeConstraints;
- type 'Headers' => where { defined $_ && eval { $_->isa('Response::Headers') } };
+ subtype 'Headers' => as 'Object', where { $_->isa('Response::Headers') };
coerce 'Headers' =>
from 'HashRef' => via {
Response::Headers->new(%{ $_ });
More information about the Pkg-perl-cvs-commits
mailing list