t/302_modify_parent_method.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Fatal;
   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(
  31         'method' => sub {
  32             my $orig = shift;
  33             push @calls, 'before Child::method';
  34             $orig->(@_);
  35             push @calls, 'after Child::method';
  36         }
  37     );
  38 }
  39
  40 Parent->method;
  41
  42 is_deeply(
  43     [ splice @calls ],
  44     [
  45         'Parent::method',
  46     ]
  47 );
  48
  49 Child->method;
  50
  51 is_deeply(
  52     [ splice @calls ],
  53     [
  54         'before Child::method',
  55         'Parent::method',
  56         'after Child::method',
  57     ]
  58 );
  59
  60 {
  61     package Parent;
  62
  63     Parent->meta->add_around_method_modifier(
  64         'method' => sub {
  65             my $orig = shift;
  66             push @calls, 'before Parent::method';
  67             $orig->(@_);
  68             push @calls, 'after Parent::method';
  69         }
  70     );
  71 }
  72
  73 Parent->method;
  74
  75 is_deeply(
  76     [ splice @calls ],
  77     [
  78         'before Parent::method',
  79         'Parent::method',
  80         'after Parent::method',
  81     ]
  82 );
  83
  84 Child->method;
  85
  86 TODO: {
  87     local $TODO = "pending fix";
  88     is_deeply(
  89         [ splice @calls ],
  90         [
  91             'before Child::method',
  92             'before Parent::method',
  93             'Parent::method',
  94             'after Parent::method',
  95             'after Child::method',
  96         ],
  97         "cache is correctly invalidated when the parent method is wrapped"
  98     );
  99 }
 100
 101 done_testing;