Changeset 25463 for lang/perl/Shika

Timestamp:

11/30/08 22:58:52 (4 years ago)

Author:

yappo

Message:

role を with した時にちゃんと SUBTYPE/COERCE を引き継ぐ、さっきの壊れてた

Location:

lang/perl/Shika/trunk/lib

Files:

• Shika.pm (modified) (1 diff)
• Shika/Role.pm (modified) (1 diff)
• Shika/Util/TypeConstraints.pm (modified) (2 diffs)

lang/perl/Shika/trunk/lib/Shika.pm

@@ -318 +318 @@
         # copy subtype/coerce
         require Shika::Util::TypeConstraints;
-        Shika::Util::TypeConstraints::copy_types($role, $target);
+        Shika::Util::TypeConstraints::copy_types($role, $target, '-all');
 
         push @{ $target->meta->{role} }, $role;

lang/perl/Shika/trunk/lib/Shika/Role.pm

@@ -57 +57 @@
         # copy subtype/coerce
         require Shika::Util::TypeConstraints;
-        Shika::Util::TypeConstraints::copy_types($role, $target);
+        Shika::Util::TypeConstraints::copy_types($role, $target, '-all');
 
         push @{ $target->meta->{role} }, $role;

lang/perl/Shika/trunk/lib/Shika/Util/TypeConstraints.pm

@@ -33 +33 @@
     return unless exists $SUBTYPE->{$class} && exists $COERCE->{$class};
     my $pkg = caller(1);
+    return unless @types;
     copy_types($class, $pkg, @types);
 }
@@ -40 +41 @@
     $SUBTYPE->{$target} ||= +{};
     $COERCE->{$target}  ||= +{};
+
+    if ($types[0] eq '-all') {
+        @types = ();
+        my %cache;
+        for my $type (%{ $SUBTYPE->{$src} }, %{ $COERCE->{$src} }) {
+            next if $cache{$type}++;
+            push @types, $type;
+        }
+    }
 
     for my $type (@types) {