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   1133 use strict;
  100         197  
  100         2646  
3 100     100   517 use warnings;
  100         189  
  100         2699  
4              
5 100     100   519 use Scalar::Util qw/looks_like_number/;
  100         188  
  100         4801  
6              
7 100     100   490 use Carp qw/carp/;
  100         202  
  100         4072  
8              
9 100     100   516 use Test::Stream::Compare;
  100         236  
  100         648  
10             use Test::Stream::HashBase(
11 100         1032 base => 'Test::Stream::Compare',
12             accessors => [qw/input/],
13 100     100   540 );
  100         201  
14              
15             sub init {
16 5     5 0 7 my $self = shift;
17 5         637 carp "Test::Stream::Compare::Value is considered deprecated and dangerous";
18 5         27 $self->SUPER::init(@_);
19             }
20              
21             sub name {
22 5     5 1 27 my $self = shift;
23 5         9 my $in = $self->{+INPUT};
24 5 100       17 return '' unless defined $in;
25 4         17 return "$in";
26             }
27              
28             sub operator {
29 35     35 1 58 my $self = shift;
30              
31 35 100       90 return '' unless @_;
32              
33 30         40 my ($got) = @_;
34 30         43 my $input = $self->{+INPUT};
35              
36 30 100 100     152 return '' if defined($input) xor defined($got);
37 24 100 66     103 return '==' unless defined($input) && defined($got);
38 23 100 100     119 return '==' if looks_like_number($got) && looks_like_number($input);
39 14         44 return 'eq';
40             }
41              
42             sub verify {
43 32     32 1 51 my $self = shift;
44 32         83 my %params = @_;
45 32         61 my ($got, $exists) = @params{qw/got exists/};
46              
47 32 100       83 return 0 unless $exists;
48 27 100       73 return 0 if ref $got;
49              
50 22         34 my $input = $self->{+INPUT};
51 22 100       55 return !defined($got) unless defined $input;
52 19 100       53 return 0 unless defined($got);
53              
54 15         32 my $op = $self->operator($got);
55              
56 15 100       69 return $input == $got if $op eq '==';
57 8         40 return $input eq $got;
58             }
59              
60             1;
61              
62             __END__