t/bugs/memory_leaks.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::Requires {
   5     'Test::LeakTrace'     => '0.01',
   6     'Test::Memory::Cycle' => '0',
   7 };
   8
   9 use Test::More;
  10
  11 use Moose ();
  12 use Moose::Util qw( apply_all_roles );
  13
  14 {
  15     package MyRole;
  16     use Moose::Role;
  17     sub myname { "I'm a role" }
  18 }
  19 use Data::Dumper ();
  20 my $o = Data::Dumper->can('_dump'); *Data::Dumper::_dump = sub { Scalar::Util::isweak($_[1]) ? 'WEAK<'.&$o.'>' : &$o };
  21 no_leaks_ok(
  22     sub {
  23         Moose::Meta::Class->create_anon_class->new_object;
  24     },
  25     'anonymous class with no roles is leak-free'
  26 );
  27
  28 no_leaks_ok(
  29     sub {
  30         Moose::Meta::Role->initialize('MyRole2');
  31     },
  32     'Moose::Meta::Role->initialize is leak-free'
  33 );
  34
  35 no_leaks_ok(
  36     sub {
  37         Moose::Meta::Class->create('MyClass2')->new_object;
  38     },
  39     'creating named class is leak-free'
  40 );
  41
  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 no_leaks_ok(
  57     sub {
  58         my $object = Moose::Meta::Class->create('MyClass2')->new_object;
  59         apply_all_roles( $object, 'MyRole' );
  60     },
  61     'applying role to an instance is leak-free'
  62 );
  63
  64 no_leaks_ok(
  65     sub {
  66         Moose::Meta::Role->create_anon_role;
  67     },
  68     'anonymous role is leak-free'
  69 );
  70
  71 no_leaks_ok(
  72     sub {
  73         my $meta = Moose::Meta::Class->create_anon_class;
  74         $meta->make_immutable;
  75     },
  76     'making an anon class immutable is leak-free'
  77 );
  78
  79 {
  80     my $meta3 = Class::MOP::Class->create('MyClass3');
  81     memory_cycle_ok( $meta3, 'named metaclass object is cycle-free' );
  82     memory_cycle_ok( $meta3->new_object, 'MyClass3 object is cycle-free' );
  83
  84     my $anon = Class::MOP::Class->create_anon_class;
  85     memory_cycle_ok($anon, 'anon metaclass object is cycle-free' );
  86     memory_cycle_ok( $anon->new_object, 'object from anon metaclass is cycle-free' );
  87
  88     $anon->make_immutable;
  89     memory_cycle_ok($anon, 'immutable anon metaclass object is cycle-free' );
  90     memory_cycle_ok( $anon->new_object, 'object from immutable anon metaclass is cycle-free' );
  91 }
  92
  93 done_testing;