File Coverage

lib/Test/Easy/DeepEqual.pm

Criterion	Covered	Total	%
statement	30	92	32.6
branch	0	38	0.0
condition	0	18	0.0
subroutine	10	22	45.4
pod	0	2	0.0
total	40	172	23.2

use strict;
use warnings;
package Test::Easy::DeepEqual;
use base qw(Exporter);

use Carp ();
use Data::Denter ();
use Data::Denter ();
use Data::Difflet;
use Scalar::Util ();
use Test::Easy::equivalence;
use Test::More ();

our @EXPORT = qw(deep_ok deep_equal);

sub deep_ok ($$;$) {
  my ($got, $exp, $message) = @_;

  local $Test::Builder::Level = $Test::Builder::Level + 1;
  Test::More::ok( deep_equal($got, $exp), $message ) || do {
    my $dump_got = Data::Denter::Denter($got);
    my $dump_exp = Data::Denter::Denter($exp);

    Test::More::diag '$GOT';
    Test::More::diag $dump_got;
    Test::More::diag '$EXPECTED';
    Test::More::diag $dump_exp;
    Test::More::diag '$DIFFLET';
    Test::More::diag(Data::Difflet->new->compare($got, $exp));
  };
}

sub deep_equal {
  Carp::confess "must have only two things to deep_equal" if @_ != 2;

  return 1 if _undefs(@_);
  return 0 unless _same_type(@_);
  return 1 if _hashrefs(@_) && _same_hashrefs(@_);
  return 1 if _arrayrefs(@_) && _same_arrayrefs(@_);
  return 1 if _same_values(@_); # note, not 'if _scalars(@_) && _same_values(@_)'
  return 1 if _regex_match(@_);
  return 0;
}

sub _undefs    { return 2 == grep { ! defined } @_ }
sub _hashrefs  { return 2 == grep { ref($_) eq 'HASH' } @_ }
sub _arrayrefs { return 2 == grep { ref($_) eq 'ARRAY' } @_ }

# check the refs of $got and $exp; they must match, or $got must be a simple scalar and $exp must be a checker object.
sub _same_type {
  my ($got, $exp) = @_;

  return 1 if _undefs(@_);
  return 1 if ref($got) eq ref($exp);
  return 1 if ! ref($got) && _is_a_checker($exp);
  if (! ref($got) && ref($exp) eq 'Regexp') {
$DB::single = 1;1;
    return 1;
  }
  Carp::cluck "a ${\ref($got)} is not a ${\ref($exp)}!\n";
  return 0;
}

sub _same_hashrefs {
  my ($got, $exp) = @_;

  # if their keys aren't the same there's no point checking further
  # ...but really we should run the checker objects as mutators on $exp
  # so the real failure is apparent
  return 0 unless scalar keys %$got == scalar keys %$exp;

  # not 'each': it would reset the hash's iterator on a potentially weird caller
  foreach my $k (keys %$exp) {
    return 0 unless exists $got->{$k};
    return 0 unless deep_equal($got->{$k}, $exp->{$k});
  }

  # make sure there's nothing extra in $got that we didn't $exp'ect to see.
  return 0 == grep { ! exists $exp->{$_} } keys %$got;
}

sub _same_arrayrefs {
  my ($got, $exp) = @_;

  return 0 unless $#$got == $#$exp;

  for (my $i = 0; $i < @$exp; $i++) {
    return 0 unless deep_equal($got->[$i], $exp->[$i]);
  }

  return 1;
}

sub _is_a_checker {
  my ($exp) = @_;
  my $ref = ref($exp);
  return $ref && Scalar::Util::blessed($exp) && UNIVERSAL::can($exp, 'check_value');
}

sub _same_values {
  my ($got, $exp) = @_;
  my ($ref_got, $ref_exp) = map { ref } $got, $exp;
  my $checker = _is_a_checker($exp)
    ? $exp
    : Test::Easy::equivalence->new(
      test => sub {
        my ($got) = @_;
        return "$got" eq "$exp";
      },
    );
  return $checker->check_value($got);
}

sub _regex_match {
  my ($got, $exp) = @_;
  return 0 if ref($got) || ref($exp) ne 'Regexp';
  return $got =~ $exp;
}

1;