Benchmark-DKbench

 view release on metacpan or  search on metacpan

data/t/recipes/basics_binarytree_attributefeatures.t  view on Meta::CPAN

my $left = $root->left;
isa_ok($left, 'BinaryTree');

is($root->left, $left, '... got the same node (and it is $left)');
ok($root->has_left, '... we have a left node now');

ok($left->has_parent, '... lefts has a parent');
is($left->parent, $root, '... lefts parent is the root');

ok(isweak($left->{parent}), '... parent is a weakened ref');

ok(!$left->has_left, '... $left no left node yet');
ok(!$left->has_right, '... $left no right node yet');

is($left->node, undef, '... left has got no node value');

is(
    exception {
        $left->node('left');
    },

data/t/recipes/basics_binarytree_attributefeatures.t  view on Meta::CPAN

);

is($right->node, 'right', '... left now has a node value');

is($root->right, $right, '... got the same node (and it is $right)');
ok($root->has_right, '... we have a right node now');

ok($right->has_parent, '... rights has a parent');
is($right->parent, $root, '... rights parent is the root');

ok(isweak($right->{parent}), '... parent is a weakened ref');

# make a left node of the left node

my $left_left = $left->left;
isa_ok($left_left, 'BinaryTree');

ok($left_left->has_parent, '... left does have a parent');

is($left_left->parent, $left, '... got a parent node (and it is $left)');
ok($left->has_left, '... we have a left node now');
is($left->left, $left_left, '... got a left node (and it is $left_left)');

ok(isweak($left_left->{parent}), '... parent is a weakened ref');

# make a right node of the left node

my $left_right = BinaryTree->new;
isa_ok($left_right, 'BinaryTree');

is(
    exception {
        $left->right($left_right);
    },
    undef,
    '... assign to rights node'
);

ok($left_right->has_parent, '... left does have a parent');

is($left_right->parent, $left, '... got a parent node (and it is $left)');
ok($left->has_right, '... we have a left node now');
is($left->right, $left_right, '... got a left node (and it is $left_left)');

ok(isweak($left_right->{parent}), '... parent is a weakened ref');

# and check the error

isnt(
    exception {
        $left_right->right($left_left);
    },
    undef,
    '... cannot assign a node which already has a parent'
);

data/t/recipes/meta_globref_instancemetaclass.t  view on Meta::CPAN

use Test::Fatal;
$| = 1;



# =begin testing SETUP
{

  package My::Meta::Instance;

  use Scalar::Util qw( weaken );
  use Symbol qw( gensym );

  use Moose::Role;

  sub create_instance {
      my $self = shift;
      my $sym = gensym();
      bless $sym, $self->_class_name;
  }

data/t/recipes/meta_globref_instancemetaclass.t  view on Meta::CPAN

  sub deinitialize_slot {
      my ( $self, $instance, $slot_name ) = @_;
      delete *$instance->{$slot_name};
  }

  sub is_slot_initialized {
      my ( $self, $instance, $slot_name ) = @_;
      exists *$instance->{$slot_name};
  }

  sub weaken_slot_value {
      my ( $self, $instance, $slot_name ) = @_;
      weaken *$instance->{$slot_name};
  }

  sub inline_create_instance {
      my ( $self, $class_variable ) = @_;
      return 'do { my $sym = Symbol::gensym(); bless $sym, ' . $class_variable . ' }';
  }

  sub inline_slot_access {
      my ( $self, $instance, $slot_name ) = @_;
      return '*{' . $instance . '}->{' . $slot_name . '}';