File Coverage

blib/lib/Test/Stream/Compare/Number.pm
Criterion Covered Total %
statement 49 50 98.0
branch 22 24 91.6
condition 7 9 77.7
subroutine 10 10 100.0
pod 3 4 75.0
total 91 97 93.8


line stmt bran cond sub pod time code
1             package Test::Stream::Compare::Number;
2 100     100   1296 use strict;
  100         186  
  100         2866  
3 100     100   542 use warnings;
  100         193  
  100         2939  
4              
5 100     100   515 use Carp qw/confess/;
  100         195  
  100         4440  
6              
7 100     100   560 use Test::Stream::Compare;
  100         192  
  100         653  
8             use Test::Stream::HashBase(
9 100         767 base => 'Test::Stream::Compare',
10             accessors => [qw/input negate/],
11 100     100   528 );
  100         199  
12              
13             sub init {
14 7     7 0 14 my $self = shift;
15 7         24 my $input = $self->{+INPUT};
16              
17 7 100       208 confess "input must be defined for 'Number' check"
18             unless defined $input;
19              
20             # Check for ''
21 6 100 100     270 confess "input must be a number for 'Number' check"
22             unless length($input) && $input =~ m/\S/;
23              
24 4         25 $self->SUPER::init(@_);
25             }
26              
27             sub name {
28 7     7 1 16 my $self = shift;
29 7         13 my $in = $self->{+INPUT};
30 7         25 return $in;
31             }
32              
33             sub operator {
34 11     11 1 26 my $self = shift;
35 11 100       36 return '' unless @_;
36 9         15 my ($got) = @_;
37              
38 9 100       29 return '' unless defined($got);
39 7 50 33     57 return '' unless length($got) && $got =~ m/\S/;
40              
41 7 100       27 return '!=' if $self->{+NEGATE};
42 4         17 return '==';
43             }
44              
45             sub verify {
46 25     25 1 45 my $self = shift;
47 25         71 my %params = @_;
48 25         51 my ($got, $exists) = @params{qw/got exists/};
49              
50 25 100       64 return 0 unless $exists;
51 23 100       54 return 0 unless defined $got;
52 21 100       53 return 0 if ref $got;
53 19 100 100     124 return 0 unless length($got) && $got =~ m/\S/;
54              
55 17         56 my $input = $self->{+INPUT};
56 17         28 my $negate = $self->{+NEGATE};
57              
58 17         22 my @warnings;
59             my $out;
60             {
61 17     4   22 local $SIG{__WARN__} = sub { push @warnings => @_ };
  17         100  
  4         33  
62 17 100       139 $out = $negate ? ($input != $got) : ($input == $got);
63             }
64              
65 17         38 for my $warn (@warnings) {
66 4 50       22 if ($warn =~ m/numeric/) {
67 4         7 $out = 0;
68 4         9 next; # This warning won't help anyone.
69             }
70 0         0 warn $warn;
71             }
72              
73 17         88 return $out;
74             }
75              
76             1;
77              
78             __END__