1# Bug report that initiated this debugging:
2# https://rt.cpan.org/Ticket/Display.html?id=81519
3
4use strict;
5use warnings;
6
7use Test::More tests => 1;
8
9use Data::Visitor::Callback;
10
11BEGIN {
12    package W3C::XHTML::Image;
13    use Moose;
14
15    package W3C::XHTML::Body;
16    use Moose;
17    has 'images' => (
18        is     => 'ro',
19        isa    => 'ArrayRef[W3C::XHTML::Image]',
20    );
21}
22
23my $body = W3C::XHTML::Body->new( images => [ W3C::XHTML::Image->new ] );
24my $tc = $body->meta->get_attribute('images')->type_constraint;
25
26note "TC contains only one instance of W3C::XHTML::Image - $tc";
27
28# Figure out classes mentioned in type constraint (isa)
29my @classes;
30Data::Visitor::Callback->new({
31    object => 'visit_ref',
32    'Moose::Meta::TypeConstraint::Union'         => sub { return $_[1]->type_constraints; },
33    'Moose::Meta::TypeConstraint::Class'         => sub { push @classes, $_[1]->class; return $_[1]; },
34    'Moose::Meta::TypeConstraint::Parameterized' => sub { return $_[1]->type_parameter; },
35})->visit($tc);
36
37note "Classes found: " . join(", ", @classes);
38
39# On 5.16.2 it gives me only one item if mentioned once in TC,
40# but on 5.17.6 it occasionally gives two items in @classes
41is( scalar @classes, 1, "Only one case of W3C::XHTML::Image should be present");
42