eilaras bug fixed and tested

diff --git a/Changes b/Changes
index 74e58d7..d2726f2 100644 (file)
--- a/Changes
+++ b/Changes
@@ -13,6 +13,12 @@ Revision history for Perl extension Moose
            
        * t/
          - complete re-organization of the test suite
+         - added some new tests as well 
+
+    * Moose::Meta::Class
+      - fixed very odd and very nasty recursion bug with 
+        inner/augment (mst)
+        - added tests for this (eilara)
 
     * Moose::Util::TypeConstraint
       - no longer uses package variable to keep track of 

diff --git a/MANIFEST b/MANIFEST
index 0c80594..556767e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -19,6 +19,7 @@ lib/Moose/Cookbook/Recipe5.pod
 lib/Moose/Cookbook/Recipe6.pod
 lib/Moose/Cookbook/Recipe7.pod
 lib/Moose/Cookbook/WTF.pod
+lib/Moose/Cookbook/Snack/Types.pod
 lib/Moose/Meta/Attribute.pm
 lib/Moose/Meta/Class.pm
 lib/Moose/Meta/Instance.pm
@@ -32,94 +33,99 @@ lib/Moose/Meta/Method/Destructor.pm
 lib/Moose/Meta/Method/Overriden.pm
 lib/Moose/Meta/Role/Method.pm
 lib/Moose/Meta/Role/Method/Required.pm
+lib/Moose/Meta/TypeConstraint/Container.pm
+lib/Moose/Meta/TypeConstraint/Registry.pm
 lib/Moose/Meta/TypeConstraint/Union.pm
 lib/Moose/Spec/Role.pod
 lib/Moose/Util/TypeConstraints.pm
 lib/Test/Moose.pm
 t/000_load.t
-t/001_recipe.t
-t/002_recipe.t
-t/003_recipe.t
-t/004_recipe.t
-t/005_recipe.t
-t/006_recipe.t
-t/007_recipe.t
-t/010_basic_class_setup.t
-t/011_require_superclasses.t
-t/012_super_and_override.t
-t/013_inner_and_augment.t
-t/014_override_augment_inner_super.t
-t/015_override_and_foreign_classes.t
-t/016_always_strict_warnings.t
-t/017_wrapped_method_context_propagation.t
-t/018_import_unimport.t
-t/019_method_keyword.t
-t/020_foreign_inheritence.t
-t/021_moose_w_metaclass.t
-t/022_moose_respects_base.t
-t/023_moose_respects_type_constraints.t
-t/030_attribute_reader_generation.t
-t/031_attribute_writer_generation.t
-t/032_attribute_accessor_generation.t
-t/033_attribute_triggers.t
-t/034_attribute_does.t
-t/035_attribute_required.t
-t/036_attribute_custom_metaclass.t
-t/037_attribute_type_unions.t
-t/038_attribute_inherited_slot_specs.t
-t/039_attribute_delegation.t
-t/040_meta_role.t
-t/041_role.t
-t/042_apply_role.t
-t/043_role_composition_errors.t
-t/044_role_conflict_detection.t
-t/045_role_exclusion.t
-t/046_roles_and_required_method_edge_cases.t
-t/047_role_conflict_edge_cases.t
-t/048_more_role_edge_cases.t
-t/049_run_time_role_composition.t
-t/050_util_type_constraints.t
-t/051_util_type_constraints_export.t
-t/052_util_std_type_constraints.t
-t/053_util_find_type_constraint.t
-t/054_util_type_coercion.t
-t/055_util_type_reloading.t
-t/056_util_more_type_coercion.t
-t/057_union_types.t
-t/058_union_types_and_coercions.t
-t/059_misc_type_tests.t
-t/060_moose_for_meta.t
-t/070_more_attr_delegation.t
-t/071_misc_attribute_tests.t
-t/072_attr_dereference_test.t
-t/073_misc_attribute_coerce_lazy.t
-t/100_subtype_quote_bug.t
-t/101_subtype_conflict_bug.t
-t/102_Moose_Object_error.t
-t/103_subclass_use_base_bug.t
-t/104_inline_reader_bug.t
-t/105_module_refresh_compat.t
-t/106_handles_foreign_class_bug.t
-t/107_custom_attr_meta_with_roles.t
-t/108_custom_attr_meta_as_role.t
-t/109_reader_precedence_bug.t
-t/110_new_w_undef.t
-t/201_example.t
-t/202_example_Moose_POOP.t
-t/203_example.t
-t/204_example_w_DCS.t
-t/205_example_w_TestDeep.t
-t/206_example_Protomoose.t
-t/300_immutable_moose.t
-t/400_moose_util.t
-t/401_moose_util_does_role.t
-t/402_moose_util_search_class_by_role.t
-t/500_test_moose.t
-t/501_test_moose_does_ok.t
-t/502_test_moose_has_attribute_ok.t
-t/503_test_moose_meta_ok.t
 t/pod.t
 t/pod_coverage.t
