Changeset 7197 for perl5/Perl6-Value/lib/Perl6/Code.pm

Timestamp:

09/29/05 06:44:20 (3 years ago)

Author:

putter

Message:

Perl6/Code.pm: Typechecking of Array and Hash parameters repaired (vis MM2). And check_params() now returns (mostly placeholder) error messages.

Files:

• perl5/Perl6-Value/lib/Perl6/Code.pm (modified) (4 diffs)

perl5/Perl6-Value/lib/Perl6/Code.pm

@@ -154 +154 @@
                 Perl6::Type->new( 
                     name => 'Array', 
-                    match => sub { ref($_[0]) eq 'ARRAY' || ref($_[0]) eq 'Array' } ) : 
+                    match => sub { ref($_[0]) eq 'ARRAY' || ref($_[0]) eq 'Array' || ref($_[0]) eq 'Dispatchable' && $_[0]->isa('Array') } ) : 
             $name =~ /^\%/ ? 
                 Perl6::Type->new( 
                     name => 'Hash', 
-                    match => sub { ref($_[0]) eq 'HASH'  || ref($_[0]) eq 'Hash' } ) : 
+                    match => sub { ref($_[0]) eq 'HASH'  || ref($_[0]) eq 'Hash' || ref($_[0]) eq 'Dispatchable' && $_[0]->isa('Hash') } ) : 
             $name =~ /^\&/ ?
                 Perl6::Type->new( 
@@ -253 +253 @@
                 return $j if $j;
 
-                $self->check_params(@arguments)
-                    || confess "Signature does not match - (" . $self->signature_str . ")";
+                my($ok,$err)=$self->check_params(@arguments);
+                $ok || confess "Signature does not match - (" . $self->signature_str . "): $err";
                 # my %bound_params = $::SELF->bind_params(@arguments); 
                 # warn "entering sub ".$self->name;   
@@ -285 +285 @@
                     if ( $i >= scalar @{ $self->params } && $i >= scalar @params ) {
                         #warn "CHECK: $i - required $num_required - given @params";
-                        return 0 if $num_required > scalar @params;
+                        return (0,"err1") if $num_required > scalar @params;
                         return 1;
                     }
                     # return 1 if $i > scalar $#{ $self->params } && $i > scalar $#params;
-                    return 0 if $i > scalar $#{ $self->params } && $i <= scalar $#params;
+                    return (0,"err2") if $i > scalar $#{ $self->params } && $i <= scalar $#params;
                     # warn $i;
                     my $spec = ${ $self->params }[$i];
@@ -296 +296 @@
                     next if $spec->optional && ! defined $candidate;
                     if ( $spec->slurpy ) {    ## && $spec->name eq 'Array' ) {
-                        ## return 0 unless $spec->match_type( [ @params[$i..$#params] ] ); XXX
+                        ## return (0,"") unless $spec->match_type( [ @params[$i..$#params] ] ); XXX
                         return 1;   # @params = ();
                     }
                     else {
-                        return 0 unless $spec->match_type($candidate);
+                        my $mt = $spec->match_type($candidate);
+                        return (0,"type mismatch: $candidate vs ".$spec->str)
+                            if !$mt;
                     }
                 }