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   1050 use strict;
  100         188  
  100         2746  
3 100     100   552 use warnings;
  100         201  
  100         2798  
4              
5 100     100   506 use Carp qw/confess/;
  100         197  
  100         4400  
6              
7 100     100   542 use Test::Stream::Compare;
  100         185  
  100         656  
8             use Test::Stream::HashBase(
9 100         769 base => 'Test::Stream::Compare',
10             accessors => [qw/input negate/],
11 100     100   515 );
  100         194  
12              
13             sub init {
14 7     7 0 13 my $self = shift;
15 7         23 my $input = $self->{+INPUT};
16              
17 7 100       212 confess "input must be defined for 'Number' check"
18             unless defined $input;
19              
20             # Check for ''
21 6 100 100     267 confess "input must be a number for 'Number' check"
22             unless length($input) && $input =~ m/\S/;
23              
24 4         24 $self->SUPER::init(@_);
25             }
26              
27             sub name {
28 7     7 1 18 my $self = shift;
29 7         15 my $in = $self->{+INPUT};
30 7         25 return $in;
31             }
32              
33             sub operator {
34 11     11 1 24 my $self = shift;
35 11 100       42 return '' unless @_;
36 9         11 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       25 return '!=' if $self->{+NEGATE};
42 4         17 return '==';
43             }
44              
45             sub verify {
46 25     25 1 41 my $self = shift;
47 25         70 my %params = @_;
48 25         53 my ($got, $exists) = @params{qw/got exists/};
49              
50 25 100       67 return 0 unless $exists;
51 23 100       59 return 0 unless defined $got;
52 21 100       52 return 0 if ref $got;
53 19 100 100     123 return 0 unless length($got) && $got =~ m/\S/;
54              
55 17         34 my $input = $self->{+INPUT};
56 17         23 my $negate = $self->{+NEGATE};
57              
58 17         21 my @warnings;
59             my $out;
60             {
61 17     4   24 local $SIG{__WARN__} = sub { push @warnings => @_ };
  17         99  
  4         32  
62 17 100       137 $out = $negate ? ($input != $got) : ($input == $got);
63             }
64              
65 17         35 for my $warn (@warnings) {
66 4 50       22 if ($warn =~ m/numeric/) {
67 4         6 $out = 0;
68 4         12 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__