+t/000_recipes/001_recipe.t
+t/000_recipes/002_recipe.t
+t/000_recipes/003_recipe.t
+t/000_recipes/004_recipe.t
+t/000_recipes/005_recipe.t
+t/000_recipes/006_recipe.t
+t/000_recipes/007_recipe.t
+t/010_basics/001_basic_class_setup.t
+t/010_basics/002_require_superclasses.t
+t/010_basics/003_super_and_override.t
+t/010_basics/004_inner_and_augment.t
+t/010_basics/005_override_augment_inner_super.t
+t/010_basics/006_override_and_foreign_classes.t
+t/010_basics/007_always_strict_warnings.t
+t/010_basics/008_wrapped_method_context_propagation.t
+t/010_basics/009_import_unimport.t
+t/010_basics/010_method_keyword.t
+t/010_basics/011_moose_respects_type_constraints.t
+t/020_attributes/001_attribute_reader_generation.t
+t/020_attributes/002_attribute_writer_generation.t
+t/020_attributes/003_attribute_accessor_generation.t
+t/020_attributes/004_attribute_triggers.t
+t/020_attributes/005_attribute_does.t
+t/020_attributes/006_attribute_required.t
+t/020_attributes/007_attribute_custom_metaclass.t
+t/020_attributes/008_attribute_type_unions.t
+t/020_attributes/009_attribute_inherited_slot_specs.t
+t/020_attributes/010_attribute_delegation.t
+t/020_attributes/011_more_attr_delegation.t
+t/020_attributes/012_misc_attribute_tests.t
+t/020_attributes/013_attr_dereference_test.t
+t/020_attributes/014_misc_attribute_coerce_lazy.t
+t/030_roles/001_meta_role.t
+t/030_roles/002_role.t
+t/030_roles/003_apply_role.t
+t/030_roles/004_role_composition_errors.t
+t/030_roles/005_role_conflict_detection.t
+t/030_roles/006_role_exclusion.t
+t/030_roles/007_roles_and_required_method_edge_cases.t
+t/030_roles/008_role_conflict_edge_cases.t
+t/030_roles/009_more_role_edge_cases.t
+t/030_roles/010_run_time_role_composition.t
+t/040_type_constraints/001_util_type_constraints.t
+t/040_type_constraints/002_util_type_constraints_export.t
+t/040_type_constraints/003_util_std_type_constraints.t
+t/040_type_constraints/004_util_find_type_constraint.t
+t/040_type_constraints/005_util_type_coercion.t
+t/040_type_constraints/006_util_type_reloading.t
+t/040_type_constraints/007_util_more_type_coercion.t
+t/040_type_constraints/008_union_types.t
+t/040_type_constraints/009_union_types_and_coercions.t
+t/040_type_constraints/010_misc_type_tests.t
+t/040_type_constraints/011_container_type_constraint.t
+t/050_metaclasses/001_custom_attr_meta_with_roles.t
+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/060_compat/001_module_refresh_compat.t
+t/060_compat/002_moose_respects_base.t
+t/060_compat/003_foreign_inheritence.t
+t/100_bugs/001_subtype_quote_bug.t
+t/100_bugs/002_subtype_conflict_bug.t
+t/100_bugs/003_Moose_Object_error.t
+t/100_bugs/004_subclass_use_base_bug.t
+t/100_bugs/005_inline_reader_bug.t
+t/100_bugs/006_handles_foreign_class_bug.t
+t/100_bugs/007_reader_precedence_bug.t
+t/100_bugs/008_new_w_undef.t
+t/100_bugs/009_augment_recursion_bug.t
+t/200_examples/001_example.t
+t/200_examples/002_example_Moose_POOP.t
+t/200_examples/003_example.t
+t/200_examples/004_example_w_DCS.t
+t/200_examples/005_example_w_TestDeep.t
+t/200_examples/006_example_Protomoose.t
+t/200_examples/007_example_Child_Parent_attr_inherit.t
+t/300_immutable/001_immutable_moose.t
+t/400_moose_util/001_moose_util.t
+t/400_moose_util/002_moose_util_does_role.t
+t/400_moose_util/003_moose_util_search_class_by_role.t
+t/500_test_moose/001_test_moose.t
+t/500_test_moose/002_test_moose_does_ok.t
+t/500_test_moose/003_test_moose_has_attribute_ok.t
+t/500_test_moose/004_test_moose_meta_ok.t
 t/lib/Bar.pm
 t/lib/Foo.pm
 t/lib/MyMooseA.pm

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index e398eb1..6643307 100644 (file)
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -9,7 +9,7 @@ use Class::MOP;
 use Carp         'confess';
 use Scalar::Util 'weaken', 'blessed', 'reftype';
 
