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   1054 use strict;
  100         188  
  100         2606  
3 100     100   515 use warnings;
  100         204  
  100         2482  
4              
5 100     100   587 use Test::Stream::Compare;
  100         198  
  100         682  
6             use Test::Stream::HashBase(
7 100         760 base => 'Test::Stream::Compare',
8             accessors => [qw/input/],
9 100     100   552 );
  100         197  
10              
11 100     100   632 use Test::Stream::Util qw/render_ref rtype/;
  100         197  
  100         691  
12 100     100   532 use Scalar::Util qw/reftype refaddr/;
  100         214  
  100         5460  
13 100     100   516 use Carp qw/croak/;
  100         197  
  100         28279  
14              
15             sub init {
16 161     161 0 243 my $self = shift;
17              
18             croak "'input' is a required attribute"
19 161 100       674 unless $self->{+INPUT};
20              
21             croak "'input' must be a reference, got '" . $self->{+INPUT} . "'"
22 160 100       540 unless ref $self->{+INPUT};
23              
24 159         521 $self->SUPER::init();
25             }
26              
27 4     4 1 17 sub operator { '==' }
28              
29 4     4 1 26 sub name { render_ref($_[0]->{+INPUT}) };
30              
31             sub verify {
32 164     164 1 261 my $self = shift;
33 164         538 my %params = @_;
34 164         371 my ($got, $exists) = @params{qw/got exists/};
35              
36 164 100       376 return 0 unless $exists;
37              
38 163         245 my $in = $self->{+INPUT};
39 163 100       437 return 0 unless ref $in;
40 162 100       371 return 0 unless ref $got;
41              
42 160         439 my $in_type = rtype($in);
43 160         428 my $got_type = rtype($got);
44              
45 160 100       432 return 0 unless $in_type eq $got_type;
46              
47             # Don't let overloading mess with us.
48 159         820 return refaddr($in) == refaddr($got);
49             }
50              
51             1;
52              
53             __END__