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   657 use strict;
  100         118  
  100         2272  
3 100     100   301 use warnings;
  100         117  
  100         1943  
4              
5 100     100   291 use base 'Test::Stream::Compare';
  100         138  
  100         5842  
6 100     100   368 use Test::Stream::HashBase accessors => [qw/input/];
  100         121  
  100         568  
7              
8 100     100   454 use Test::Stream::Util qw/render_ref rtype/;
  100         121  
  100         526  
9 100     100   381 use Scalar::Util qw/reftype refaddr/;
  100         118  
  100         4114  
10 100     100   341 use Carp qw/croak/;
  100         114  
  100         19441  
11              
12             sub init {
13 165     165 0 166 my $self = shift;
14              
15             croak "'input' is a required attribute"
16 165 100       467 unless $self->{+INPUT};
17              
18             croak "'input' must be a reference, got '" . $self->{+INPUT} . "'"
19 164 100       383 unless ref $self->{+INPUT};
20              
21 163         357 $self->SUPER::init();
22             }
23              
24 4     4 1 10 sub operator { '==' }
25              
26 4     4 1 13 sub name { render_ref($_[0]->{+INPUT}) };
27              
28             sub verify {
29 168     168 1 155 my $self = shift;
30 168         298 my %params = @_;
31 168         217 my ($got, $exists) = @params{qw/got exists/};
32              
33 168 100       263 return 0 unless $exists;
34              
35 167         166 my $in = $self->{+INPUT};
36 167 100       295 return 0 unless ref $in;
37 166 100       300 return 0 unless ref $got;
38              
39 164         313 my $in_type = rtype($in);
40 164         268 my $got_type = rtype($got);
41              
42 164 100       278 return 0 unless $in_type eq $got_type;
43              
44             # Don't let overloading mess with us.
45 163         667 return refaddr($in) == refaddr($got);
46             }
47              
48             1;
49              
50             __END__