Changeset 25463 for lang/perl/Shika

Show
Ignore:
Timestamp:
11/30/08 22:58:52 (6 years ago)
Author:
yappo
Message:

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

Location:
lang/perl/Shika/trunk/lib
Files:
3 modified

Legend:

Unmodified
Added
Removed
  • lang/perl/Shika/trunk/lib/Shika.pm

    r25459 r25463  
    318318        # copy subtype/coerce 
    319319        require Shika::Util::TypeConstraints; 
    320         Shika::Util::TypeConstraints::copy_types($role, $target); 
     320        Shika::Util::TypeConstraints::copy_types($role, $target, '-all'); 
    321321 
    322322        push @{ $target->meta->{role} }, $role; 
  • lang/perl/Shika/trunk/lib/Shika/Role.pm

    r25459 r25463  
    5757        # copy subtype/coerce 
    5858        require Shika::Util::TypeConstraints; 
    59         Shika::Util::TypeConstraints::copy_types($role, $target); 
     59        Shika::Util::TypeConstraints::copy_types($role, $target, '-all'); 
    6060 
    6161        push @{ $target->meta->{role} }, $role; 
  • lang/perl/Shika/trunk/lib/Shika/Util/TypeConstraints.pm

    r25459 r25463  
    3333    return unless exists $SUBTYPE->{$class} && exists $COERCE->{$class}; 
    3434    my $pkg = caller(1); 
     35    return unless @types; 
    3536    copy_types($class, $pkg, @types); 
    3637} 
     
    4041    $SUBTYPE->{$target} ||= +{}; 
    4142    $COERCE->{$target}  ||= +{}; 
     43 
     44    if ($types[0] eq '-all') { 
     45        @types = (); 
     46        my %cache; 
     47        for my $type (%{ $SUBTYPE->{$src} }, %{ $COERCE->{$src} }) { 
     48            next if $cache{$type}++; 
     49            push @types, $type; 
     50        } 
     51    } 
    4252 
    4353    for my $type (@types) {