File Coverage

blib/lib/Mite/Signature/Compiler.pm
Criterion Covered Total %
statement 38 42 90.4
branch 6 10 60.0
condition 6 17 35.2
subroutine 10 10 100.0
pod 0 1 0.0
total 60 80 75.0


line stmt bran cond sub pod time code
1 8     8   160 use 5.010001;
  8         26  
2 8     8   39 use strict;
  8         14  
  8         159  
3 8     8   41 use warnings;
  8         18  
  8         396  
4              
5              
6             use Type::Params::Signature 1.016008 ();
7 8     8   3600 use Types::Standard qw( Slurpy );
  8         250200  
  8         225  
8 8     8   67 use Scalar::Util ();
  8         17  
  8         47  
9 8     8   4085  
  8         17  
  8         2926  
10             our @ISA = 'Type::Params::Signature';
11              
12             my $self = shift;
13              
14 10     10 0 3193 Scalar::Util::weaken( $self->{mite_signature} );
15              
16 10         46 # This is not a Mite class, so manually call
17             # parent BUILD:
18             $self->SUPER::BUILD( @_ );
19             }
20 10         90  
21             my ( $self, %args ) = @_;
22              
23             my $croaker = $self->{mite_signature}->class->_function_for_croak;
24 19     19   2801  
25             return sprintf '%s( "Failure in signature for %s: " . %s )', $croaker, $self->subname, $args{message};
26 19         72 }
27              
28 19         42 my ( $self, %args ) = @_;
29              
30             my $type = $args{constraint};
31             if ( $type->parent and $type->parent->{uniq} == Slurpy->{uniq} ) {
32 28     28   7899 $type = $type->type_parameter || $type;
33             }
34 28         51  
35 28 50 33     61 my $croaker = $self->{mite_signature}->class->_function_for_croak;
36 0   0     0  
37             return sprintf '%s( "Type check failed in signature for %s: %%s should be %%s", %s, %s )',
38             $croaker, $self->subname, B::perlstring( $args{display_var} || $args{varname} ), B::perlstring( $type->display_name );
39 28         606 }
40              
41             my ( $self, %args ) = @_;
42 28   33     86  
43             my $msg;
44             my $min = $args{minimum};
45             my $max = $args{minimum};
46 10     10   4280
47             if ( defined $min and defined $max and $min==$max ) {
48 10         32 $msg = sprintf 'expected exactly %d parameters', $min;
49 10         16 }
50 10         22 elsif ( defined $max ) {
51             $msg = sprintf 'expected between %d and %d parameters', $min || 0, $max;
52 10 100 66     86 }
    50 66        
    50          
53 4         20 elsif ( defined $min ) {
54             $msg = sprintf 'expected at least %d parameters', $min;
55             }
56 0   0     0 else {
57             $msg = 'that does not seem right';
58             }
59 0         0  
60             my $croaker = $self->{mite_signature}->class->_function_for_croak;
61              
62 6         11 if ( $args{got} ) {
63             return sprintf '%s( "Wrong number of parameters in signature for %%s: got %%d, %%s", %s, %s, %s )',
64             $croaker, B::perlstring( $self->subname ), $args{got}, B::perlstring( $msg );
65 10         84 }
66             else {
67 10 50       42 return sprintf '%s( "Wrong number of parameters in signature for %%s: got ???, %%s", %s, %s )',
68             $croaker, B::perlstring( $self->subname ), B::perlstring( $msg );
69 10         60 }
70            
71             }
72 0            
73             1;