File Coverage

blib/lib/Test/Stream/Compare/Value.pm
Criterion Covered Total %
statement 44 44 100.0
branch 20 20 100.0
condition 9 10 90.0
subroutine 10 10 100.0
pod 3 4 75.0
total 86 88 97.7


line stmt bran cond sub pod time code
1             package Test::Stream::Compare::Value;
2 100     100   1018 use strict;
  100         197  
  100         2654  
3 100     100   514 use warnings;
  100         186  
  100         2764  
4              
5 100     100   507 use Scalar::Util qw/looks_like_number/;
  100         178  
  100         4687  
6              
7 100     100   570 use Carp qw/carp/;
  100         188  
  100         3982  
8              
9 100     100   516 use Test::Stream::Compare;
  100         197  
  100         647  
10             use Test::Stream::HashBase(
11 100         763 base => 'Test::Stream::Compare',
12             accessors => [qw/input/],
13 100     100   547 );
  100         201  
14              
15             sub init {
16 5     5 0 9 my $self = shift;
17 5         599 carp "Test::Stream::Compare::Value is considered deprecated and dangerous";
18 5         23 $self->SUPER::init(@_);
19             }
20              
21             sub name {
22 5     5 1 13 my $self = shift;
23 5         10 my $in = $self->{+INPUT};
24 5 100       15 return '' unless defined $in;
25 4         16 return "$in";
26             }
27              
28             sub operator {
29 35     35 1 50 my $self = shift;
30              
31 35 100       92 return '' unless @_;
32              
33 30         47 my ($got) = @_;
34 30         39 my $input = $self->{+INPUT};
35              
36 30 100 100     155 return '' if defined($input) xor defined($got);
37 24 100 66     104 return '==' unless defined($input) && defined($got);
38 23 100 100     128 return '==' if looks_like_number($got) && looks_like_number($input);
39 14         42 return 'eq';
40             }
41              
42             sub verify {
43 32     32 1 49 my $self = shift;
44 32         82 my %params = @_;
45 32         56 my ($got, $exists) = @params{qw/got exists/};
46              
47 32 100       86 return 0 unless $exists;
48 27 100       77 return 0 if ref $got;
49              
50 22         29 my $input = $self->{+INPUT};
51 22 100       57 return !defined($got) unless defined $input;
52 19 100       53 return 0 unless defined($got);
53              
54 15         31 my $op = $self->operator($got);
55              
56 15 100       71 return $input == $got if $op eq '==';
57 8         42 return $input eq $got;
58             }
59              
60             1;
61              
62             __END__