t/20-leaks.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Fatal;
   6 use Test::Requires 'Test::LeakTrace';
   7
   8 use Package::Stash;
   9 use Symbol;
  10
  11 {
  12     package Bar;
  13 }
  14
  15 {
  16     package Baz;
  17     our $foo;
  18     sub bar { }
  19     use constant baz => 1;
  20     our %quux = (a => 'b');
  21 }
  22
  23 {
  24     no_leaks_ok {
  25         Package::Stash->new('Foo');
  26     } "object construction doesn't leak";
  27 }
  28
  29 {
  30     no_leaks_ok {
  31         Package::Stash->new('Bar');
  32     } "object construction doesn't leak, with an existing package";
  33 }
  34
  35 {
  36     no_leaks_ok {
  37         Package::Stash->new('Baz');
  38     } "object construction doesn't leak, with an existing package with things in it";
  39 }
  40
  41 {
  42     my $foo = Package::Stash->new('Foo');
  43     no_leaks_ok {
  44         $foo->name;
  45         $foo->namespace;
  46     } "accessors don't leak";
  47 }
  48
  49 {
  50     my $foo = Package::Stash->new('Foo');
  51     no_leaks_ok {
  52         $foo->add_symbol('$scalar');
  53         $foo->add_symbol('@array');
  54         $foo->add_symbol('%hash');
  55         $foo->add_symbol('io');
  56     } "add_symbol doesn't leak";
  57 }
  58
  59 {
  60     my $foo = Package::Stash->new('Foo');
  61     no_leaks_ok {
  62         $foo->add_symbol('$scalar_init' => 1);
  63         $foo->add_symbol('@array_init' => []);
  64         $foo->add_symbol('%hash_init' => {});
  65         $foo->add_symbol('&code_init' => sub { "foo" });
  66         $foo->add_symbol('io_init' => Symbol::geniosym);
  67     } "add_symbol doesn't leak";
  68     is(exception {
  69         is(Foo->code_init, 'foo', "sub installed correctly")
  70     }, undef, "code_init exists");
  71 }
  72
  73 {
  74     my $foo = Package::Stash->new('Foo');
  75     no_leaks_ok {
  76         $foo->remove_symbol('$scalar_init');
  77         $foo->remove_symbol('@array_init');
  78         $foo->remove_symbol('%hash_init');
  79         $foo->remove_symbol('&code_init');
  80         $foo->remove_symbol('io_init');
  81     } "remove_symbol doesn't leak";
  82 }
  83
  84 {
  85     my $foo = Package::Stash->new('Foo');
  86     $foo->add_symbol("${_}glob") for ('$', '@', '%', '&', '');
  87     no_leaks_ok {
  88         $foo->remove_glob('glob');
  89     } "remove_glob doesn't leak";
  90 }
  91
  92 {
  93     my $foo = Package::Stash->new('Foo');
  94     no_leaks_ok {
  95         $foo->has_symbol('io');
  96         $foo->has_symbol('%hash');
  97         $foo->has_symbol('@array_init');
  98         $foo->has_symbol('$glob');
  99         $foo->has_symbol('&something_else');
 100     } "has_symbol doesn't leak";
 101 }
 102
 103 {
 104     my $foo = Package::Stash->new('Foo');
 105     no_leaks_ok {
 106         $foo->get_symbol('io');
 107         $foo->get_symbol('%hash');
 108         $foo->get_symbol('@array_init');
 109         $foo->get_symbol('$glob');
 110         $foo->get_symbol('&something_else');
 111     } "get_symbol doesn't leak";
 112 }
 113
 114 {
 115     my $foo = Package::Stash->new('Foo');
 116     ok(!$foo->has_symbol('$glob'));
 117     ok(!$foo->has_symbol('@array_init'));
 118     no_leaks_ok {
 119         $foo->get_or_add_symbol('io');
 120         $foo->get_or_add_symbol('%hash');
 121         my @super = ('Exporter');
 122         @{$foo->get_or_add_symbol('@ISA')} = @super;
 123         $foo->get_or_add_symbol('$glob');
 124     } "get_or_add_symbol doesn't leak";
 125     { local $TODO = $] < 5.010 ? "undef scalars aren't visible on 5.8" : undef;
 126     ok($foo->has_symbol('$glob'));
 127     }
 128     is(ref($foo->get_symbol('$glob')), 'SCALAR');
 129     ok($foo->has_symbol('@ISA'));
 130     is(ref($foo->get_symbol('@ISA')), 'ARRAY');
 131     is_deeply($foo->get_symbol('@ISA'), ['Exporter']);
 132     isa_ok('Foo', 'Exporter');
 133 }
 134
 135 {
 136     my $foo = Package::Stash->new('Foo');
 137     my $baz = Package::Stash->new('Baz');
 138     no_leaks_ok {
 139         $foo->list_all_symbols;
 140         $foo->list_all_symbols('SCALAR');
 141         $foo->list_all_symbols('CODE');
 142         $baz->list_all_symbols('CODE');
 143     } "list_all_symbols doesn't leak";
 144 }
 145
 146 # mimic CMOP::create_anon_class
 147 {
 148     local $TODO = $] < 5.010 ? "deleting stashes is inherently leaky on 5.8"
 149                              : undef;
 150     my $i = 0;
 151     no_leaks_ok {
 152         $i++;
 153         eval "package Quux$i; 1;";
 154         my $quux = Package::Stash->new("Quux$i");
 155         $quux->get_or_add_symbol('@ISA');
 156         delete $::{'Quux' . $i . '::'};
 157     } "get_symbol doesn't leak during glob expansion";
 158 }
 159
 160 {
 161     my $foo = Package::Stash->new('Foo');
 162     no_leaks_ok {
 163         eval { $foo->get_or_add_symbol('&blorg') };
 164     } "doesn't leak on errors";
 165 }
 166
 167 done_testing;