1package Test2::Compare::Ref; 2use strict; 3use warnings; 4 5use base 'Test2::Compare::Base'; 6 7our $VERSION = '0.000162'; 8 9use Test2::Util::HashBase qw/input/; 10 11use Test2::Util::Ref qw/render_ref rtype/; 12use Scalar::Util qw/refaddr/; 13use Carp qw/croak/; 14 15sub init { 16 my $self = shift; 17 18 croak "'input' is a required attribute" 19 unless $self->{+INPUT}; 20 21 croak "'input' must be a reference, got '" . $self->{+INPUT} . "'" 22 unless ref $self->{+INPUT}; 23 24 $self->SUPER::init(); 25} 26 27sub operator { '==' } 28 29sub name { render_ref($_[0]->{+INPUT}) } 30 31sub verify { 32 my $self = shift; 33 my %params = @_; 34 my ($got, $exists) = @params{qw/got exists/}; 35 36 return 0 unless $exists; 37 38 my $in = $self->{+INPUT}; 39 return 0 unless ref $in; 40 return 0 unless ref $got; 41 42 my $in_type = rtype($in); 43 my $got_type = rtype($got); 44 45 return 0 unless $in_type eq $got_type; 46 47 # Don't let overloading mess with us. 48 return refaddr($in) == refaddr($got); 49} 50 511; 52 53__END__ 54 55=pod 56 57=encoding UTF-8 58 59=head1 NAME 60 61Test2::Compare::Ref - Ref comparison 62 63=head1 DESCRIPTION 64 65Used to compare two refs in a deep comparison. 66 67=head1 SYNOPSIS 68 69 my $ref = {}; 70 my $check = Test2::Compare::Ref->new(input => $ref); 71 72 # Passes 73 is( [$ref], [$check], "The array contains the exact ref we want" ); 74 75 # Fails, they both may be empty hashes, but we are looking for a specific 76 # reference. 77 is( [{}], [$check], "This will fail"); 78 79=head1 SOURCE 80 81The source code repository for Test2-Suite can be found at 82F<https://github.com/Test-More/Test2-Suite/>. 83 84=head1 MAINTAINERS 85 86=over 4 87 88=item Chad Granum E<lt>exodist@cpan.orgE<gt> 89 90=back 91 92=head1 AUTHORS 93 94=over 4 95 96=item Chad Granum E<lt>exodist@cpan.orgE<gt> 97 98=back 99 100=head1 COPYRIGHT 101 102Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. 103 104This program is free software; you can redistribute it and/or 105modify it under the same terms as Perl itself. 106 107See F<http://dev.perl.org/licenses/> 108 109=cut 110