File Coverage

blib/lib/Type/Tiny/NumEq.pm
Criterion Covered Total %
statement 39 42 92.8
branch 10 18 55.5
condition 1 3 33.3
subroutine 12 14 85.7
pod 6 6 100.0
total 68 83 81.9


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