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   1100 use strict;
  169         340  
  169         4877  
3 169     169   877 use warnings;
  169         333  
  169         4244  
4              
5 169     169   803 use base 'Test2::Compare::Base';
  169         687  
  169         17885  
6              
7             our $VERSION = '0.000155';
8              
9 169     169   1148 use Test2::Util::HashBase qw/input/;
  169         377  
  169         1046  
10              
11 169     169   21453 use Test2::Util::Ref qw/render_ref rtype/;
  169         352  
  169         8811  
12 169     169   1034 use Scalar::Util qw/refaddr/;
  169         412  
  169         8951  
13 169     169   1164 use Carp qw/croak/;
  169         329  
  169         46899  
14              
15             sub init {
16 65     65 0 1012 my $self = shift;
17              
18             croak "'input' is a required attribute"
19 65 100       434 unless $self->{+INPUT};
20              
21             croak "'input' must be a reference, got '" . $self->{+INPUT} . "'"
22 64 100       277 unless ref $self->{+INPUT};
23              
24 63         210 $self->SUPER::init();
25             }
26              
27 4     4 1 23 sub operator { '==' }
28              
29 4     4 1 41 sub name { render_ref($_[0]->{+INPUT}) }
30              
31             sub verify {
32 68     68 1 135 my $self = shift;
33 68         209 my %params = @_;
34 68         198 my ($got, $exists) = @params{qw/got exists/};
35              
36 68 100       177 return 0 unless $exists;
37              
38 67         140 my $in = $self->{+INPUT};
39 67 100       165 return 0 unless ref $in;
40 66 100       156 return 0 unless ref $got;
41              
42 64         161 my $in_type = rtype($in);
43 64         180 my $got_type = rtype($got);
44              
45 64 100       266 return 0 unless $in_type eq $got_type;
46              
47             # Don't let overloading mess with us.
48 63         301 return refaddr($in) == refaddr($got);
49             }
50              
51             1;
52              
53             __END__