r60121 - in /branches/upstream/libmouse-perl/current: ./ inc/Module/ inc/Module/Install/ lib/ lib/Mouse/ lib/Mouse/Meta/ lib/Mouse/Meta/Method/ lib/Mouse/Meta/Role/ lib/Mouse/Util/ t/001_mouse/ xs-src/
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Wed Jul 7 11:32:34 UTC 2010
Author: ansgar-guest
Date: Wed Jul 7 11:32:15 2010
New Revision: 60121
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=60121
Log:
[svn-upgrade] new version libmouse-perl (0.62)
Modified:
branches/upstream/libmouse-perl/current/Changes
branches/upstream/libmouse-perl/current/META.yml
branches/upstream/libmouse-perl/current/inc/Module/Install.pm
branches/upstream/libmouse-perl/current/inc/Module/Install/Base.pm
branches/upstream/libmouse-perl/current/inc/Module/Install/Can.pm
branches/upstream/libmouse-perl/current/inc/Module/Install/Makefile.pm
branches/upstream/libmouse-perl/current/inc/Module/Install/Metadata.pm
branches/upstream/libmouse-perl/current/inc/Module/Install/With.pm
branches/upstream/libmouse-perl/current/inc/Module/Install/WriteAll.pm
branches/upstream/libmouse-perl/current/lib/Mouse.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Exporter.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Class.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Accessor.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Delegation.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Destructor.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Composite.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Method.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/TypeConstraint.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Object.pm
branches/upstream/libmouse-perl/current/lib/Mouse/PurePerl.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pod
branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Util/TypeConstraints.pm
branches/upstream/libmouse-perl/current/lib/Mouse/XS.pod
branches/upstream/libmouse-perl/current/mouse.h
branches/upstream/libmouse-perl/current/t/001_mouse/060-threads.t
branches/upstream/libmouse-perl/current/t/001_mouse/068-strict-constructor.t
branches/upstream/libmouse-perl/current/xs-src/Mouse.xs
branches/upstream/libmouse-perl/current/xs-src/MouseTypeConstraints.xs
Modified: branches/upstream/libmouse-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/Changes?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/Changes (original)
+++ branches/upstream/libmouse-perl/current/Changes Wed Jul 7 11:32:15 2010
@@ -1,4 +1,8 @@
Revision history for Mouse
+
+0.62 Tue Jul 6 20:18:58 2010
+ [FEATURES]
+ * Support MouseX::StrictConstructor (gfx)
0.61 Sat Jun 19 15:35:48 2010
[BUG FIXES]
@@ -61,7 +65,7 @@
[BUG FIXES]
* Mouse::Object::DESTROY could cause SEGVs
* Attribute triggers could cause panics
- * Integers > 2**32 ware not groked as Int
+ * Integers > 2**32 were not groked as Int
* Incorrect types, e.g. "Array[Int", was accepted
* Metaclass compatibility was sometimes ignored
Modified: branches/upstream/libmouse-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/META.yml?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/META.yml (original)
+++ branches/upstream/libmouse-perl/current/META.yml Wed Jul 7 11:32:15 2010
@@ -13,7 +13,7 @@
Devel::PPPort: 3.19
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.99'
+generated_by: 'Module::Install version 1.00'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -32,4 +32,4 @@
resources:
license: http://dev.perl.org/licenses/
repository: git://git.moose.perl.org/Mouse.git
-version: 0.61
+version: 0.62
Modified: branches/upstream/libmouse-perl/current/inc/Module/Install.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/inc/Module/Install.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/inc/Module/Install.pm (original)
+++ branches/upstream/libmouse-perl/current/inc/Module/Install.pm Wed Jul 7 11:32:15 2010
@@ -31,7 +31,7 @@
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.99';
+ $VERSION = '1.00';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -230,8 +230,12 @@
sub new {
my ($class, %args) = @_;
- delete $INC{'FindBin.pm'};
- require FindBin;
+ delete $INC{'FindBin.pm'};
+ {
+ # to suppress the redefine warning
+ local $SIG{__WARN__} = sub {};
+ require FindBin;
+ }
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
Modified: branches/upstream/libmouse-perl/current/inc/Module/Install/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/inc/Module/Install/Base.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/inc/Module/Install/Base.pm (original)
+++ branches/upstream/libmouse-perl/current/inc/Module/Install/Base.pm Wed Jul 7 11:32:15 2010
@@ -4,7 +4,7 @@
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.99';
+ $VERSION = '1.00';
}
# Suspend handler for "redefined" warnings
Modified: branches/upstream/libmouse-perl/current/inc/Module/Install/Can.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/inc/Module/Install/Can.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/inc/Module/Install/Can.pm (original)
+++ branches/upstream/libmouse-perl/current/inc/Module/Install/Can.pm Wed Jul 7 11:32:15 2010
@@ -9,7 +9,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.99';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libmouse-perl/current/inc/Module/Install/Makefile.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/inc/Module/Install/Makefile.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/inc/Module/Install/Makefile.pm (original)
+++ branches/upstream/libmouse-perl/current/inc/Module/Install/Makefile.pm Wed Jul 7 11:32:15 2010
@@ -8,7 +8,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.99';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libmouse-perl/current/inc/Module/Install/Metadata.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/inc/Module/Install/Metadata.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/inc/Module/Install/Metadata.pm (original)
+++ branches/upstream/libmouse-perl/current/inc/Module/Install/Metadata.pm Wed Jul 7 11:32:15 2010
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.99';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libmouse-perl/current/inc/Module/Install/With.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/inc/Module/Install/With.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/inc/Module/Install/With.pm (original)
+++ branches/upstream/libmouse-perl/current/inc/Module/Install/With.pm Wed Jul 7 11:32:15 2010
@@ -8,7 +8,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.99';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libmouse-perl/current/inc/Module/Install/WriteAll.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/inc/Module/Install/WriteAll.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/inc/Module/Install/WriteAll.pm (original)
+++ branches/upstream/libmouse-perl/current/inc/Module/Install/WriteAll.pm Wed Jul 7 11:32:15 2010
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.99';
+ $VERSION = '1.00';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
Modified: branches/upstream/libmouse-perl/current/lib/Mouse.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse.pm Wed Jul 7 11:32:15 2010
@@ -3,7 +3,7 @@
use Mouse::Exporter; # enables strict and warnings
-our $VERSION = '0.61';
+our $VERSION = '0.62';
use Carp qw(confess);
use Scalar::Util qw(blessed);
@@ -160,7 +160,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SYNOPSIS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Exporter.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Exporter.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Exporter.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Exporter.pm Wed Jul 7 11:32:15 2010
@@ -272,7 +272,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SYNOPSIS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm Wed Jul 7 11:32:15 2010
@@ -401,7 +401,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 METHODS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Class.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Class.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Class.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Class.pm Wed Jul 7 11:32:15 2010
@@ -257,8 +257,6 @@
my %args = $self->immutable_options(@_);
$self->{is_immutable}++;
-
- $self->{strict_constructor} = $args{strict_constructor};
if ($args{inline_constructor}) {
$self->add_method($args{constructor_name} =>
@@ -488,7 +486,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 METHODS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method.pm Wed Jul 7 11:32:15 2010
@@ -54,7 +54,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Accessor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Accessor.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Accessor.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Accessor.pm Wed Jul 7 11:32:15 2010
@@ -182,7 +182,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm Wed Jul 7 11:32:15 2010
@@ -51,7 +51,7 @@
my @res;
my $has_triggers;
- my $strict = $metaclass->__strict_constructor;
+ my $strict = $metaclass->strict_constructor;
if($strict){
push @res, 'my $used = 0;';
@@ -152,7 +152,7 @@
if($strict){
push @res, q{if($used < keys %{$args})}
- . sprintf q{{ %s->_report_unknown_args($metaclass, \@attrs, $args) }}, $method_class;
+ . q{{ $metaclass->_report_unknown_args(\@attrs, $args) }};
}
if($metaclass->is_anon_class){
@@ -202,30 +202,6 @@
return join "\n", @code;
}
-sub _report_unknown_args {
- my(undef, $metaclass, $attrs, $args) = @_;
-
- my @unknowns;
- my %init_args;
- foreach my $attr(@{$attrs}){
- my $init_arg = $attr->init_arg;
- if(defined $init_arg){
- $init_args{$init_arg}++;
- }
- }
-
- while(my $key = each %{$args}){
- if(!exists $init_args{$key}){
- push @unknowns, $key;
- }
- }
-
- $metaclass->throw_error( sprintf
- "Unknown attribute passed to the constructor of %s: %s",
- $metaclass->name, Mouse::Util::english_list(@unknowns),
- );
-}
-
1;
__END__
@@ -235,7 +211,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Delegation.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Delegation.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Delegation.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Delegation.pm Wed Jul 7 11:32:15 2010
@@ -61,7 +61,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Destructor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Destructor.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Destructor.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Destructor.pm Wed Jul 7 11:32:15 2010
@@ -55,7 +55,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm Wed Jul 7 11:32:15 2010
@@ -329,7 +329,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm Wed Jul 7 11:32:15 2010
@@ -312,7 +312,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Composite.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Composite.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Composite.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Composite.pm Wed Jul 7 11:32:15 2010
@@ -125,7 +125,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Method.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Method.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Method.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role/Method.pm Wed Jul 7 11:32:15 2010
@@ -23,7 +23,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/TypeConstraint.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/TypeConstraint.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/TypeConstraint.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/TypeConstraint.pm Wed Jul 7 11:32:15 2010
@@ -236,7 +236,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 DESCRIPTION
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Object.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Object.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Object.pm Wed Jul 7 11:32:15 2010
@@ -17,7 +17,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 METHODS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/PurePerl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/PurePerl.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/PurePerl.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/PurePerl.pm Wed Jul 7 11:32:15 2010
@@ -307,6 +307,8 @@
my @triggers_queue;
+ my $used = 0;
+
foreach my $attribute ($self->get_all_attributes) {
my $init_arg = $attribute->init_arg;
my $slot = $attribute->name;
@@ -320,6 +322,7 @@
if ($attribute->has_trigger) {
push @triggers_queue, [ $attribute->trigger, $object->{$slot} ];
}
+ $used++;
}
else { # no init arg
if ($attribute->has_default || $attribute->has_builder) {
@@ -342,6 +345,10 @@
}
}
+ if($used < keys %{$args} && $self->strict_constructor) {
+ $self->_report_unknown_args([ $self->get_all_attributes ], $args);
+ }
+
if(@triggers_queue){
foreach my $trigger_and_value(@triggers_queue){
my($trigger, $value) = @{$trigger_and_value};
@@ -358,7 +365,47 @@
sub is_immutable { $_[0]->{is_immutable} }
-sub __strict_constructor{ $_[0]->{strict_constructor} }
+sub strict_constructor{
+ my $self = shift;
+ if(@_) {
+ $self->{strict_constructor} = shift;
+ }
+
+ foreach my $class($self->linearized_isa) {
+ my $meta = Mouse::Util::get_metaclass_by_name($class)
+ or next;
+
+ if(exists $meta->{strict_constructor}) {
+ return $meta->{strict_constructor};
+ }
+ }
+
+ return 0; # false
+}
+
+sub _report_unknown_args {
+ my($metaclass, $attrs, $args) = @_;
+
+ my @unknowns;
+ my %init_args;
+ foreach my $attr(@{$attrs}){
+ my $init_arg = $attr->init_arg;
+ if(defined $init_arg){
+ $init_args{$init_arg}++;
+ }
+ }
+
+ while(my $key = each %{$args}){
+ if(!exists $init_args{$key}){
+ push @unknowns, $key;
+ }
+ }
+
+ $metaclass->throw_error( sprintf
+ "Unknown attribute passed to the constructor of %s: %s",
+ $metaclass->name, Mouse::Util::english_list(@unknowns),
+ );
+}
package Mouse::Meta::Role;
@@ -731,7 +778,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SEE ALSO
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm Wed Jul 7 11:32:15 2010
@@ -1,7 +1,7 @@
package Mouse::Role;
use Mouse::Exporter; # enables strict and warnings
-our $VERSION = '0.61';
+our $VERSION = '0.62';
use Carp qw(confess);
use Scalar::Util qw(blessed);
@@ -145,7 +145,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SYNOPSIS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm Wed Jul 7 11:32:15 2010
@@ -2,7 +2,7 @@
use strict;
use warnings;
-our $VERSION = '0.61';
+our $VERSION = '0.62';
our $MouseVersion = $VERSION;
our $MooseVersion = '1.05';
@@ -19,7 +19,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 SYNOPSIS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pod?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pod (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pod Wed Jul 7 11:32:15 2010
@@ -5,7 +5,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 DESCRIPTION
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm Wed Jul 7 11:32:15 2010
@@ -52,7 +52,7 @@
# Because Mouse::Util is loaded first in all the Mouse sub-modules,
# XS loader is placed here, not in Mouse.pm.
- our $VERSION = '0.61';
+ our $VERSION = '0.62';
my $xs = !(exists $INC{'Mouse/PurePerl.pm'} || $ENV{MOUSE_PUREPERL});
@@ -365,7 +365,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 IMPLEMENTATIONS FOR
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Util/TypeConstraints.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Util/TypeConstraints.pm?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Util/TypeConstraints.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Util/TypeConstraints.pm Wed Jul 7 11:32:15 2010
@@ -406,7 +406,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head2 SYNOPSIS
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/XS.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/XS.pod?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/XS.pod (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/XS.pod Wed Jul 7 11:32:15 2010
@@ -5,7 +5,7 @@
=head1 VERSION
-This document describes Mouse version 0.61
+This document describes Mouse version 0.62
=head1 DESCRIPTION
Modified: branches/upstream/libmouse-perl/current/mouse.h
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/mouse.h?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/mouse.h (original)
+++ branches/upstream/libmouse-perl/current/mouse.h Wed Jul 7 11:32:15 2010
@@ -29,6 +29,7 @@
#define no_mro_get_linear_isa
#define mro_get_linear_isa(stash) mouse_mro_get_linear_isa(aTHX_ stash)
AV* mouse_mro_get_linear_isa(pTHX_ HV* const stash);
+#define mro_method_changed_in(stash) ((void)++PL_sub_generation)
#endif /* !mro_get_linear_isa */
#ifndef mro_get_pkg_gen
@@ -181,7 +182,6 @@
CV* mouse_simple_accessor_generate(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSUBADDR_t const accessor_impl, void* const dptr, I32 const dlen);
-XS(XS_Mouse_simple_accessor);
XS(XS_Mouse_simple_reader);
XS(XS_Mouse_simple_writer);
XS(XS_Mouse_simple_clearer);
Modified: branches/upstream/libmouse-perl/current/t/001_mouse/060-threads.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/t/001_mouse/060-threads.t?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/t/001_mouse/060-threads.t (original)
+++ branches/upstream/libmouse-perl/current/t/001_mouse/060-threads.t Wed Jul 7 11:32:15 2010
@@ -1,7 +1,7 @@
#!perl
use strict;
use warnings;
-use constant HAS_THREADS => eval{ require threads };
+use constant HAS_THREADS => eval{ require threads && require threads::shared };
use if !HAS_THREADS, 'Test::More', (skip_all => "This is a test for threads ($@)");
use Test::More;
Modified: branches/upstream/libmouse-perl/current/t/001_mouse/068-strict-constructor.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/t/001_mouse/068-strict-constructor.t?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/t/001_mouse/068-strict-constructor.t (original)
+++ branches/upstream/libmouse-perl/current/t/001_mouse/068-strict-constructor.t Wed Jul 7 11:32:15 2010
@@ -5,6 +5,7 @@
use if 'Mouse' eq 'Moose',
'Test::More' => skip_all => 'Moose does nots support strict constructor';
use Test::More;
+use Test::Mouse;
use Test::Exception;
{
@@ -25,41 +26,50 @@
default => 42,
);
- __PACKAGE__->meta->make_immutable(strict_constructor => 1);
+ __PACKAGE__->meta->strict_constructor(1);
+}
+{
+ package MySubClass;
+ use Mouse;
+ extends 'MyClass';
}
-lives_and {
- my $o = MyClass->new(foo => 1);
- isa_ok($o, 'MyClass');
- is $o->baz, 42;
-} 'correc use of the constructor';
+with_immutable sub {
+ lives_and {
+ my $o = MyClass->new(foo => 1);
+ isa_ok($o, 'MyClass');
+ is $o->baz, 42;
+ } 'correc use of the constructor';
-lives_and {
- my $o = MyClass->new(foo => 1, baz => 10);
- isa_ok($o, 'MyClass');
- is $o->baz, 10;
-} 'correc use of the constructor';
+ lives_and {
+ my $o = MyClass->new(foo => 1, baz => 10);
+ isa_ok($o, 'MyClass');
+ is $o->baz, 10;
+ } 'correc use of the constructor';
-throws_ok {
- MyClass->new(foo => 1, hoge => 42);
-} qr/\b hoge \b/xms;
+ throws_ok {
+ MyClass->new(foo => 1, hoge => 42);
+ } qr/\b hoge \b/xms;
-throws_ok {
- MyClass->new(foo => 1, bar => 42);
-} qr/\b bar \b/xms, "init_arg => undef";
+ throws_ok {
+ MyClass->new(foo => 1, bar => 42);
+ } qr/\b bar \b/xms, "init_arg => undef";
-throws_ok {
- MyClass->new(aaa => 1, bbb => 2, ccc => 3);
-} qr/\b aaa \b/xms, $@;
+ eval {
+ MyClass->new(aaa => 1, bbb => 2, ccc => 3);
+ };
+ like $@, qr/\b aaa \b/xms;
+ like $@, qr/\b bbb \b/xms;
+ like $@, qr/\b ccc \b/xms;
-throws_ok {
- MyClass->new(aaa => 1, bbb => 2, ccc => 3);
-} qr/\b bbb \b/xms, $@;
-
-throws_ok {
- MyClass->new(aaa => 1, bbb => 2, ccc => 3);
-} qr/\b ccc \b/xms, $@;
+ eval {
+ MySubClass->new(aaa => 1, bbb => 2, ccc => 3);
+ };
+ like $@, qr/\b aaa \b/xms;
+ like $@, qr/\b bbb \b/xms;
+ like $@, qr/\b ccc \b/xms;
+}, qw(MyClass MySubClass);
done_testing;
Modified: branches/upstream/libmouse-perl/current/xs-src/Mouse.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/xs-src/Mouse.xs?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/xs-src/Mouse.xs (original)
+++ branches/upstream/libmouse-perl/current/xs-src/Mouse.xs Wed Jul 7 11:32:15 2010
@@ -123,7 +123,7 @@
flags |= MOUSEf_XC_HAS_BUILDARGS;
}
- if(predicate_calls(metaclass, "__strict_constructor")){
+ if(predicate_calls(metaclass, "strict_constructor")){
flags |= MOUSEf_XC_CONSTRUCTOR_IS_STRICT;
}
@@ -297,7 +297,7 @@
I32 const len = AvFILLp(attrs) + 1;
I32 i;
AV* triggers_queue = NULL;
- I32 used = 0;
+ U32 used = 0;
assert(meta || object);
assert(args);
@@ -524,7 +524,6 @@
INSTALL_SIMPLE_READER(Class, roles);
INSTALL_SIMPLE_PREDICATE_WITH_KEY(Class, is_anon_class, anon_serial_id);
INSTALL_SIMPLE_READER(Class, is_immutable);
- INSTALL_SIMPLE_READER_WITH_KEY(Class, __strict_constructor, strict_constructor);
INSTALL_CLASS_HOLDER(Class, method_metaclass, "Mouse::Meta::Method");
INSTALL_CLASS_HOLDER(Class, attribute_metaclass, "Mouse::Meta::Attribute");
@@ -535,7 +534,6 @@
newRV_inc((SV*)get_cvs("Mouse::Object::new", TRUE)));
newCONSTSUB(gv_stashpvs("Mouse::Meta::Method::Destructor::XS", TRUE), "_generate_destructor",
newRV_inc((SV*)get_cvs("Mouse::Object::DESTROY", TRUE)));
-
void
linearized_isa(SV* self)
@@ -611,6 +609,45 @@
CODE:
{
mouse_class_initialize_object(aTHX_ meta, object, args, is_cloning);
+}
+
+void
+strict_constructor(SV* self, SV* value = NULL)
+CODE:
+{
+ SV* const slot = sv_2mortal(newSVpvs_share("strict_constructor"));
+ SV* const stash_ref = mcall0(self, mouse_namespace);
+ HV* stash;
+
+ if(!(SvROK(stash_ref) && SvTYPE(SvRV(stash_ref)) == SVt_PVHV)) {
+ croak("namespace() didn't return a HASH reference");
+ }
+ stash = (HV*)SvRV(stash_ref);
+
+ if(value) { /* setter */
+ set_slot(self, slot, value);
+ mro_method_changed_in(stash);
+ }
+
+ value = get_slot(self, slot);
+
+ if(!value) {
+ AV* const isa = mro_get_linear_isa(stash);
+ I32 const len = av_len(isa) + 1;
+ I32 i;
+ for(i = 1; i < len; i++) {
+ SV* const klass = MOUSE_av_at(isa, i);
+ SV* const meta = get_metaclass(klass);
+ if(!SvOK(meta)){
+ continue; /* skip non-Mouse classes */
+ }
+ value = get_slot(meta, slot);
+ if(value) {
+ break;
+ }
+ }
+ }
+ ST(0) = value ? value : &PL_sv_no;
}
MODULE = Mouse PACKAGE = Mouse::Meta::Role
Modified: branches/upstream/libmouse-perl/current/xs-src/MouseTypeConstraints.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/xs-src/MouseTypeConstraints.xs?rev=60121&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/xs-src/MouseTypeConstraints.xs (original)
+++ branches/upstream/libmouse-perl/current/xs-src/MouseTypeConstraints.xs Wed Jul 7 11:32:15 2010
@@ -7,7 +7,7 @@
#if PERL_BCDVERSION >= 0x5008005
#define LooksLikeNumber(sv) looks_like_number(sv)
#else
-#define LooksLikeNumber(sv) ( SvPOKp(sv) ? looks_like_number(sv) : SvNIOKp(sv) )
+#define LooksLikeNumber(sv) ( SvPOKp(sv) ? looks_like_number(sv) : (I32)SvNIOKp(sv) )
#endif
#ifndef SvRXOK
More information about the Pkg-perl-cvs-commits
mailing list