t-failing/100_bugs/024_anon_method_metaclass.t

   1 use strict;
   2 # This is automatically generated by author/import-moose-test.pl.
   3 # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
   4 use t::lib::MooseCompat;
   5 use warnings;
   6 use Test::More;
   7 $TODO = q{Mouse is not yet completed};
   8
   9 {
  10     package Ball;
  11     use Mouse;
  12 }
  13
  14 {
  15     package Arbitrary::Roll;
  16     use Mouse::Role;
  17 }
  18
  19 my $method_meta = Mouse::Meta::Class->create_anon_class(
  20     superclasses => ['Mouse::Meta::Method'],
  21     roles        => ['Arbitrary::Roll'],
  22 );
  23
  24 # For comparing identity without actually keeping $original_meta around
  25 my $original_meta = "$method_meta";
  26
  27 my $method_class = $method_meta->name;
  28
  29 my $method_object = $method_class->wrap(
  30     sub {'ok'},
  31     associated_metaclass => Ball->meta,
  32     package_name         => 'Ball',
  33     name                 => 'bounce',
  34 );
  35
  36 Ball->meta->add_method( bounce => $method_object );
  37
  38 for ( 1, 2 ) {
  39     is( Ball->bounce, 'ok', "method still exists on Ball" );
  40     is( Ball->meta->get_method('bounce')->meta->name, $method_class,
  41         "method's package still exists" );
  42
  43     is( Ball->meta->get_method('bounce'), $method_object,
  44         'original method object is preserved' );
  45
  46     is( Ball->meta->get_method('bounce')->meta . '', $original_meta,
  47         "method's metaclass still exists" );
  48     ok( Ball->meta->get_method('bounce')->meta->does_role('Arbitrary::Roll'),
  49         "method still does Arbitrary::Roll" );
  50
  51     undef $method_meta;
  52 }
  53
  54 done_testing;