package Dog;

use Tie::Constrained;
use Scalar::Util qw/blessed/;

# constraint object
my $is_a_dog = Tie::Constrained->new(
    sub { blessed $_[0] and $_[0]->isa('Dog') },
);

sub new {
	bless {}, shift;
}

# not a constructor this time, ties the referent
sub MODIFY_SCALAR_ATTRIBUTES {
    my $class = shift;
	my $ref   = shift;

	tie $$ref, 'Tie::Constrained', $is_a_dog;

	# ignore attributes for this example, but
	# must have one to get called
	();
}

sub bark {
    my $self = shift;
    print "Woof!\n";
}

package Cat;

sub new {
    bless {}, shift;
}

package main;

my Dog $spot : Generic ;

eval {$spot->bark}
    or warn q(Only tangible Dogs bark, ), $@;
eval {$spot = Cat->new}
    or warn q(Can't be a Cat, ), $@;
eval {$spot = Dog->new}
    or warn q(Major malfunction: ), $@;
eval {$spot->bark}
    or warn q(Only tangible Dogs bark, ), $@;