t/todo_tests/replacing_super_methods.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5
   6 my ($super_called, $sub_called, $new_super_called) = (0, 0, 0);
   7 {
   8     package Foo;
   9     use Moose;
  10
  11     sub foo { $super_called++ }
  12 }
  13
  14 {
  15     package Foo::Sub;
  16     use Moose;
  17     extends 'Foo';
  18
  19     override foo => sub {
  20         $sub_called++;
  21         super();
  22     };
  23 }
  24
  25 Foo::Sub->new->foo;
  26 is($super_called, 1, "super called");
  27 is($new_super_called, 0, "new super not called");
  28 is($sub_called, 1, "sub called");
  29
  30 ($super_called, $sub_called, $new_super_called) = (0, 0, 0);
  31
  32 Foo->meta->add_method(foo => sub {
  33     $new_super_called++;
  34 });
  35
  36 Foo::Sub->new->foo;
  37 { local $TODO = "super doesn't get replaced";
  38 is($super_called, 0, "super not called");
  39 is($new_super_called, 1, "new super called");
  40 }
  41 is($sub_called, 1, "sub called");
  42
  43 done_testing;