File Coverage

blib/lib/Type/Tiny/Equ.pm
Criterion Covered Total %
statement 34 40 85.0
branch 14 22 63.6
condition 1 3 33.3
subroutine 10 14 71.4
pod 6 6 100.0
total 65 85 76.4


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