#!/usr/bin/perl
# Idiom #271 Test for type extension
# https://p...content-available-to-author-only...s.org/idiom/271

use v5.10;

package Other { sub new { bless {}, $_[0] } }

package Foo { sub new { bless {}, $_[0] } }

package FooExt {
    @isa = ('Foo');
    sub new { bless {}, $_[0] }
}

my $f = Foo->new;
tst($f);

my $e = FooExt->new;
tst($e);

my $o = Other->new;
tst($o);

sub tst {
    my ($x) = @_;

    if ( $x->isa('Foo') ) {
        say "Same type";
    }
    elsif ( $x->isa('FooExt') ) {
        my $issubclass = grep { $_ eq 'Foo' } @FooExt::isa;
        say $issubclass ? "Extends type" : "Same type";
    }
    else {
        say "Not related"
    }
}