File Coverage

blib/lib/Type/Tiny/Equ.pm
Criterion Covered Total %
statement 36 42 85.7
branch 14 22 63.6
condition 1 3 33.3
subroutine 11 15 73.3
pod 6 6 100.0
total 68 88 77.2


line stmt bran cond sub pod time code
1             package Type::Tiny::Equ;
2 2     2   37 use 5.008001;
  2         12  
3 2     2   10 use strict;
  2         3  
  2         55  
4 2     2   23 use warnings;
  2         4  
  2         99  
5              
6             our $VERSION = "0.01";
7              
8 2     2   12 use parent qw( Type::Tiny );
  2         3  
  2         11  
9              
10 0     0   0 sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }
  0         0  
11              
12             sub new {
13 10     10 1 21 my $class = shift;
14              
15 10 50       44 my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_;
  0         0  
16              
17             _croak "Equ type constraints cannot have a parent constraint passed to the constructor"
18 10 50       29 if exists $opts{parent};
19              
20             _croak "Equ type constraints cannot have a constraint coderef passed to the constructor"
21 10 50       24 if exists $opts{constraint};
22              
23             _croak "Equ type constraints cannot have a inlining coderef passed to the constructor"
24 10 50       23 if exists $opts{inlined};
25              
26 10 50       24 _croak "Need to supply value" unless exists $opts{value};
27              
28             # stringify
29 10 100       31 $opts{value} = defined $opts{value} ? "$opts{value}" : undef;
30              
31 10         46 return $class->SUPER::new( %opts );
32             }
33              
34 41     41 1 7404 sub value { $_[0]{value} }
35              
36             sub _build_display_name {
37 10     10   96 my $self = shift;
38 10 100       17 defined $self->value
39             ? sprintf( "Equ['%s']", $self->value )
40             : "Equ[Undef]";
41             }
42              
43             sub has_parent {
44 0     0 1 0 !!0;
45             }
46              
47 10   33 10 1 1339 sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint }
48              
49             sub _build_constraint {
50 10     10   18 my $self = shift;
51              
52 10 100       19 if (defined $self->value) {
53             return sub {
54 0 0   0   0 defined $_ && $_ eq $self->value;
55 5         36 };
56             }
57             else {
58             return sub {
59 0     0   0 !defined $_;
60 5         38 };
61             }
62             }
63              
64             sub can_be_inlined {
65 14     14 1 884 !!1;
66             }
67              
68             sub inline_check {
69 14     14 1 55 my $self = shift;
70              
71 14         23 my $value = $self->value;
72 14         20 my $code;
73 14 100       28 if (defined $value) {
74 8         26 $code = "(defined($_[0]) && $_[0] eq '$value')";
75             }
76             else {
77 6         18 $code = "!defined($_[0])";
78             }
79              
80 14 50       32 return "do { $Type::Tiny::SafePackage $code }"
81             if $Type::Tiny::AvoidCallbacks; ## no critic (Variables::ProhibitPackageVars)
82 14         86 return $code;
83             }
84              
85             1;
86             __END__