fork download
copy 
  1. #!/usr/bin/perl
  2. # Idiom #271 Test for type extension
  3. # https://p...content-available-to-author-only...s.org/idiom/271
  4.  
  5. use v5.10;
  6.  
  7. package Other { sub new { bless {}, $_[0] } }
  8.  
  9. package Foo { sub new { bless {}, $_[0] } }
  10.  
  11. package FooExt {
  12.     @isa = ('Foo');
  13.     sub new { bless {}, $_[0] }
  14. }
  15.  
  16. my $f = Foo->new;
  17. tst($f);
  18.  
  19. my $e = FooExt->new;
  20. tst($e);
  21.  
  22. my $o = Other->new;
  23. tst($o);
  24.  
  25. sub tst {
  26.     my ($x) = @_;
  27.  
  28.     if ( $x->isa('Foo') ) {
  29.         say "Same type";
  30.     }
  31.     elsif ( $x->isa('FooExt') ) {
  32.         my $issubclass = grep { $_ eq 'Foo' } @FooExt::isa;
  33.         say $issubclass ? "Extends type" : "Same type";
  34.     }
  35.     else {
  36.         say "Not related"
  37.     }
  38. }
Success #stdin #stdout 0.01s 5444KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Same type
Extends type
Not related
https://ideone.com/kRcwLW
Idiom #271 Test for type extension
language:
Perl (perl 5.28.1)
created:
1 year ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!