t/080_meta_package.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 80;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Class::MOP');
  11     use_ok('Class::MOP::Package');
  12 }
  13
  14 {
  15     package Foo;
  16
  17     sub meta { Class::MOP::Package->initialize('Foo') }
  18 }
  19
  20 # ----------------------------------------------------------------------
  21 ## tests adding a HASH
  22
  23 ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet');
  24 ok(!Foo->meta->has_package_symbol('%foo'), '... the meta agrees');
  25
  26 lives_ok {
  27     Foo->meta->add_package_symbol('%foo' => { one => 1 });
  28 } '... created %Foo::foo successfully';
  29
  30 # ... scalar should NOT be created here
  31
  32 ok(!Foo->meta->has_package_symbol('$foo'), '... SCALAR shouldnt have been created too');
  33 ok(!Foo->meta->has_package_symbol('@foo'), '... ARRAY shouldnt have been created too');
  34 ok(!Foo->meta->has_package_symbol('&foo'), '... CODE shouldnt have been created too');
  35
  36 ok(defined($Foo::{foo}), '... the %foo slot was created successfully');
  37 ok(Foo->meta->has_package_symbol('%foo'), '... the meta agrees');
  38
  39 # check the value ...
  40
  41 {
  42     no strict 'refs';
  43     ok(exists ${'Foo::foo'}{one}, '... our %foo was initialized correctly');
  44     is(${'Foo::foo'}{one}, 1, '... our %foo was initialized correctly');
  45 }
  46
  47 my $foo = Foo->meta->get_package_symbol('%foo');
  48 is_deeply({ one => 1 }, $foo, '... got the right package variable back');
  49
  50 # ... make sure changes propogate up
  51
  52 $foo->{two} = 2;
  53
  54 {
  55     no strict 'refs';
  56     is(\%{'Foo::foo'}, Foo->meta->get_package_symbol('%foo'), '... our %foo is the same as the metas');
  57
  58     ok(exists ${'Foo::foo'}{two}, '... our %foo was updated correctly');
  59     is(${'Foo::foo'}{two}, 2, '... our %foo was updated correctly');
  60 }
  61
  62 # ----------------------------------------------------------------------
  63 ## test adding an ARRAY
  64
  65 ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet');
  66
  67 lives_ok {
  68     Foo->meta->add_package_symbol('@bar' => [ 1, 2, 3 ]);
  69 } '... created @Foo::bar successfully';
  70
  71 ok(defined($Foo::{bar}), '... the @bar slot was created successfully');
  72 ok(Foo->meta->has_package_symbol('@bar'), '... the meta agrees');
  73
  74 # ... why does this not work ...
  75
  76 ok(!Foo->meta->has_package_symbol('$bar'), '... SCALAR shouldnt have been created too');
  77 ok(!Foo->meta->has_package_symbol('%bar'), '... HASH shouldnt have been created too');
  78 ok(!Foo->meta->has_package_symbol('&bar'), '... CODE shouldnt have been created too');
  79
  80 # check the value itself
  81
  82 {
  83     no strict 'refs';
  84     is(scalar @{'Foo::bar'}, 3, '... our @bar was initialized correctly');
  85     is(${'Foo::bar'}[1], 2, '... our @bar was initialized correctly');
  86 }
  87
  88 # ----------------------------------------------------------------------
  89 ## test adding a SCALAR
  90
  91 ok(!defined($Foo::{baz}), '... the $baz slot has not been created yet');
  92
  93 lives_ok {
  94     Foo->meta->add_package_symbol('$baz' => 10);
  95 } '... created $Foo::baz successfully';
  96
  97 ok(defined($Foo::{baz}), '... the $baz slot was created successfully');
  98 ok(Foo->meta->has_package_symbol('$baz'), '... the meta agrees');
  99
 100 ok(!Foo->meta->has_package_symbol('@baz'), '... ARRAY shouldnt have been created too');
 101 ok(!Foo->meta->has_package_symbol('%baz'), '... HASH shouldnt have been created too');
 102 ok(!Foo->meta->has_package_symbol('&baz'), '... CODE shouldnt have been created too');
 103
 104 is(${Foo->meta->get_package_symbol('$baz')}, 10, '... got the right value back');
 105
 106 {
 107     no strict 'refs';
 108     ${'Foo::baz'} = 1;
 109
 110     is(${'Foo::baz'}, 1, '... our $baz was assigned to correctly');
 111     is(${Foo->meta->get_package_symbol('$baz')}, 1, '... the meta agrees');
 112 }
 113
 114 # ----------------------------------------------------------------------
 115 ## test adding a CODE
 116
 117 ok(!defined($Foo::{funk}), '... the &funk slot has not been created yet');
 118
 119 lives_ok {
 120     Foo->meta->add_package_symbol('&funk' => sub { "Foo::funk" });
 121 } '... created &Foo::funk successfully';
 122
 123 ok(defined($Foo::{funk}), '... the &funk slot was created successfully');
 124 ok(Foo->meta->has_package_symbol('&funk'), '... the meta agrees');
 125
 126 ok(!Foo->meta->has_package_symbol('$funk'), '... SCALAR shouldnt have been created too');
 127 ok(!Foo->meta->has_package_symbol('@funk'), '... ARRAY shouldnt have been created too');
 128 ok(!Foo->meta->has_package_symbol('%funk'), '... HASH shouldnt have been created too');
 129
 130 {
 131     no strict 'refs';
 132     ok(defined &{'Foo::funk'}, '... our &funk exists');
 133 }
 134
 135 is(Foo->funk(), 'Foo::funk', '... got the right value from the function');
 136
 137 # ----------------------------------------------------------------------
 138 ## test multiple slots in the glob
 139
 140 my $ARRAY = [ 1, 2, 3 ];
 141 my $CODE = sub { "Foo::foo" };
 142
 143 lives_ok {
 144     Foo->meta->add_package_symbol('@foo' => $ARRAY);
 145 } '... created @Foo::foo successfully';
 146
 147 ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot was added successfully');
 148 is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
 149
 150 lives_ok {
 151     Foo->meta->add_package_symbol('&foo' => $CODE);
 152 } '... created &Foo::foo successfully';
 153
 154 ok(Foo->meta->has_package_symbol('&foo'), '... the meta agrees');
 155 is(Foo->meta->get_package_symbol('&foo'), $CODE, '... got the right value for &Foo::foo');
 156
 157 lives_ok {
 158     Foo->meta->add_package_symbol('$foo' => 'Foo::foo');
 159 } '... created $Foo::foo successfully';
 160
 161 ok(Foo->meta->has_package_symbol('$foo'), '... the meta agrees');
 162 my $SCALAR = Foo->meta->get_package_symbol('$foo');
 163 is($$SCALAR, 'Foo::foo', '... got the right scalar value back');
 164
 165 {
 166     no strict 'refs';
 167     is(${'Foo::foo'}, 'Foo::foo', '... got the right value from the scalar');
 168 }
 169
 170 lives_ok {
 171     Foo->meta->remove_package_symbol('%foo');
 172 } '... removed %Foo::foo successfully';
 173
 174 ok(!Foo->meta->has_package_symbol('%foo'), '... the %foo slot was removed successfully');
 175 ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot still exists');
 176 ok(Foo->meta->has_package_symbol('&foo'), '... the &foo slot still exists');
 177 ok(Foo->meta->has_package_symbol('$foo'), '... the $foo slot still exists');
 178
 179 is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
 180 is(Foo->meta->get_package_symbol('&foo'), $CODE, '... got the right value for &Foo::foo');
 181 is(Foo->meta->get_package_symbol('$foo'), $SCALAR, '... got the right value for $Foo::foo');
 182
 183 {
 184     no strict 'refs';
 185     ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully');
 186     ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed');
 187     ok(defined(*{"Foo::foo"}{CODE}), '... the &foo slot has NOT been removed');
 188     ok(defined(*{"Foo::foo"}{SCALAR}), '... the $foo slot has NOT been removed');
 189 }
 190
 191 lives_ok {
 192     Foo->meta->remove_package_symbol('&foo');
 193 } '... removed &Foo::foo successfully';
 194
 195 ok(!Foo->meta->has_package_symbol('&foo'), '... the &foo slot no longer exists');
 196
 197 ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot still exists');
 198 ok(Foo->meta->has_package_symbol('$foo'), '... the $foo slot still exists');
 199
 200 is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
 201 is(Foo->meta->get_package_symbol('$foo'), $SCALAR, '... got the right value for $Foo::foo');
 202
 203 {
 204     no strict 'refs';
 205     ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully');
 206     ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed');
 207     ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed');
 208     ok(defined(*{"Foo::foo"}{SCALAR}), '... the $foo slot has NOT been removed');
 209 }
 210
 211
 212 # check some errors
 213
 214 dies_ok {
 215     Foo->meta->add_package_symbol('bar');
 216 } '... no sigil for bar';
 217
 218 dies_ok {
 219     Foo->meta->remove_package_symbol('bar');
 220 } '... no sigil for bar';
 221
 222 dies_ok {
 223     Foo->meta->get_package_symbol('bar');
 224 } '... no sigil for bar';
 225
 226 dies_ok {
 227     Foo->meta->has_package_symbol('bar');
 228 } '... no sigil for bar';