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