t/302_modify_parent_method.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 4;
   5 use Test::Exception;
   6
   7 use Class::MOP;
   8
   9 my @calls;
  10
  11 {
  12     package Parent;
  13
  14     use strict;
  15     use warnings;
  16     use metaclass;
  17
  18     use Carp 'confess';
  19
  20     sub method { push @calls, 'Parent::method' }
  21
  22         package Child;
  23
  24         use strict;
  25         use warnings;
  26     use metaclass;
  27
  28         use base 'Parent';
  29
  30         Child->meta->add_around_method_modifier('method' => sub {
  31         my $orig = shift;
  32         push @calls, 'before Child::method';
  33         $orig->(@_);
  34         push @calls, 'after Child::method';
  35         });
  36 }
  37
  38 Parent->method;
  39
  40 is_deeply([splice @calls], [
  41     'Parent::method',
  42 ]);
  43
  44 Child->method;
  45
  46 is_deeply([splice @calls], [
  47     'before Child::method',
  48     'Parent::method',
  49     'after Child::method',
  50 ]);
  51
  52 {
  53     package Parent;
  54
  55         Parent->meta->add_around_method_modifier('method' => sub {
  56         my $orig = shift;
  57         push @calls, 'before Parent::method';
  58         $orig->(@_);
  59         push @calls, 'after Parent::method';
  60         });
  61 }
  62
  63 Parent->method;
  64
  65 is_deeply([splice @calls], [
  66     'before Parent::method',
  67     'Parent::method',
  68     'after Parent::method',
  69 ]);
  70
  71 Child->method;
  72
  73 TODO: {
  74     local $TODO = "pending fix";
  75     is_deeply([splice @calls], [
  76         'before Child::method',
  77         'before Parent::method',
  78         'Parent::method',
  79         'after Parent::method',
  80         'after Child::method',
  81     ], "cache is correctly invalidated when the parent method is wrapped");
  82 }
  83