1use strict;
2use warnings;
3
4package Test::Deep::Set;
5
6use Test::Deep::Cmp;
7
8sub init
9{
10	my $self = shift;
11
12	$self->{IgnoreDupes} = shift;
13	$self->{SubSup} = shift;
14
15	$self->{val} = [];
16
17	$self->add(@_);
18}
19
20sub descend
21{
22	my $self = shift;
23	my $d1 = shift;
24
25	my $d2 = $self->{val};
26
27	my $IgnoreDupes = $self->{IgnoreDupes};
28
29	my $data = $self->data;
30
31	my $SubSup = $self->{SubSup};
32
33	my $type = $IgnoreDupes ? "Set" : "Bag";
34
35	my $diag;
36
37	if (ref $d1 ne 'ARRAY')
38	{
39		my $got = Test::Deep::render_val($d1);
40		$diag = <<EOM;
41got    : $got
42expect : An array to use as a $type
43EOM
44	}
45
46	if (not $diag)
47	{
48		my @got = @$d1;
49		my @missing;
50		foreach my $expect (@$d2)
51		{
52			my $found = 0;
53
54			for (my $i = $#got; $i >= 0; $i--)
55			{
56				if (Test::Deep::eq_deeply_cache($got[$i], $expect))
57				{
58					$found = 1;
59					splice(@got, $i, 1);
60
61					last unless $IgnoreDupes;
62				}
63			}
64
65			push(@missing, $expect) unless $found;
66		}
67
68
69		my @diags;
70		if (@missing and $SubSup ne "sub")
71		{
72			push(@diags, "Missing: ".nice_list(\@missing));
73		}
74
75		if (@got and $SubSup ne "sup")
76		{
77			my $got = __PACKAGE__->new($IgnoreDupes, "", @got);
78			push(@diags, "Extra: ".nice_list($got->{val}));
79		}
80
81		$diag = join("\n", @diags);
82	}
83
84	if ($diag)
85	{
86		$data->{diag} = $diag;
87
88		return 0;
89	}
90	else
91	{
92		return 1;
93	}
94}
95
96sub diagnostics
97{
98	my $self = shift;
99	my ($where, $last) = @_;
100
101	my $type = $self->{IgnoreDupes} ? "Set" : "Bag";
102	$type = "Sub$type" if $self->{SubSup} eq "sub";
103	$type = "Super$type" if $self->{SubSup} eq "sup";
104
105	my $error = $last->{diag};
106	my $diag = <<EOM;
107Comparing $where as a $type
108$error
109EOM
110
111	return $diag;
112}
113
114sub add
115{
116	# this takes an array.
117
118	# For each element A of the array, it looks for an element, B, already in
119	# the set which are deeply equal to A. If no matching B is found then A is
120	# added to the set. If a B is found and IgnoreDupes is true, then A will
121	# be discarded, if IgnoreDupes is false, then B will be added to the set
122	# again.
123
124	my $self = shift;
125
126	my @array = @_;
127
128	my $IgnoreDupes = $self->{IgnoreDupes};
129
130	my $already = $self->{val};
131
132	local $Test::Deep::Expects = 1;
133	foreach my $new_elem (@array)
134	{
135		my $want_push = 1;
136		my $push_this = $new_elem;
137		foreach my $old_elem (@$already)
138		{
139			if (Test::Deep::eq_deeply($new_elem, $old_elem))
140			{
141				$push_this = $old_elem;
142				$want_push = ! $IgnoreDupes;
143				last;
144			}
145		}
146		push(@$already, $push_this) if $want_push;
147	}
148
149	# so we can compare 2 Test::Deep::Set objects using array comparison
150
151	@$already = sort {(defined $a ? $a : "") cmp (defined $b ? $b : "")} @$already;
152}
153
154sub nice_list
155{
156	my $list = shift;
157
158	my @scalars = grep ! ref $_, @$list;
159	my $refs = grep ref $_, @$list;
160
161	my @ref_string = "$refs reference" if $refs;
162	$ref_string[0] .= "s" if $refs > 1;
163
164	# sort them so we can predict the diagnostic output
165
166	return join(", ",
167		(map {Test::Deep::render_val($_)} sort {(defined $a ? $a : "") cmp (defined $b ? $b : "")} @scalars),
168		@ref_string
169	);
170}
171
172sub compare
173{
174	my $self = shift;
175
176	my $other = shift;
177
178	return 0 if $self->{IgnoreDupes} != $other->{IgnoreDupes};
179
180	# this works (kind of) because the the arrays are sorted
181
182	return Test::Deep::descend($self->{val}, $other->{val});
183}
184
1851;
186