Fix many 0.40_07
gfx [Tue, 17 Nov 2009 09:24:39 +0000 (18:24 +0900)]
27 files changed:
Changes
lib/Mouse.pm
lib/Mouse/Exporter.pm
lib/Mouse/Meta/Attribute.pm
lib/Mouse/Meta/Class.pm
lib/Mouse/Meta/Method.pm
lib/Mouse/Meta/Method/Accessor.pm
lib/Mouse/Meta/Method/Constructor.pm
lib/Mouse/Meta/Method/Delegation.pm
lib/Mouse/Meta/Method/Destructor.pm
lib/Mouse/Meta/Module.pm
lib/Mouse/Meta/Role.pm
lib/Mouse/Meta/Role/Composite.pm
lib/Mouse/Meta/Role/Method.pm
lib/Mouse/Meta/TypeConstraint.pm
lib/Mouse/Object.pm
lib/Mouse/PurePerl.pm
lib/Mouse/Role.pm
lib/Mouse/Spec.pm
lib/Mouse/Util.pm
lib/Mouse/Util/TypeConstraints.pm
lib/Mouse/XS.pod
t/001_mouse/059-weak-with-default.t
t/050_metaclasses/017_use_base_of_moose.t
t/050_metaclasses/020_metaclass_parameterized_traits.t
t/050_metaclasses/failing/013_metaclass_traits.t [moved from t/050_metaclasses/013_metaclass_traits.t with 100% similarity]
t/050_metaclasses/failing/015_metarole.t [moved from t/050_metaclasses/015_metarole.t with 100% similarity]

diff --git a/Changes b/Changes
index 2156189..1df9f93 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,13 +1,20 @@
 Revision history for Mouse
 
-0.40_06
+0.40_07 Tue Nov 17 18:28:57 2009
+    * Mouse::Util::MetaRole
+        - Implemented, but there are many to be done (gfx)
+
+    * Mouse::Meta::Method::Accessor
+    * Mouse::Meta::Method::Constructor
+        - Fix a bug that default values are not weaken()ed (gfx)
+
+0.40_06 Mon Nov 16 17:21:10 2009
     * Shipped with Module::Install::XSUtil 0.17 (gfx)
     * Mouse::Object
         - BUILDALL and DMELISHALL are no longer called by the default ctr/dtr,
           because generated ctrs/dtrs have never call them anyway (gfx)
         - new and DESTROY are now in XS (gfx)
 
-
 0.40_05 Mon Nov  2 11:59:01 2009
     * Shipped with Module::Install::XSUtil 0.16 (gfx)
 
index 04be220..6aaae46 100644 (file)
@@ -3,7 +3,7 @@ use 5.006_002;
 
 use Mouse::Exporter; # enables strict and warnings
 
-our $VERSION = '0.40_06';
+our $VERSION = '0.40_07';
 
 use Carp         qw(confess);
 use Scalar::Util qw(blessed);
@@ -160,7 +160,7 @@ Mouse - Moose minus the antlers
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SYNOPSIS
 
index ce5757d..0b4468a 100644 (file)
@@ -262,7 +262,7 @@ Mouse::Exporter - make an import() and unimport() just like Mouse.pm
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SYNOPSIS
 
index c30a9ee..68cfaea 100644 (file)
@@ -205,7 +205,7 @@ sub canonicalize_args{ # DEPRECATED
 
     Carp::cluck("$self->canonicalize_args has been deprecated."
         . "Use \$self->_process_options instead.")
-            if _MOUSE_VERBOSE;
+            if Mouse::Util::_MOUSE_VERBOSE;
 
     return %args;
 }
