t/313_before_after_dollar_under.t

   1 use strict;
   2 use warnings;
   3
   4 use Class::MOP;
   5 use Class::MOP::Class;
   6 use Test::More;
   7 use Test::Exception;
   8
   9 my %results;
  10
  11 {
  12
  13     package Base;
  14     use metaclass;
  15     sub hey { $results{base}++ }
  16 }
  17
  18 for my $wrap (qw(before after)) {
  19     my $meta = Class::MOP::Class->create_anon_class(
  20         superclasses => [ 'Base', 'Class::MOP::Object' ] );
  21     my $alter = "add_${wrap}_method_modifier";
  22     $meta->$alter(
  23         'hey' => sub {
  24             $results{wrapped}++;
  25             $_ = 'barf';    # 'barf' would replace the cached wrapper subref
  26         }
  27     );
  28
  29     %results = ();
  30     my $o = $meta->get_meta_instance->create_instance;
  31     isa_ok( $o, 'Base' );
  32     lives_ok {
  33         $o->hey;
  34         $o->hey
  35             ; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use'
  36     }
  37     'wrapped doesn\'t die when $_ gets changed';
  38     is_deeply(
  39         \%results, { base => 2, wrapped => 2 },
  40         'saw expected calls to wrappers'
  41     );
  42 }
  43
  44 {
  45     my $meta = Class::MOP::Class->create_anon_class(
  46         superclasses => [ 'Base', 'Class::MOP::Object' ] );
  47     for my $wrap (qw(before after)) {
  48         my $alter = "add_${wrap}_method_modifier";
  49         $meta->$alter(
  50             'hey' => sub {
  51                 $results{wrapped}++;
  52                 $_ = 'barf';  # 'barf' would replace the cached wrapper subref
  53             }
  54         );
  55     }
  56
  57     %results = ();
  58     my $o = $meta->get_meta_instance->create_instance;
  59     isa_ok( $o, 'Base' );
  60     lives_ok {
  61         $o->hey;
  62         $o->hey
  63             ; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use'
  64     }
  65     'double-wrapped doesn\'t die when $_ gets changed';
  66     is_deeply(
  67         \%results, { base => 2, wrapped => 4 },
  68         'saw expected calls to wrappers'
  69     );
  70 }
  71
  72 done_testing;