File Coverage

blib/lib/Type/Tiny/NumEq.pm
Criterion Covered Total %
statement 41 44 93.1
branch 10 18 55.5
condition 1 3 33.3
subroutine 13 15 86.6
pod 6 6 100.0
total 71 86 82.5


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