File Coverage

blib/lib/Test/Stream/Compare/Ref.pm
Criterion Covered Total %
statement 38 38 100.0
branch 12 12 100.0
condition n/a
subroutine 11 11 100.0
pod 3 4 75.0
total 64 65 98.4


line stmt bran cond sub pod time code
1             package Test::Stream::Compare::Ref;
2 100     100   1100 use strict;
  100         195  
  100         2643  
3 100     100   512 use warnings;
  100         198  
  100         2607  
4              
5 100     100   530 use Test::Stream::Compare;
  100         198  
  100         681  
6             use Test::Stream::HashBase(
7 100         762 base => 'Test::Stream::Compare',
8             accessors => [qw/input/],
9 100     100   542 );
  100         191  
10              
11 100     100   610 use Test::Stream::Util qw/render_ref rtype/;
  100         208  
  100         735  
12 100     100   549 use Scalar::Util qw/reftype refaddr/;
  100         213  
  100         5406  
13 100     100   509 use Carp qw/croak/;
  100         194  
  100         28919  
14              
15             sub init {
16 161     161 0 254 my $self = shift;
17              
18             croak "'input' is a required attribute"
19 161 100       672 unless $self->{+INPUT};
20              
21             croak "'input' must be a reference, got '" . $self->{+INPUT} . "'"
22 160 100       542 unless ref $self->{+INPUT};
23              
24 159         537 $self->SUPER::init();
25             }
26              
27 4     4 1 20 sub operator { '==' }
28              
29 4     4 1 23 sub name { render_ref($_[0]->{+INPUT}) };
30              
31             sub verify {
32 164     164 1 265 my $self = shift;
33 164         530 my %params = @_;
34 164         344 my ($got, $exists) = @params{qw/got exists/};
35              
36 164 100       399 return 0 unless $exists;
37              
38 163         275 my $in = $self->{+INPUT};
39 163 100       418 return 0 unless ref $in;
40 162 100       389 return 0 unless ref $got;
41              
42 160         432 my $in_type = rtype($in);
43 160         454 my $got_type = rtype($got);
44              
45 160 100       417 return 0 unless $in_type eq $got_type;
46              
47             # Don't let overloading mess with us.
48 159         821 return refaddr($in) == refaddr($got);
49             }
50              
51             1;
52              
53             __END__