Moose

 view release on metacpan or  search on metacpan

lib/Class/MOP/Instance.pm  view on Meta::CPAN

    sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
}

sub inline_strengthen_slot_value {
    my ($self, $instance, $slot_name) = @_;
    $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
}

sub inline_rebless_instance_structure {
    my ($self, $instance, $class_variable) = @_;
    "bless $instance => $class_variable";
}

sub _inline_get_mop_slot {
    my ($self, $instance) = @_;
    $self->inline_get_slot_value($instance, $RESERVED_MOP_SLOT);
}

sub _inline_set_mop_slot {
    my ($self, $instance, $value) = @_;
    $self->inline_set_slot_value($instance, $RESERVED_MOP_SLOT, $value);

t/cmop/LazyClass_test.t  view on Meta::CPAN

        default => sub { BinaryTree->new() }
    ));

    BinaryTree->meta->add_attribute('right' => (
        reader  => 'right',
        default => sub { BinaryTree->new() }
    ));

    sub new {
        my $class = shift;
        bless $class->meta->new_object(@_) => $class;
    }
}

my $root = BinaryTree->new('node' => 0);
isa_ok($root, 'BinaryTree');

ok(exists($root->{'node'}), '... node attribute has been initialized yet');
ok(!exists($root->{'left'}), '... left attribute has not been initialized yet');
ok(!exists($root->{'right'}), '... right attribute has not been initialized yet');

t/cmop/add_attribute_alternate.t  view on Meta::CPAN

        init_arg => 'x'
    ));

    Point->meta->add_attribute('y' => (
        accessor => 'y',
        init_arg => 'y'
    ));

    sub new {
        my $class = shift;
        bless $class->meta->new_object(@_) => $class;
    }

    sub clear {
        my $self = shift;
        $self->{'x'} = 0;
        $self->{'y'} = 0;
    }

    package Point3D;
    our @ISA = ('Point');

t/cmop/create_class.t  view on Meta::CPAN

        )),
        Class::MOP::Attribute->new('y' => (
            accessor => 'y',
            init_arg => 'y'
        )),
    ],
    methods => {
        'new' => sub {
            my $class = shift;
            my $instance = $class->meta->new_object(@_);
            bless $instance => $class;
        },
        'clear' => sub {
            my $self = shift;
            $self->{'x'} = 0;
            $self->{'y'} = 0;
        }
    }
));

my $Point3D = Class::MOP::Class->create('Point3D' => (

t/cmop/insertion_order.t  view on Meta::CPAN

        )),
        Class::MOP::Attribute->new('y' => (
            accessor => 'y',
            init_arg => 'y'
        )),
    ],
    methods => {
        'new' => sub {
            my $class = shift;
            my $instance = $class->meta->new_object(@_);
            bless $instance => $class;
        },
        'clear' => sub {
            my $self = shift;
            $self->{'x'} = 0;
            $self->{'y'} = 0;
        }
    }
));

is($Point->get_attribute('x')->insertion_order, 0, 'Insertion order of Attribute "x"');

t/cmop/instance_inline.t  view on Meta::CPAN

my $C = 'Class::MOP::Instance';

{
    my $instance  = '$self';
    my $slot_name = 'foo';
    my $value     = '$value';
    my $class     = '$class';

    is($C->inline_create_instance($class),
      'bless {} => $class',
      '... got the right code for create_instance');
    is($C->inline_get_slot_value($instance, $slot_name),
      q[$self->{"foo"}],
      '... got the right code for get_slot_value');

    is($C->inline_set_slot_value($instance, $slot_name, $value),
      q[$self->{"foo"} = $value],
      '... got the right code for set_slot_value');

    is($C->inline_initialize_slot($instance, $slot_name),

t/compat/foreign_inheritence.t  view on Meta::CPAN

{

    package Elk;
    use strict;
    use warnings;

    sub new {
        my $class = shift;
        bless { no_moose => "Elk" } => $class;
    }

    sub no_moose { $_[0]->{no_moose} }

    package Foo::Moose;
    use Moose;

    extends 'Elk';

    has 'moose' => ( is => 'ro', default => 'Foo' );

t/exceptions/class-mop-method-accessor.t  view on Meta::CPAN

        package Point;
        use metaclass;

        Point->meta->add_attribute('x' => (
            reader   => 'x',
            init_arg => 'x'
        ));

        sub new {
            my $class = shift;
            bless $class->meta->new_object(@_) => $class;
        }
    }

    my $point = Point->new();

    my $exception = exception {
        $point->x(120);
    };

    like(

xt/author/memory_leaks.t  view on Meta::CPAN

            )),
            Class::MOP::Attribute->new('y' => (
                accessor => 'y',
                init_arg => 'y'
            )),
        ],
        methods => {
            'new' => sub {
                my $class = shift;
                my $instance = $class->meta->new_object(@_);
                bless $instance => $class;
            },
            'clear' => sub {
                my $self = shift;
                $self->{'x'} = 0;
                $self->{'y'} = 0;
            }
        }
    ));

    my $Point3D = Class::MOP::Class->create('Point3D' => (

 view all matches for this distribution
 view release on metacpan -  search on metacpan