Revision history for Perl extension Moose
+0.37
+ * Moose
+ - fixed some details in Moose::init_meta
+ and its superclass handling (thanks thepler)
+ - added tests for this (thanks thepler)
+
+ * Moose::Meta::Class
+ Moose::Meta::Method::Constructor
+ Moose::Meta::Attribute
+ - making (init_arg => undef) work here too
+ (thanks to nothingmuch)
+
+ * Moose::Util::TypeConstraints
+ Moose::Util::TypeConstraints::OptimizedConstraints
+ Moose::Meta::Attribute
+ Moose::Meta::Method::Constructor
+ Moose::Meta::Method::Accessor
+ - making type errors use the
+ assigned message (thanks to Sartak)
+ - added tests for this
+
0.36 Sat. Jan. 26, 2008
* Moose::Role
Moose::Meta::Attribute
t/050_metaclasses/002_custom_attr_meta_as_role.t
t/050_metaclasses/003_moose_w_metaclass.t
t/050_metaclasses/004_moose_for_meta.t
+t/050_metaclasses/010_extending_and_embedding.t
+t/050_metaclasses/011_init_meta.t
t/060_compat/001_module_refresh_compat.t
t/060_compat/002_moose_respects_base.t
t/060_compat/003_foreign_inheritence.t
# prereqs
requires 'Scalar::Util' => $win32 ? '1.17' : '1.18';
requires 'Carp';
-requires 'Class::MOP' => '0.51';
+requires 'Class::MOP' => '0.53';
requires 'Sub::Name' => '0.02';
requires 'Sub::Exporter' => '0.972';
-Moose version 0.36
+Moose version 0.37
===========================
See the individual module documentation for more information
use strict;
use warnings;
-our $VERSION = '0.36';
+our $VERSION = '0.37';
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed', 'reftype';
sub init_meta {
my ( $class, $base_class, $metaclass ) = @_;
- $base_class = $class unless defined $base_class;
- $metaclass = 'Moose::Meta::Class' unless defined $metaclass;
+ $base_class = 'Moose::Object' unless defined $base_class;
+ $metaclass = 'Moose::Meta::Class' unless defined $metaclass;
confess
"The Metaclass $metaclass must be a subclass of Moose::Meta::Class."
# make sure they inherit from Moose::Object
$meta->superclasses($base_class)
unless $meta->superclasses();
+
+ return $meta;
}
my %exports = (
$val = $type_constraint->coerce($val);
}
(defined($type_constraint->check($val)))
- || confess "Attribute (" .
- $self->name .
- ") does not pass the type constraint (" .
- $type_constraint->name .
- ") with '" .
- (defined $val
- ? overload::StrVal($val)
- : 'undef') .
- "'";
+ || confess "Attribute ("
+ . $self->name
+ . ") does not pass the type constraint because: "
+ . $type_constraint->get_message($val);
}
$meta_instance->set_slot_value($instance, $self->name, $val);
if ($self->should_coerce) {
$value = $type_constraint->coerce($value);
- }
+ }
$type_constraint->_compiled_type_constraint->($value)
- || confess "Attribute ($attr_name) does not pass the type constraint ("
- . $type_constraint->name
- . ") with "
- . (defined($value)
- ? ("'" . overload::StrVal($value) . "'")
- : "undef")
- if defined($value);
+ || confess "Attribute ("
+ . $self->name
+ . ") does not pass the type constraint because "
+ . $type_constraint->get_message($value)
+ if defined($value);
}
my $meta_instance = Class::MOP::Class->initialize(blessed($instance))
use Carp 'confess';
-our $VERSION = '0.11';
+our $VERSION = '0.12';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Moose::Meta::Method',
# FIXME
# This sprintf is insanely annoying, we should
# fix it someday - SL
- return sprintf <<'EOF', $value, $attr_name, $type_constraint_name, $value, $value, $value, $value, $value, $value
+ return sprintf <<'EOF', $value, $attr_name, $value, $value,
$type_constraint->(%s)
- || confess "Attribute (%s) does not pass the type constraint (%s) with "
- . (defined(%s) ? overload::StrVal(%s) : "undef")
+ || confess "Attribute (%s) does not pass the type constraint because: "
+ . $type_constraint_obj->get_message(%s)
if defined(%s);
EOF
}
if ($is_moose && $attr->has_type_constraint) {
if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
- push @source => $self->_generate_type_coercion($attr, '$type_constraints[' . $index . ']', '$val', '$val');
+ push @source => $self->_generate_type_coercion(
+ $attr,
+ '$type_constraints[' . $index . ']',
+ '$val',
+ '$val'
+ );
}
- push @source => $self->_generate_type_constraint_check($attr, '$type_constraint_bodies[' . $index . ']', '$val');
+ push @source => $self->_generate_type_constraint_check(
+ $attr,
+ '$type_constraint_bodies[' . $index . ']',
+ '$type_constraints[' . $index . ']',
+ '$val'
+ );
}
push @source => $self->_generate_slot_assignment($attr, '$val');
push @source => "} else {";
}
-
my $default;
if ( $attr->has_default ) {
$default = $self->_generate_default_value($attr, $index);
my $builder = $attr->builder;
$default = '$instance->' . $builder;
}
+
+ push @source => '{'; # wrap this to avoid my $val overrite warnings
push @source => ('my $val = ' . $default . ';');
push @source => $self->_generate_type_constraint_check(
$attr,
('$type_constraint_bodies[' . $index . ']'),
+ ('$type_constraints[' . $index . ']'),
'$val'
) if ($is_moose && $attr->has_type_constraint);
push @source => $self->_generate_slot_assignment($attr, $default);
+ push @source => '}'; # close - wrap this to avoid my $val overrite warnings
push @source => "}" if defined $attr->init_arg;
}
push @source => ('my $val = $params{\'' . $init_arg . '\'};');
if ($is_moose && $attr->has_type_constraint) {
if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
- push @source => $self->_generate_type_coercion($attr, '$type_constraints[' . $index . ']', '$val', '$val');
+ push @source => $self->_generate_type_coercion(
+ $attr,
+ '$type_constraints[' . $index . ']',
+ '$val',
+ '$val'
+ );
}
- push @source => $self->_generate_type_constraint_check($attr, '$type_constraint_bodies[' . $index . ']', '$val');
+ push @source => $self->_generate_type_constraint_check(
+ $attr,
+ '$type_constraint_bodies[' . $index . ']',
+ '$type_constraints[' . $index . ']',
+ '$val'
+ );
}
push @source => $self->_generate_slot_assignment($attr, '$val');
}
sub _generate_type_constraint_check {
- my ($self, $attr, $type_constraint_cv, $value_name) = @_;
+ my ($self, $attr, $type_constraint_cv, $type_constraint_obj, $value_name) = @_;
return (
$type_constraint_cv . '->(' . $value_name . ')'
- . "\n\t" . '|| confess "Attribute (' . $attr->name . ') does not pass the type constraint ('
- . $attr->type_constraint->name
- . ') with " . (defined(' . $value_name . ') ? overload::StrVal(' . $value_name . ') : "undef");'
+ . "\n\t" . '|| confess "Attribute ('
+ . $attr->name
+ . ') does not pass the type constraint because: " . '
+ . $type_constraint_obj . '->get_message(' . $value_name . ');'
);
}
return undef;
}
else {
- if ($self->has_message) {
- local $_ = $value;
- return $self->message->($value);
- }
- else {
- return "Validation failed for '" . $self->name . "' failed";
- }
+ $self->get_message($value);
}
}
+sub get_message {
+ my ($self, $value) = @_;
+ $value = (defined $value ? overload::StrVal($value) : 'undef');
+ if (my $msg = $self->message) {
+ local $_ = $value;
+ return $msg->($value);
+ }
+ else {
+ return "Validation failed for '" . $self->name . "' failed with value $value";
+ }
+}
+
## type predicates ...
sub is_a_type_of {
=item B<message>
+=item B<get_message ($value)>
+
=item B<has_coercion>
=item B<coercion>
lives_ok { $foo->type_constrained(10.5) } "Num type constraint for now..";
# try to rebless, except it will fail due to Child's stricter type constraint
-throws_ok { Child->meta->rebless_instance($foo) } qr/^Attribute \(type_constrained\) does not pass the type constraint \(Int\) with '10\.5'/;
-throws_ok { Child->meta->rebless_instance($bar) } qr/^Attribute \(type_constrained\) does not pass the type constraint \(Int\) with '5\.5'/;
+throws_ok { Child->meta->rebless_instance($foo) }
+qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' failed with value 10\.5/,
+'... this failed cause of type check';
+throws_ok { Child->meta->rebless_instance($bar) }
+qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' failed with value 5\.5/,
+'... this failed cause of type check';;
$foo->type_constrained(10);
$bar->type_constrained(5);
is($foo->lazy_classname, 'Parent', "lazy attribute was already initialized");
is($bar->lazy_classname, 'Child', "lazy attribute just now initialized");
-throws_ok { $foo->type_constrained(10.5) } qr/^Attribute \(type_constrained\) does not pass the type constraint \(Int\) with 10\.5 /;
+throws_ok { $foo->type_constrained(10.5) }
+qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' failed with value 10\.5/,
+'... this failed cause of type check';
throws_ok {
$moose_obj->a_str( $moose_obj )
- } qr/Attribute \(a_str\) does not pass the type constraint \(Str\) with OverloadedStr\=HASH\(.*?\)/, '... dies without overloading the string';
+ } qr/Attribute \(a_str\) does not pass the type constraint because\: Validation failed for 'Str' failed with value OverloadedStr=HASH\(0x.......\)/,
+ '... dies without overloading the string';
}
throws_ok {
OverloadBreaker->new;
- } qr/Attribute \(a_num\) does not pass the type constraint \(Int\) with \'7\.5\'/, '... this doesnt trip overload to break anymore ';
+ } qr/Attribute \(a_num\) does not pass the type constraint because\: Validation failed for 'Int' failed with value 7\.5/,
+ '... this doesnt trip overload to break anymore ';
lives_ok {
OverloadBreaker->new(a_num => 5);
ok(!defined($natural->validate(5)), '... validated successfully (no error)');
is($natural->validate(-5),
- "Validation failed for 'Natural' failed",
+ "Validation failed for 'Natural' failed with value -5",
'... validated unsuccessfully (got error)');
my $string = find_type_constraint('String');
ok(!defined($HashOrArray->validate([])), '... (ArrayRef | HashRef) can accept []');
ok(!defined($HashOrArray->validate({})), '... (ArrayRef | HashRef) can accept {}');
-is($HashOrArray->validate(\(my $var2)), 'Validation failed for \'ArrayRef\' failed and Validation failed for \'HashRef\' failed in (ArrayRef | HashRef)', '... (ArrayRef | HashRef) cannot accept scalar refs');
-is($HashOrArray->validate(sub {}), 'Validation failed for \'ArrayRef\' failed and Validation failed for \'HashRef\' failed in (ArrayRef | HashRef)', '... (ArrayRef | HashRef) cannot accept code refs');
-is($HashOrArray->validate(50), 'Validation failed for \'ArrayRef\' failed and Validation failed for \'HashRef\' failed in (ArrayRef | HashRef)', '... (ArrayRef | HashRef) cannot accept Numbers');
+like($HashOrArray->validate(\(my $var2)),
+qr/Validation failed for \'ArrayRef\' failed with value SCALAR\(0x.......\) and Validation failed for \'HashRef\' failed with value SCALAR\(0x.......\) in \(ArrayRef \| HashRef\)/,
+'... (ArrayRef | HashRef) cannot accept scalar refs');
+
+like($HashOrArray->validate(sub {}),
+qr/Validation failed for \'ArrayRef\' failed with value CODE\(0x.......\) and Validation failed for \'HashRef\' failed with value CODE\(0x.......\) in \(ArrayRef \| HashRef\)/,
+'... (ArrayRef | HashRef) cannot accept code refs');
+
+is($HashOrArray->validate(50),
+'Validation failed for \'ArrayRef\' failed with value 50 and Validation failed for \'HashRef\' failed with value 50 in (ArrayRef | HashRef)',
+'... (ArrayRef | HashRef) cannot accept Numbers');
);
}
-lives_ok { my $goat = Animal->new(leg_count => 4) };
-lives_ok { my $spider = Animal->new(leg_count => 8) };
+lives_ok { my $goat = Animal->new(leg_count => 4) } '... no errors thrown, value is good';
+lives_ok { my $spider = Animal->new(leg_count => 8) } '... no errors thrown, value is good';
throws_ok { my $fern = Animal->new(leg_count => 0) }
- qr/^This number \(0\) is not a positive integer!/,
+ qr/This number \(0\) is not less than ten!/,
"gave custom supertype error message on new";
throws_ok { my $centipede = Animal->new(leg_count => 30) }
- qr/^This number \(30\) is not less than ten!/,
+ qr/This number \(30\) is not less than ten!/,
"gave custom subtype error message on new";
my $chimera;
-lives_ok { $chimera = Animal->new(leg_count => 4) };
+lives_ok { $chimera = Animal->new(leg_count => 4) } '... no errors thrown, value is good';
# first we remove the lion's legs..
throws_ok { $chimera->leg_count(0) }
- qr/^This number \(0\) is not a positive integer!/,
+ qr/This number \(0\) is not less than ten!/,
"gave custom supertype error message on set_value";
# mix in a few octopodes
throws_ok { $chimera->leg_count(16) }
- qr/^This number \(16\) is not less than ten!/,
+ qr/This number \(16\) is not less than ten!/,
"gave custom subtype error message on set_value";
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose');
+}
+
+BEGIN {
+ package MyFramework::Base;
+ use Moose;
+
+ package MyFramework::Meta::Base;
+ use Moose;
+
+ extends 'Moose::Meta::Class';
+
+ package MyFramework;
+ use Moose;
+
+ sub import {
+ my $CALLER = caller();
+
+ strict->import;
+ warnings->import;
+
+ return if $CALLER eq 'main';
+ Moose::init_meta( $CALLER, 'MyFramework::Base', 'MyFramework::Meta::Base' );
+ Moose->import({ into => $CALLER });
+
+ return 1;
+ }
+}
+
+{
+ package MyClass;
+ BEGIN { MyFramework->import }
+
+ has 'foo' => (is => 'rw');
+}
+
+can_ok( 'MyClass', 'meta' );
+
+isa_ok(MyClass->meta, 'MyFramework::Meta::Base');
+isa_ok(MyClass->meta, 'Moose::Meta::Class');
+
+my $obj = MyClass->new(foo => 10);
+isa_ok($obj, 'MyClass');
+isa_ok($obj, 'MyFramework::Base');
+isa_ok($obj, 'Moose::Object');
+
+is($obj->foo, 10, '... got the right value');
+
+
+
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+BEGIN {
+ use_ok('Moose');
+}
+
+{ package Foo; }
+
+my $meta = Moose::init_meta('Foo');
+
+ok( Foo->isa('Moose::Object'), '... Foo isa Moose::Object');
+isa_ok( $meta, 'Moose::Meta::Class' );
+isa_ok( Foo->meta, 'Moose::Meta::Class' );
+
+is($meta, Foo->meta, '... our metas are the same');
extends 'Moose::Meta::Class';
- has 'meta_size' =>
- ( is => 'rw',
- isa => 'Int',
- );
+ has 'meta_size' => (
+ is => 'rw',
+ isa => 'Int',
+ );
}
-lives_ok { My::Meta->meta()->make_immutable() } 'can make a meta class immutable';
+lives_ok {
+ My::Meta->meta()->make_immutable(debug => 0)
+} '... can make a meta class immutable';
projects / gitmo/Moose.git / commitdiff