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