t/302_modify_parent_method.t

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