@@ -215,7 +215,7 @@ sub create { # DEPRECATED
 
     Carp::cluck("$self->create has been deprecated."
         . "Use \$meta->add_attribute and \$attr->install_accessors instead.")
-            if _MOUSE_VERBOSE;
+            if Mouse::Util::_MOUSE_VERBOSE;
 
     # noop
     return $self;
@@ -284,7 +284,7 @@ sub clone_parent { # DEPRECATED
 
     Carp::cluck("$self->clone_parent has been deprecated."
         . "Use \$meta->add_attribute and \$attr->install_accessors instead.")
-        if _MOUSE_VERBOSE;
+        if Mouse::Util::_MOUSE_VERBOSE;
 
     $self->clone_and_inherited_args($class, $name, %args);
 }
@@ -435,7 +435,7 @@ Mouse::Meta::Attribute - The Mouse attribute metaclass
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 METHODS
 
index 195cd32..e8593f6 100644 (file)
@@ -140,7 +140,7 @@ sub add_attribute {
     $self->{attributes}{$attr->name} = $attr;
     $attr->install_accessors();
 
-    if(_MOUSE_VERBOSE && !$attr->{associated_methods} && ($attr->{is} || '') ne 'bare'){
+    if(Mouse::Util::_MOUSE_VERBOSE && !$attr->{associated_methods} && ($attr->{is} || '') ne 'bare'){
         Carp::cluck(qq{Attribute (}.$attr->name.qq{) of class }.$self->name.qq{ has no associated methods (did you mean to provide an "is" argument?)});
     }
     return $attr;
@@ -148,7 +148,7 @@ sub add_attribute {
 
 sub compute_all_applicable_attributes {
     Carp::cluck('compute_all_applicable_attributes() has been deprecated')
-        if _MOUSE_VERBOSE;
+        if Mouse::Util::_MOUSE_VERBOSE;
     return shift->get_all_attributes(@_)
 }
 
@@ -174,7 +174,7 @@ sub clone_instance {
     my ($class, $instance, %params) = @_;
 
     Carp::cluck('clone_instance has been deprecated. Use clone_object instead')
-        if _MOUSE_VERBOSE;
+        if Mouse::Util::_MOUSE_VERBOSE;
     return $class->clone_object($instance, %params);
 }
 
@@ -402,7 +402,7 @@ Mouse::Meta::Class - The Mouse class metaclass
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 METHODS
 
index 561051a..755cb68 100755 (executable)
@@ -39,7 +39,7 @@ Mouse::Meta::Method - A Mouse Method metaclass
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SEE ALSO
 
index 2f03b9d..68d51e3 100755 (executable)
@@ -25,7 +25,7 @@ sub _generate_accessor{
 
     $type ||= 'accessor';
 
-    my $accessor = sprintf(qq{#line 1 "%s for %s (%s)"\n}, $type, $name, __FILE__)
+    my $accessor = sprintf(qq{package %s;\n#line 1 "%s for %s (%s)"\n}, $class->name, $type, $name, __FILE__)
                  . "sub {\n";
 
     if ($type eq 'accessor' || $type eq 'writer') {
@@ -124,7 +124,7 @@ sub _generate_accessor{
 
     $accessor .= "return $slot;\n}\n";
 
-    #print "# class ", $class->name, "\n", $accessor, "\n";
+    #print $accessor, "\n";
     my $code;
     my $e = do{
         local $@;
@@ -175,7 +175,7 @@ Mouse::Meta::Method::Accessor - A Mouse method generator for accessors
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SEE ALSO
 
index 2e848a7..ec47edd 100644 (file)
@@ -60,6 +60,7 @@ sub _generate_processattrs {
 
         my $init_arg        = $attr->init_arg;
         my $type_constraint = $attr->type_constraint;
+        my $is_weak_ref     = $attr->is_weak_ref;
         my $need_coercion;
 
         my $instance_slot  = $method_class->_inline_slot('$instance', $key);
@@ -78,7 +79,7 @@ sub _generate_processattrs {
             $post_process .= "\$checks[$index]->($instance_slot)";
             $post_process .= "  or $attr_var->verify_type_constraint_error(q{$key}, $instance_slot, $constraint_var);\n";
         }
-        if($attr->is_weak_ref){
+        if($is_weak_ref){
             $post_process .= "Scalar::Util::weaken($instance_slot) if ref $instance_slot;\n";
         }
 
@@ -126,6 +127,9 @@ sub _generate_processattrs {
                 }
 
                 $code .= "$instance_slot = $value;\n";
+                if($is_weak_ref){
+                    $code .= "Scalar::Util::weaken($instance_slot);\n";
+                }
             }
         }
         elsif ($attr->is_required) {
@@ -193,7 +197,7 @@ Mouse::Meta::Method::Constructor - A Mouse method generator for constructors
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SEE ALSO
 
index 022cb98..4edfa80 100644 (file)
@@ -34,7 +34,7 @@ Mouse::Meta::Method::Delegation - A Mouse method generator for delegation method
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SEE ALSO
 
index f61e354..d11a8a6 100644 (file)
@@ -53,7 +53,7 @@ Mouse::Meta::Method::Destructor - A Mouse method generator for destructors
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SEE ALSO
 
index bc74808..793de9b 100755 (executable)
@@ -6,7 +6,8 @@ use Scalar::Util ();
 
 my %METAS;
 
-if(Mouse::Util::_MOUSE_XS){
+# XXX: work around a warning "useless use of a constant in void context" in 5.6.2
+if(&Mouse::Util::_MOUSE_XS()){
     # register meta storage for performance
     Mouse::Util::__register_metaclass_storage(\%METAS, 0);
 
@@ -310,7 +311,7 @@ Mouse::Meta::Module - The base class for Mouse::Meta::Class and Mouse::Meta::Rol
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SEE ALSO
 
index 620baf0..1dd7c3f 100644 (file)
@@ -330,7 +330,7 @@ Mouse::Meta::Role - The Mouse Role metaclass
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SEE ALSO
 
index 1eb91a7..66082b3 100644 (file)
@@ -120,7 +120,7 @@ Mouse::Meta::Role::Composite - An object to represent the set of roles
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SEE ALSO
 
index b476751..31b0a6e 100755 (executable)
@@ -20,7 +20,7 @@ Mouse::Meta::Role::Method - A Mouse Method metaclass for Roles
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SEE ALSO
 
index a29edfe..8c07a75 100644 (file)
@@ -26,7 +26,7 @@ sub new {
 
     if($args{_compiled_type_constraint}){
         Carp::cluck("'_compiled_type_constraint' has been deprecated, use 'optimized' instead")
-            if _MOUSE_VERBOSE;
+            if Mouse::Util::_MOUSE_VERBOSE;
 
         $check = $args{_compiled_type_constraint};
     }
@@ -210,7 +210,7 @@ Mouse::Meta::TypeConstraint - The Mouse Type Constraint metaclass
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 DESCRIPTION
 
index 6acd681..7f20548 100644 (file)
@@ -49,7 +49,7 @@ Mouse::Object - The base object for Mouse classes
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 METHODS
 
index ad1c624..17017dd 100644 (file)
@@ -492,7 +492,7 @@ Mouse::PurePerl - A Mouse guts in pure Perl
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SEE ALSO
 
index 635c936..e08fb53 100644 (file)
@@ -1,7 +1,7 @@
 package Mouse::Role;
 use Mouse::Exporter; # enables strict and warnings
 
-our $VERSION = '0.40_06';
+our $VERSION = '0.40_07';
 
 use Carp         qw(confess);
 use Scalar::Util qw(blessed);
@@ -143,7 +143,7 @@ Mouse::Role - The Mouse Role
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SYNOPSIS
 
index 30a49ae..27ef726 100644 (file)
@@ -2,7 +2,7 @@ package Mouse::Spec;
 use strict;
 use warnings;
 
-our $VERSION = '0.40_06';
+our $VERSION = '0.40_07';
 
 our $MouseVersion = $VERSION;
 our $MooseVersion = '0.90';
@@ -19,7 +19,7 @@ Mouse::Spec - To what extent Mouse is compatible with Moose
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 SYNOPSIS
 
index b99cd8f..a226e1e 100644 (file)
@@ -4,10 +4,41 @@ use Mouse::Exporter; # enables strict and warnings
 sub get_linear_isa($;$); # must be here
 
 BEGIN{
+    # This is used in Mouse::PurePerl
+    Mouse::Exporter->setup_import_methods(
+        as_is => [qw(
+            find_meta
+            does_role
+            resolve_metaclass_alias
+            apply_all_roles
+            english_list
+
+            load_class
+            is_class_loaded
+
+            get_linear_isa
+            get_code_info
+
+            get_code_package
+            get_code_ref
+
+            not_supported
+
+            does meta dump
+        )],
+        groups => {
+            default => [], # export no functions by default
+
+            # The ':meta' group is 'use metaclass' for Mouse
+            meta    => [qw(does meta dump)],
+        },
+    );
+
+
     # Because Mouse::Util is loaded first in all the Mouse sub-modules,
     # XS loader is placed here, not in Mouse.pm.
 
-    our $VERSION = '0.40_06';
+    our $VERSION = '0.40_07';
 
     my $xs = !(exists $INC{'Mouse/PurePerl.pm'} || $ENV{MOUSE_PUREPERL});
 
@@ -38,36 +69,6 @@ use Scalar::Util ();
 
 use constant _MOUSE_VERBOSE => !!$ENV{MOUSE_VERBOSE};
 
-Mouse::Exporter->setup_import_methods(
-    as_is => [qw(
-        find_meta
-        does_role
-        resolve_metaclass_alias
-        apply_all_roles
-        english_list
-
-        load_class
-        is_class_loaded
-
-        get_linear_isa
-        get_code_info
-
-        get_code_package
-        get_code_ref
-
-        not_supported
-
-        does meta dump
-        _MOUSE_VERBOSE
-    )],
-    groups => {
-        default => [], # export no functions by default
-
-        # The ':meta' group is 'use metaclass' for Mouse
-        meta    => [qw(does meta dump _MOUSE_VERBOSE)],
-    },
-);
-
 # aliases as public APIs
 # it must be 'require', not 'use', because Mouse::Meta::Module depends on Mouse::Util
 require Mouse::Meta::Module; # for the entities of metaclass cache utilities
@@ -336,7 +337,7 @@ Mouse::Util - Features, with or without their dependencies
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 IMPLEMENTATIONS FOR
 
index b47a93b..c198818 100644 (file)
@@ -351,7 +351,7 @@ Mouse::Util::TypeConstraints - Type constraint system for Mouse
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head2 SYNOPSIS
 
index f09fbd1..b4b5ded 100644 (file)
@@ -5,7 +5,7 @@ Mouse::XS - A Mouse guts in XS
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_06
+This document describes Mouse version 0.40_07
 
 =head1 DESCRIPTION
 
index 5a5a46d..2710d7d 100644 (file)
@@ -1,7 +1,7 @@
 #!perl
 use strict;
 use warnings;
-use Test::More tests => 4;
+use Test::More tests => 6;
 
 {
     package MyClass;
@@ -27,9 +27,11 @@ use Test::More tests => 4;
 my $o = MyClass->new();
 is($o->weak_with_default, undef);
 is($o->lazy_weak_with_default, undef);
+is($o->lazy_weak_with_default, undef);
 
 MyClass->meta->make_immutable();
 
 $o = MyClass->new();
 is($o->weak_with_default, undef);
 is($o->lazy_weak_with_default, undef);
+is($o->lazy_weak_with_default, undef);
index 2b68fd3..9076fa8 100644 (file)
@@ -2,6 +2,13 @@
 
 use strict;
 use warnings;
+use Test::More;
+
+BEGIN{
+    if($] < 5.008){
+        plan skip_all => "segv happens on 5.6.2";
+    }
+}
 
 use Test::More tests => 4;
 use Test::Exception;
@@ -9,11 +16,13 @@ use Test::Exception;
 {
     package NoOpTrait;
     use Mouse::Role;
+
+
 }
 
 {
     package Parent;
-    use Mouse -traits => 'NoOpTrait';
+    use Mouse "-traits" => 'NoOpTrait';
 
     has attr => (
         is  => 'rw',
@@ -25,12 +34,11 @@ use Test::Exception;
     package Child;
     use base 'Parent';
 }
-
 is(Child->meta->name, 'Child', "correct metaclass name");
-
 my $child = Child->new(attr => "ibute");
 ok($child, "constructor works");
 
+
 is($child->attr, "ibute", "getter inherited properly");
 
 $child->attr("ition");
index 416526b..5d27522 100644 (file)
@@ -1,6 +1,15 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
+
+use Test::More;
+
+BEGIN{
+    if($] < 5.008){
+        plan skip_all => "segv happens on 5.6.2";
+    }
+}
+
 use Test::More tests => 5;
 
 {