t/305_RT_41255.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use Test::More tests => 20;
   5 use Test::Exception;
   6
   7 use Class::MOP;
   8
   9 {
  10     package Base;
  11     sub m1 { 1 }
  12     sub m2 { 2 }
  13     sub m3 { 3 }
  14     sub m4 { 4 }
  15     sub m5 { 5 }
  16
  17     package Derived;
  18     use parent -norequire => qw(Base);
  19
  20     sub m1;
  21     sub m2 ();
  22     sub m3 :method;
  23     sub m4; m4() if 0;
  24     sub m5; our $m5;;
  25 }
  26
  27 my $meta = Class::MOP::Class->initialize('Derived');
  28 my %methods = map { $_ => $meta->find_method_by_name($_) } 'm1' .. 'm5';
  29
  30 while (my ($name, $meta_method) = each %methods) {
  31     is $meta_method->fully_qualified_name, "Derived::${name}";
  32     throws_ok { $meta_method->execute } qr/Undefined subroutine .* called at/;
  33 }
  34
  35 {
  36     package Derived;
  37     eval <<'EOC';
  38
  39     sub m1         { 'affe'  }
  40     sub m2 ()      { 'apan'  }
  41     sub m3 :method { 'tiger' }
  42     sub m4         { 'birne' }
  43     sub m5         { 'apfel' }
  44
  45 EOC
  46 }
  47
  48 while (my ($name, $meta_method) = each %methods) {
  49     is $meta_method->fully_qualified_name, "Derived::${name}";
  50     lives_ok { $meta_method->execute };
  51 }