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 169     169   1223 use strict;
  169         333  
  169         5101  
3 169     169   941 use warnings;
  169         364  
  169         4385  
4              
5 169     169   948 use base 'Test2::Compare::Base';
  169         378  
  169         19776  
6              
7             our $VERSION = '0.000156';
8              
9 169     169   1242 use Test2::Util::HashBase qw/input/;
  169         518  
  169         1268  
10              
11 169     169   23231 use Test2::Util::Ref qw/render_ref rtype/;
  169         386  
  169         9201  
12 169     169   1056 use Scalar::Util qw/refaddr/;
  169         411  
  169         8028  
13 169     169   1046 use Carp qw/croak/;
  169         412  
  169         49253  
14              
15             sub init {
16 65     65 0 993 my $self = shift;
17              
18             croak "'input' is a required attribute"
19 65 100       401 unless $self->{+INPUT};
20              
21             croak "'input' must be a reference, got '" . $self->{+INPUT} . "'"
22 64 100       270 unless ref $self->{+INPUT};
23              
24 63         242 $self->SUPER::init();
25             }
26              
27 4     4 1 23 sub operator { '==' }
28              
29 4     4 1 49 sub name { render_ref($_[0]->{+INPUT}) }
30              
31             sub verify {
32 68     68 1 129 my $self = shift;
33 68         220 my %params = @_;
34 68         201 my ($got, $exists) = @params{qw/got exists/};
35              
36 68 100       154 return 0 unless $exists;
37              
38 67         125 my $in = $self->{+INPUT};
39 67 100       181 return 0 unless ref $in;
40 66 100       156 return 0 unless ref $got;
41              
42 64         152 my $in_type = rtype($in);
43 64         166 my $got_type = rtype($got);
44              
45 64 100       250 return 0 unless $in_type eq $got_type;
46              
47             # Don't let overloading mess with us.
48 63         299 return refaddr($in) == refaddr($got);
49             }
50              
51             1;
52              
53             __END__