t/001_cmop/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::Fatal;
   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     is( exception {
  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     }, undef, 'wrapped doesn\'t die when $_ gets changed' );
  37     is_deeply(
  38         \%results, { base => 2, wrapped => 2 },
  39         'saw expected calls to wrappers'
  40     );
  41 }
  42
  43 {
  44     my $meta = Class::MOP::Class->create_anon_class(
  45         superclasses => [ 'Base', 'Class::MOP::Object' ] );
  46     for my $wrap (qw(before after)) {
  47         my $alter = "add_${wrap}_method_modifier";
  48         $meta->$alter(
  49             'hey' => sub {
  50                 $results{wrapped}++;
  51                 $_ = 'barf';  # 'barf' would replace the cached wrapper subref
  52             }
  53         );
  54     }
  55
  56     %results = ();
  57     my $o = $meta->get_meta_instance->create_instance;
  58     isa_ok( $o, 'Base' );
  59     is( exception {
  60         $o->hey;
  61         $o->hey
  62             ; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use'
  63     }, undef, 'double-wrapped doesn\'t die when $_ gets changed' );
  64     is_deeply(
  65         \%results, { base => 2, wrapped => 4 },
  66         'saw expected calls to wrappers'
  67     );
  68 }
  69
  70 done_testing;