-our $VERSION   = '0.15';
+our $VERSION   = '0.16';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Overriden;
@@ -180,11 +180,10 @@ sub add_override_method_modifier {
         my @args = @_;
         no warnings 'redefine';
         if ($Moose::SUPER_SLOT{$_super_package}) {
-          local *{$Moose::SUPER_SLOT{$_super_package}}
-            = sub { $super->(@args) };
-          return $method->(@args);
+            local *{$Moose::SUPER_SLOT{$_super_package}} = sub { $super->(@args) };
+            return $method->(@args);
         } else {
-          confess "Trying to call override modifier'd method without super()";
+            confess "Trying to call override modifier'd method without super()";
         }
     }));
 }
@@ -211,11 +210,14 @@ sub add_augment_method_modifier {
         my @args = @_;
         no warnings 'redefine';
         if ($Moose::INNER_SLOT{$_super_package}) {
-          local *{$Moose::INNER_SLOT{$_super_package}}
-            = sub { $method->(@args) };
-          return $super->(@args);
-        } else {
-          return $super->(@args);
+            local *{$Moose::INNER_SLOT{$_super_package}} = sub { 
+                local *{$Moose::INNER_SLOT{$_super_package}} = sub {}; 
+                $method->(@args);
+            };
+            return $super->(@args);
+        } 
+        else {          
+            return $super->(@args);
         }
     });
 }

diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm
index 9e0bf7f..9da35cf 100644 (file)
--- a/lib/Moose/Meta/Method/Constructor.pm
+++ b/lib/Moose/Meta/Method/Constructor.pm
@@ -231,8 +231,6 @@ sub _generate_default_value {
 
 1;
 
-1;
-
 __END__
 
 =pod

diff --git a/t/100_bugs/009_augment_recursion_bug.t b/t/100_bugs/009_augment_recursion_bug.t
new file mode 100644 (file)
index 0000000..df985e7
--- /dev/null
+++ b/t/100_bugs/009_augment_recursion_bug.t
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+BEGIN {
+    use_ok('Moose');
+}
+
+{
+    package Foo;
+    use Moose;
+
+    sub foo { 'Foo::foo(' . (inner() || '') . ')' };
+
+    package Bar;
+    use Moose;
+
+    extends 'Foo';
+
+    package Baz;
+    use Moose;
+
+    extends 'Foo';
+
+    my $foo_call_counter;
+    augment 'foo' => sub {
+        die "infinite loop on Baz::foo" if $foo_call_counter++ > 1;
+        return 'Baz::foo and ' . Bar->new->foo;
+    };
+}
+
+my $baz = Baz->new();
+isa_ok($baz, 'Baz');
+isa_ok($baz, 'Foo');
+
+=pod
+
+When a subclass which augments foo(), calls a subclass which does not augment
+foo(), there is a chance for some confusion. If Moose does not realize that
+Bar does not augment foo(), becuase it is in the call flow of Baz which does,
+then we may have an infinite loop.
+
+=cut
+
+is($baz->foo,
+  'Foo::foo(Baz::foo and Foo::foo())',
+  '... got the right value for 1 augmented subclass calling non-augmented subclass');
+

diff --git a/t/200_examples/007_example_Child_Parent_attr_inherit.t b/t/200_examples/007_example_Child_Parent_attr_inherit.t
new file mode 100644 (file)
index 0000000..d7abef0
--- /dev/null
+++ b/t/200_examples/007_example_Child_Parent_attr_inherit.t
@@ -0,0 +1,109 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 23;
+
+=pod
+
+Some examples of triggers and how they can 
+be used to manage parent-child relationships.
+
+=cut
+
+{
+    package Parent;
+    use Moose;
+    
+    has 'last_name' => (
+        is      => 'rw', 
+        isa     => 'Str',
+        trigger => sub {
+            my $self = shift;
+            # if the parents last-name changes
+            # then so do all the childrens
+            foreach my $child (@{$self->children}) {
+                $child->last_name($self->last_name);
+            }
+        }
+    );
+    
+    has 'children' => (is => 'rw', isa => 'ArrayRef', default => sub {[]});
+}
+{
+    package Child;
+    use Moose;
+    
+    has 'parent' => (
+        is          => 'rw',
+        isa         => 'Parent',
+        required    => 1,
+        trigger     => sub {
+            my $self = shift;
+            # if the parent is changed,.. 
+            # make sure we update            
+            $self->last_name($self->parent->last_name);
+        }
+    );
+    
+    has 'last_name' => (
+        is      => 'rw', 
+        isa     => 'Str', 
+        lazy    => 1,
+        default => sub { (shift)->parent->last_name }
+    );
+    
+}
+
+my $parent = Parent->new(last_name => 'Smith');
+isa_ok($parent, 'Parent');
+
+is($parent->last_name, 'Smith', '... the parent has the last name we expected');
+
+$parent->children([
+    map { Child->new(parent => $parent) } (0 .. 3)
+]);
+
+foreach my $child (@{$parent->children}) {
+    is($child->last_name, $parent->last_name, '... parent and child have the same last name (' . $parent->last_name . ')');
+}
+
+$parent->last_name('Jones');
+is($parent->last_name, 'Jones', '... the parent has the new last name');
+
+foreach my $child (@{$parent->children}) {
+    is($child->last_name, $parent->last_name, '... parent and child have the same last name (' . $parent->last_name . ')');
+}
+
+# make a new parent
+
+my $parent2 = Parent->new(last_name => 'Brown');
+isa_ok($parent2, 'Parent');
+
+# orphan the child 
+
+my $orphan = pop @{$parent->children};
+
+# and then the new parent adopts it 
+
+$orphan->parent($parent2);
+
+foreach my $child (@{$parent->children}) {
+    is($child->last_name, $parent->last_name, '... parent and child have the same last name (' . $parent->last_name . ')');
+}
+
+isnt($orphan->last_name, $parent->last_name, '... the orphan child does not have the same last name anymore (' . $parent2->last_name . ')');
+is($orphan->last_name, $parent2->last_name, '... parent2 and orphan child have the same last name (' . $parent2->last_name . ')');
+
+# make sure that changes still will not propagate
+
+$parent->last_name('Miller');
+is($parent->last_name, 'Miller', '... the parent has the new last name (again)');
+
+foreach my $child (@{$parent->children}) {
+    is($child->last_name, $parent->last_name, '... parent and child have the same last name (' . $parent->last_name . ')');
+}
+
+isnt($orphan->last_name, $parent->last_name, '... the orphan child is not affected by changes in the parent anymore');
+is($orphan->last_name, $parent2->last_name, '... parent2 and orphan child have the same last name (' . $parent2->last_name . ')');