t/106_LazyClass_test.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 26;
   7 use File::Spec;
   8
   9 BEGIN {
  10     use_ok('Class::MOP');
  11     require_ok(File::Spec->catdir('examples', 'LazyClass.pod'));
  12 }
  13
  14 {
  15     package BinaryTree;
  16
  17     use metaclass (
  18         'attribute_metaclass' => 'LazyClass::Attribute',
  19         'instance_metaclass'  => 'LazyClass::Instance',
  20     );
  21
  22     BinaryTree->meta->add_attribute('$:node' => (
  23         accessor => 'node',
  24         init_arg => 'node'
  25     ));
  26
  27     BinaryTree->meta->add_attribute('$:left' => (
  28         reader  => 'left',
  29         default => sub { BinaryTree->new() }
  30     ));
  31
  32     BinaryTree->meta->add_attribute('$:right' => (
  33         reader  => 'right',
  34         default => sub { BinaryTree->new() }
  35     ));
  36
  37     sub new {
  38         my $class = shift;
  39         bless $class->meta->construct_instance(@_) => $class;
  40     }
  41 }
  42
  43 my $root = BinaryTree->new('node' => 0);
  44 isa_ok($root, 'BinaryTree');
  45
  46 ok(exists($root->{'$:node'}), '... node attribute has been initialized yet');
  47 ok(!exists($root->{'$:left'}), '... left attribute has not been initialized yet');
  48 ok(!exists($root->{'$:right'}), '... right attribute has not been initialized yet');
  49
  50 isa_ok($root->left, 'BinaryTree');
  51 isa_ok($root->right, 'BinaryTree');
  52
  53 ok(exists($root->{'$:left'}), '... left attribute has now been initialized');
  54 ok(exists($root->{'$:right'}), '... right attribute has now been initialized');
  55
  56 ok(!exists($root->left->{'$:node'}), '... node attribute has not been initialized yet');
  57 ok(!exists($root->left->{'$:left'}), '... left attribute has not been initialized yet');
  58 ok(!exists($root->left->{'$:right'}), '... right attribute has not been initialized yet');
  59
  60 ok(!exists($root->right->{'$:node'}), '... node attribute has not been initialized yet');
  61 ok(!exists($root->right->{'$:left'}), '... left attribute has not been initialized yet');
  62 ok(!exists($root->right->{'$:right'}), '... right attribute has not been initialized yet');
  63
  64 is($root->left->node(), undef, '... the left node is uninitialized');
  65
  66 ok(exists($root->left->{'$:node'}), '... node attribute has now been initialized');
  67
  68 $root->left->node(1);
  69 is($root->left->node(), 1, '... the left node == 1');
  70
  71 ok(!exists($root->left->{'$:left'}), '... left attribute still has not been initialized yet');
  72 ok(!exists($root->left->{'$:right'}), '... right attribute still has not been initialized yet');
  73
  74 is($root->right->node(), undef, '... the right node is uninitialized');
  75
  76 ok(exists($root->right->{'$:node'}), '... node attribute has now been initialized');
  77
  78 $root->right->node(2);
  79 is($root->right->node(), 2, '... the right node == 1');
  80
  81 ok(!exists($root->right->{'$:left'}), '... left attribute still has not been initialized yet');
  82 ok(!exists($root->right->{'$:right'}), '... right attribute still has not been initialized yet');
  83