From: Stevan Little Date: Fri, 14 Sep 2007 20:24:41 +0000 (+0000) Subject: eilaras bug fixed and tested X-Git-Tag: 0_26~16 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b468a3d37718e1b289e83ba3bfda103b4326d8be;p=gitmo%2FMoose.git eilaras bug fixed and tested --- diff --git a/Changes b/Changes index 74e58d7..d2726f2 100644 --- 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 --- 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 --- 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 --- 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 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 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 . ')');