-#!/usr/bin/perl
-
use strict;
use warnings;
-use Test::More tests => 27;
-use Test::Exception;
+use Test::More;
+use Test::Fatal;
-BEGIN {
- use_ok('Class::MOP');
-}
+use Class::MOP;
{
package Point;
use metaclass;
- Point->meta->add_attribute('$.x' => (
+ Point->meta->add_attribute('x' => (
reader => 'x',
init_arg => 'x'
));
- Point->meta->add_attribute('$.y' => (
+ Point->meta->add_attribute('y' => (
accessor => 'y',
init_arg => 'y'
));
sub new {
my $class = shift;
- bless $class->meta->construct_instance(@_) => $class;
+ bless $class->meta->new_object(@_) => $class;
}
sub clear {
my $self = shift;
- $self->{'$.x'} = 0;
- $self->{'$.y'} = 0;
+ $self->{'x'} = 0;
+ $self->{'y'} = 0;
}
package Point3D;
our @ISA = ('Point');
-
- Point3D->meta->add_attribute('$:z' => (
+
+ Point3D->meta->add_attribute('z' => (
default => 123
));
sub clear {
my $self = shift;
- $self->{'$:z'} = 0;
+ $self->{'z'} = 0;
$self->SUPER::clear();
}
}
is($meta, Point->meta(), '... got the meta from the instance too');
}
-is($point->y, 3, '... the $.y attribute was initialized correctly through the metaobject');
+is($point->y, 3, '... the y attribute was initialized correctly through the metaobject');
$point->y(42);
-is($point->y, 42, '... the $.y attribute was set properly with the accessor');
+is($point->y, 42, '... the y attribute was set properly with the accessor');
-is($point->x, 2, '... the $.x attribute was initialized correctly through the metaobject');
+is($point->x, 2, '... the x attribute was initialized correctly through the metaobject');
-$point->x(42);
-is($point->x, 2, '... the $.x attribute was not altered');
+isnt( exception {
+ $point->x(42);
+}, undef, '... cannot write to a read-only accessor' );
+is($point->x, 2, '... the x attribute was not altered');
$point->clear();
-is($point->y, 0, '... the $.y attribute was cleared correctly');
-is($point->x, 0, '... the $.x attribute was cleared correctly');
+is($point->y, 0, '... the y attribute was cleared correctly');
+is($point->x, 0, '... the x attribute was cleared correctly');
-my $point3d = Point3D->new('x' => 1, 'y' => 2, '$:z' => 3);
+my $point3d = Point3D->new('x' => 1, 'y' => 2, 'z' => 3);
isa_ok($point3d, 'Point3D');
isa_ok($point3d, 'Point');
can_ok($point3d, 'y');
can_ok($point3d, 'clear');
-is($point3d->x, 1, '... the $.x attribute was initialized correctly through the metaobject');
-is($point3d->y, 2, '... the $.y attribute was initialized correctly through the metaobject');
-is($point3d->{'$:z'}, 3, '... the $:z attribute was initialized correctly through the metaobject');
+is($point3d->x, 1, '... the x attribute was initialized correctly through the metaobject');
+is($point3d->y, 2, '... the y attribute was initialized correctly through the metaobject');
+is($point3d->{'z'}, 3, '... the z attribute was initialized correctly through the metaobject');
{
my $point3d = Point3D->new();
isa_ok($point3d, 'Point3D');
-
- is($point3d->x, undef, '... the $.x attribute was not initialized');
- is($point3d->y, undef, '... the $.y attribute was not initialized');
- is($point3d->{'$:z'}, 123, '... the $:z attribute was initialized correctly through the metaobject');
-
+
+ is($point3d->x, undef, '... the x attribute was not initialized');
+ is($point3d->y, undef, '... the y attribute was not initialized');
+ is($point3d->{'z'}, 123, '... the z attribute was initialized correctly through the metaobject');
+
}
+
+done_testing;