xt/author/memory_leaks.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::LeakTrace 0.01;
   6 use Test::Memory::Cycle;
   7
   8 use Moose ();
   9 use Moose::Util qw( apply_all_roles );
  10 use Moose::Util::TypeConstraints;
  11
  12 {
  13     package MyRole;
  14     use Moose::Role;
  15     sub myname { "I'm a role" }
  16 }
  17
  18 no_leaks_ok(
  19     sub {
  20         Moose::Meta::Class->create_anon_class->new_object;
  21     },
  22     'anonymous class with no roles is leak-free'
  23 );
  24
  25 no_leaks_ok(
  26     sub {
  27         Moose::Meta::Role->initialize('MyRole2');
  28     },
  29     'Moose::Meta::Role->initialize is leak-free'
  30 );
  31
  32 no_leaks_ok(
  33     sub {
  34         Moose::Meta::Class->create('MyClass2')->new_object;
  35     },
  36     'creating named class is leak-free'
  37 );
  38
  39 {
  40     local $TODO
  41         = 'role application leaks because we end up applying the role more than once to the meta object';
  42     no_leaks_ok(
  43         sub {
  44             Moose::Meta::Class->create( 'MyClass', roles => ['MyRole'] );
  45         },
  46         'named class with roles is leak-free'
  47     );
  48
  49     no_leaks_ok(
  50         sub {
  51             Moose::Meta::Role->create( 'MyRole2', roles => ['MyRole'] );
  52         },
  53         'named role with roles is leak-free'
  54     );
  55 }
  56
  57 no_leaks_ok(
  58     sub {
  59         my $object = Moose::Meta::Class->create('MyClass2')->new_object;
  60         apply_all_roles( $object, 'MyRole' );
  61     },
  62     'applying role to an instance is leak-free'
  63 );
  64
  65 no_leaks_ok(
  66     sub {
  67         Moose::Meta::Role->create_anon_role;
  68     },
  69     'anonymous role is leak-free'
  70 );
  71
  72 {
  73     # fixing this leak currently triggers a bug in Carp
  74     # we can un-TODO once that fix goes in allowing the leak
  75     # in Eval::Closure to be fixed
  76     local $TODO = 'Eval::Closure leaks a bit at the moment';
  77     no_leaks_ok(
  78         sub {
  79             my $meta = Moose::Meta::Class->create_anon_class;
  80             $meta->make_immutable;
  81         },
  82         'making an anon class immutable is leak-free'
  83     );
  84 }
  85
  86 {
  87     my $meta3 = Moose::Meta::Class->create('MyClass3');
  88     memory_cycle_ok( $meta3, 'named metaclass object is cycle-free' );
  89     memory_cycle_ok( $meta3->new_object, 'MyClass3 object is cycle-free' );
  90
  91     my $anon_class = Moose::Meta::Class->create_anon_class;
  92     memory_cycle_ok($anon_class, 'anon metaclass object is cycle-free' );
  93     memory_cycle_ok( $anon_class->new_object, 'object from anon metaclass is cycle-free' );
  94
  95     $anon_class->make_immutable;
  96     memory_cycle_ok($anon_class, 'immutable anon metaclass object is cycle-free' );
  97     memory_cycle_ok( $anon_class->new_object, 'object from immutable anon metaclass is cycle-free' );
  98
  99     my $anon_role = Moose::Meta::Role->create_anon_role;
 100     memory_cycle_ok($anon_role, 'anon role meta object is cycle-free' );
 101 }
 102
 103 {
 104     my $Str = find_type_constraint('Str');
 105     my $Undef = find_type_constraint('Undef');
 106     my $Str_or_Undef = Moose::Meta::TypeConstraint::Union->new(
 107         type_constraints => [ $Str, $Undef ] );
 108     memory_cycle_ok($Str_or_Undef, 'union types do not leak');
 109 }
 110
 111
 112 done_testing;