use strict; use warnings; package Test::Deep::Set; use Test::Deep::Cmp; sub init { my $self = shift; $self->{IgnoreDupes} = shift; $self->{SubSup} = shift; $self->{val} = []; $self->add(@_); } sub descend { my $self = shift; my $d1 = shift; my $d2 = $self->{val}; my $IgnoreDupes = $self->{IgnoreDupes}; my $data = $self->data; my $SubSup = $self->{SubSup}; my $type = $IgnoreDupes ? "Set" : "Bag"; my $diag; if (ref $d1 ne 'ARRAY') { my $got = Test::Deep::render_val($d1); $diag = <= 0; $i--) { if (Test::Deep::eq_deeply_cache($got[$i], $expect)) { $found = 1; splice(@got, $i, 1); last unless $IgnoreDupes; } } push(@missing, $expect) unless $found; } my @diags; if (@missing and $SubSup ne "sub") { push(@diags, "Missing: ".nice_list(\@missing)); } if (@got and $SubSup ne "sup") { my $got = __PACKAGE__->new($IgnoreDupes, "", @got); push(@diags, "Extra: ".nice_list($got->{val})); } $diag = join("\n", @diags); } if ($diag) { $data->{diag} = $diag; return 0; } else { return 1; } } sub diagnostics { my $self = shift; my ($where, $last) = @_; my $type = $self->{IgnoreDupes} ? "Set" : "Bag"; $type = "Sub$type" if $self->{SubSup} eq "sub"; $type = "Super$type" if $self->{SubSup} eq "sup"; my $error = $last->{diag}; my $diag = <{IgnoreDupes}; my $already = $self->{val}; local $Test::Deep::Expects = 1; foreach my $new_elem (@array) { my $want_push = 1; my $push_this = $new_elem; foreach my $old_elem (@$already) { if (Test::Deep::eq_deeply($new_elem, $old_elem)) { $push_this = $old_elem; $want_push = ! $IgnoreDupes; last; } } push(@$already, $push_this) if $want_push; } # so we can compare 2 Test::Deep::Set objects using array comparison @$already = sort {(defined $a ? $a : "") cmp (defined $b ? $b : "")} @$already; } sub nice_list { my $list = shift; my @scalars = grep ! ref $_, @$list; my $refs = grep ref $_, @$list; my @ref_string = "$refs reference" if $refs; $ref_string[0] .= "s" if $refs > 1; # sort them so we can predict the diagnostic output return join(", ", (map {Test::Deep::render_val($_)} sort {(defined $a ? $a : "") cmp (defined $b ? $b : "")} @scalars), @ref_string ); } sub compare { my $self = shift; my $other = shift; return 0 if $self->{IgnoreDupes} != $other->{IgnoreDupes}; # this works (kind of) because the the arrays are sorted return Test::Deep::descend($self->{val}, $other->{val}); } 1;