t/302_modify_parent_method.t

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