t/305_RT_41255.t

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