File Coverage

blib/lib/Test2/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 Test2::Compare::Ref;
2 168     168   1127 use strict;
  168         340  
  168         4697  
3 168     168   828 use warnings;
  168         322  
  168         4143  
4              
5 168     168   799 use base 'Test2::Compare::Base';
  168         367  
  168         17018  
6              
7             our $VERSION = '0.000153';
8              
9 168     168   1104 use Test2::Util::HashBase qw/input/;
  168         336  
  168         1031  
10              
11 168     168   20565 use Test2::Util::Ref qw/render_ref rtype/;
  168         369  
  168         8563  
12 168     168   982 use Scalar::Util qw/refaddr/;
  168         367  
  168         7450  
13 168     168   987 use Carp qw/croak/;
  168         351  
  168         45044  
14              
15             sub init {
16 65     65 0 983 my $self = shift;
17              
18             croak "'input' is a required attribute"
19 65 100       385 unless $self->{+INPUT};
20              
21             croak "'input' must be a reference, got '" . $self->{+INPUT} . "'"
22 64 100       267 unless ref $self->{+INPUT};
23              
24 63         196 $self->SUPER::init();
25             }
26              
27 4     4 1 14 sub operator { '==' }
28              
29 4     4 1 30 sub name { render_ref($_[0]->{+INPUT}) }
30              
31             sub verify {
32 68     68 1 134 my $self = shift;
33 68         202 my %params = @_;
34 68         179 my ($got, $exists) = @params{qw/got exists/};
35              
36 68 100       154 return 0 unless $exists;
37              
38 67         135 my $in = $self->{+INPUT};
39 67 100       177 return 0 unless ref $in;
40 66 100       171 return 0 unless ref $got;
41              
42 64         151 my $in_type = rtype($in);
43 64         170 my $got_type = rtype($got);
44              
45 64 100       171 return 0 unless $in_type eq $got_type;
46              
47             # Don't let overloading mess with us.
48 63         350 return refaddr($in) == refaddr($got);
49             }
50              
51             1;
52              
53             __END__