From: Stevan Little Date: Thu, 2 Mar 2006 22:52:45 +0000 (+0000) Subject: release 0.20 X-Git-Tag: 0_20^0 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=96ceced87583646c1396bba4fdfa92d0b6c37058;hp=a4258ffd7a0a2bb8db5f01936068185d4f879b1a;p=gitmo%2FClass-MOP.git release 0.20 --- diff --git a/Build.PL b/Build.PL index b46a5ac..93daac5 100644 --- a/Build.PL +++ b/Build.PL @@ -10,7 +10,6 @@ my $build = Module::Build->new( 'Sub::Name' => '0.02', 'Carp' => '0.01', 'B' => '0', - 'SUPER' => '1.11', }, optional => { }, diff --git a/Changes b/Changes index ed728ae..2f2eecd 100644 --- a/Changes +++ b/Changes @@ -1,13 +1,12 @@ Revision history for Perl extension Class-MOP. -0.20 +0.20 Thurs. March 2, 2006 - removed the dependency for Clone since we no longer to deep-cloning by default. - - added dependency for SUPER to support the - method modifier code. * Class::MOP::Method - - added &package_name and &name methods + - added &package_name, &name and + &fully_qualified_name methods, some of which were formerly private subs in Class::MOP::Class @@ -18,16 +17,16 @@ Revision history for Perl extension Class-MOP. * Class::MOP::Class - improved &get_package_variable + - &version and &superclasses now use it - methods are now blessed into Class::MOP::Method whenever possible - - &has_method now uses new method introspection - from Class::MOP::Method to determine where the - sub comes from - added methods to install CLOS-style method modifiers - &add_before_method_modifier - &add_after_method_modifier - &add_around_method_modifier - added tests and docs for these + - added &find_next_method_by_name which finds the + equivalent of SUPER::method_name 0.12 Thurs. Feb 23, 2006 - reduced the dependency on B, no need to always diff --git a/MANIFEST b/MANIFEST index 1269db0..e446d6d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,17 +1,17 @@ Build.PL Changes Makefile.PL +META.yml MANIFEST MANIFEST.SKIP -META.yml README examples/AttributesWithHistory.pod +examples/C3MethodDispatchOrder.pod examples/ClassEncapsulatedAttributes.pod examples/InsideOutClass.pod examples/InstanceCountingClass.pod examples/LazyClass.pod examples/Perl6Attribute.pod -examples/C3MethodDispatchOrder.pod lib/metaclass.pm lib/Class/MOP.pm lib/Class/MOP/Attribute.pm @@ -31,9 +31,11 @@ t/013_add_attribute_alternate.t t/014_attribute_introspection.t t/015_metaclass_inheritance.t t/016_class_errors_and_edge_cases.t +t/017_add_method_modifier.t t/020_attribute.t t/021_attribute_errors_and_edge_cases.t t/030_method.t +t/031_method_modifiers.t t/040_metaclass.t t/041_metaclass_incompatability.t t/050_scala_style_mixin_composition.t diff --git a/examples/C3MethodDispatchOrder.pod b/examples/C3MethodDispatchOrder.pod index a45e593..1a0c2a0 100644 --- a/examples/C3MethodDispatchOrder.pod +++ b/examples/C3MethodDispatchOrder.pod @@ -12,7 +12,7 @@ our $VERSION = '0.02'; use base 'Class::MOP::Class'; -my $_find_method_in_superclass = sub { +my $_find_method = sub { my ($class, $method) = @_; foreach my $super ($class->class_precedence_list) { return $super->meta->get_method($method) @@ -31,12 +31,12 @@ C3MethodDispatchOrder->meta->add_around_method_modifier('initialize' => sub { my $label = ${$meta->name . '::AUTOLOAD'}; $method_name = (split /\:\:/ => $label)[-1]; } - my $method = $_find_method_in_superclass->($meta, $method_name); + my $method = $_find_method->($meta, $method_name); (defined $method) || confess "Method ($method_name) not found"; goto &$method; }); $meta->add_method('can' => sub { - $_find_method_in_superclass->($_[0]->meta, $_[1]); + $_find_method->($_[0]->meta, $_[1]); }); return $meta; }); diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 0e48dfa..474783b 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed', 'reftype'; use Sub::Name 'subname'; -use SUPER (); +use B 'svref_2object'; our $VERSION = '0.06'; @@ -78,7 +78,7 @@ sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) } shift @class_list; # shift off $self->name foreach my $class_name (@class_list) { - my $meta = $METAS{$class_name}; + my $meta = $METAS{$class_name} || next; ($self->isa(blessed($meta))) || confess $self->name . "->meta => (" . (blessed($self)) . ")" . " is not compatible with the " . @@ -191,20 +191,18 @@ sub clone_instance { sub version { my $self = shift; - no strict 'refs'; - ${$self->name . '::VERSION'}; + ${$self->get_package_variable('$VERSION')}; } # Inheritance sub superclasses { my $self = shift; - no strict 'refs'; if (@_) { my @supers = @_; - @{$self->name . '::ISA'} = @supers; + @{$self->get_package_variable('@ISA')} = @supers; } - @{$self->name . '::ISA'}; + @{$self->get_package_variable('@ISA')}; } sub class_precedence_list { @@ -249,8 +247,14 @@ sub add_method { my $method = $self->get_method($method_name); # if we dont have local ... unless ($method) { - # create a local which just calls the SUPER method ... - $self->add_method($method_name => sub { $_[0]->super($method_name)->(@_) }); + # make sure this method even exists ... + ($self->find_next_method_by_name($method_name)) + || confess "The method '$method_name' is not found in the inherience hierarchy for this class"; + # if so, then create a local which just + # calls the next applicable method ... + $self->add_method($method_name => sub { + $self->find_next_method_by_name($method_name)->(@_); + }); $method = $self->get_method($method_name); } @@ -317,12 +321,13 @@ sub has_method { no strict 'refs'; return 0 if !defined(&{$sub_name}); - my $method = \&{$sub_name}; - $method = $self->method_metaclass->wrap($method) unless blessed($method); + return 0 if (svref_2object($method)->GV->STASH->NAME || '') ne $self->name && + (svref_2object($method)->GV->NAME || '') ne '__ANON__'; - return 0 if $method->package_name ne $self->name && - $method->name ne '__ANON__'; + # at this point we are relatively sure + # it is our method, so we bless/wrap it + $self->method_metaclass->wrap($method) unless blessed($method); return 1; } @@ -397,7 +402,7 @@ sub find_all_methods_by_name { next if $seen_class{$class}; $seen_class{$class}++; # fetch the meta-class ... - my $meta = $self->initialize($class);; + my $meta = $self->initialize($class); push @methods => { name => $method_name, class => $class, @@ -407,6 +412,28 @@ sub find_all_methods_by_name { return @methods; } +sub find_next_method_by_name { + my ($self, $method_name) = @_; + (defined $method_name && $method_name) + || confess "You must define a method name to find"; + # keep a record of what we have seen + # here, this will handle all the + # inheritence issues because we are + # using the &class_precedence_list + my %seen_class; + my @cpl = $self->class_precedence_list(); + shift @cpl; # discard ourselves + foreach my $class (@cpl) { + next if $seen_class{$class}; + $seen_class{$class}++; + # fetch the meta-class ... + my $meta = $self->initialize($class); + return $meta->get_method($method_name) + if $meta->has_method($method_name); + } + return; +} + ## Attributes sub add_attribute { @@ -838,18 +865,110 @@ duplicates in it. This is especially useful for things like object initialization and destruction where you only want the method called once, and in the correct order. +=item B + +This will return the first method to match a given C<$method_name> in +the superclasses, this is basically equivalent to calling +C, but it can be dispatched at runtime. + =back =head2 Method Modifiers +Method modifiers are a concept borrowed from CLOS, in which a method +can be wrapped with I, I and I method modifiers +that will be called everytime the method is called. + +=head3 How method modifiers work? + +Method modifiers work by wrapping the original method and then replacing +it in the classes symbol table. The wrappers will handle calling all the +modifiers in the appropariate orders and preserving the calling context +for the original method. + +Each method modifier serves a particular purpose, which may not be +obvious to users of other method wrapping modules. To start with, the +return values of I and I modifiers are ignored. This is +because thier purpose is B to filter the input and output of the +primary method (this is done with an I modifier). This may seem +like an odd restriction to some, but doing this allows for simple code +to be added at the begining or end of a method call without jeapordizing +the normal functioning of the primary method or placing any extra +responsibility on the code of the modifier. Of course if you have more +complex needs, then use the I modifier, which uses a variation +of continutation passing style to allow for a high degree of flexibility. + +Before and around modifiers are called in last-defined-first-called order, +while after modifiers are called in first-defined-first-called order. So +the call tree might looks something like this: + + before 2 + before 1 + around 2 + around 1 + primary + after 1 + after 2 + +To see examples of using method modifiers, see the following examples +included in the distribution; F, F, +F and F. There is also a +classic CLOS usage example in the test F<017_add_method_modifier.t>. + +=head3 What is the performance impact? + +Of course there is a performance cost associated with method modifiers, +but we have made every effort to make that cost be directly proportional +to the amount of modifier features you utilize. + +The wrapping method does it's best to B do as much work as it +absolutely needs to. In order to do this we have moved some of the +performance costs to set-up time, where they are easier to amortize. + +All this said, my benchmarks have indicated the following: + + simple wrapper with no modifiers 100% slower + simple wrapper with simple before modifier 400% slower + simple wrapper with simple after modifier 450% slower + simple wrapper with simple around modifier 500-550% slower + simple wrapper with all 3 modifiers 1100% slower + +These numbers may seem daunting, but you must remember, every feature +comes with some cost. To put things in perspective, just doing a simple +C which does nothing but extract the name of the method called +and return it costs about 400% over a normal method call. + =over 4 =item B +This will wrap the method at C<$method_name> and the supplied C<$code> +will be passed the C<@_> arguments, and called before the original +method is called. As specified above, the return value of the I +method modifiers is ignored, and it's ability to modify C<@_> is +fairly limited. If you need to do either of these things, use an +C method modifier. + =item B +This will wrap the method at C<$method_name> so that the original +method will be called, it's return values stashed, and then the +supplied C<$code> will be passed the C<@_> arguments, and called. +As specified above, the return value of the I method +modifiers is ignored, and it cannot modify the return values of +the original method. If you need to do either of these things, use an +C method modifier. + =item B +This will wrap the method at C<$method_name> so that C<$code> +will be called and passed the original method as an extra argument +at the begining of the C<@_> argument list. This is a variation of +continuation passing style, where the function prepended to C<@_> +can be considered a continuation. It is up to C<$code> if it calls +the original method or not, there is no restriction on what the +C<$code> can or cannot do. + =back =head2 Attributes diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm index c0ed04c..8b3c2b4 100644 --- a/lib/Class/MOP/Method.pm +++ b/lib/Class/MOP/Method.pm @@ -43,6 +43,13 @@ sub name { svref_2object($code)->GV->NAME; } +sub fully_qualified_name { + my $code = shift; + (blessed($code)) + || confess "Can only ask the package name of a blessed CODE"; + $code->package_name . '::' . $code->name; +} + package Class::MOP::Method::Wrapped; use strict; @@ -50,11 +57,67 @@ use warnings; use Carp 'confess'; use Scalar::Util 'reftype', 'blessed'; +use Sub::Name 'subname'; our $VERSION = '0.01'; our @ISA = ('Class::MOP::Method'); +# NOTE: +# this ugly beast is the result of trying +# to micro optimize this as much as possible +# while not completely loosing maintainability. +# At this point it's "fast enough", after all +# you can't get something for nothing :) +my $_build_wrapped_method = sub { + my $modifier_table = shift; + my ($before, $after, $around) = ( + $modifier_table->{before}, + $modifier_table->{after}, + $modifier_table->{around}, + ); + if (@$before && @$after) { + $modifier_table->{cache} = sub { + $_->(@_) for @{$before}; + my @rval; + ((defined wantarray) ? + ((wantarray) ? + (@rval = $around->{cache}->(@_)) + : + ($rval[0] = $around->{cache}->(@_))) + : + $around->{cache}->(@_)); + $_->(@_) for @{$after}; + return unless defined wantarray; + return wantarray ? @rval : $rval[0]; + } + } + elsif (@$before && !@$after) { + $modifier_table->{cache} = sub { + $_->(@_) for @{$before}; + return $around->{cache}->(@_); + } + } + elsif (@$after && !@$before) { + $modifier_table->{cache} = sub { + my @rval; + ((defined wantarray) ? + ((wantarray) ? + (@rval = $around->{cache}->(@_)) + : + ($rval[0] = $around->{cache}->(@_))) + : + $around->{cache}->(@_)); + $_->(@_) for @{$after}; + return unless defined wantarray; + return wantarray ? @rval : $rval[0]; + } + } + else { + $modifier_table->{cache} = $around->{cache}; + } +}; + my %MODIFIERS; sub wrap { @@ -63,32 +126,17 @@ sub wrap { (blessed($code) && $code->isa('Class::MOP::Method')) || confess "Can only wrap blessed CODE"; my $modifier_table = { + cache => undef, orig => $code, before => [], after => [], around => { cache => $code, - methods => [], + methods => [], }, }; - my $method = $class->SUPER::wrap(sub { - $_->(@_) for @{$modifier_table->{before}}; - my (@rlist, $rval); - if (defined wantarray) { - if (wantarray) { - @rlist = $modifier_table->{around}->{cache}->(@_); - } - else { - $rval = $modifier_table->{around}->{cache}->(@_); - } - } - else { - $modifier_table->{around}->{cache}->(@_); - } - $_->(@_) for @{$modifier_table->{after}}; - return unless defined wantarray; - return wantarray ? @rlist : $rval; - }); + $_build_wrapped_method->($modifier_table); + my $method = $class->SUPER::wrap(sub { $modifier_table->{cache}->(@_) }); $MODIFIERS{$method} = $modifier_table; $method; } @@ -103,6 +151,7 @@ sub add_before_modifier { ('CODE' eq (reftype($code) || '')) || confess "You must supply a CODE reference for a modifier"; unshift @{$MODIFIERS{$code}->{before}} => $modifier; + $_build_wrapped_method->($MODIFIERS{$code}); } sub add_after_modifier { @@ -115,9 +164,16 @@ sub add_after_modifier { ('CODE' eq (reftype($code) || '')) || confess "You must supply a CODE reference for a modifier"; push @{$MODIFIERS{$code}->{after}} => $modifier; + $_build_wrapped_method->($MODIFIERS{$code}); } { + # NOTE: + # this is another possible canidate for + # optimization as well. There is an overhead + # associated with the currying that, if + # eliminated might make around modifiers + # more manageable. my $compile_around_method = sub {{ my $f1 = pop; return $f1 unless @_; @@ -140,6 +196,7 @@ sub add_after_modifier { @{$MODIFIERS{$code}->{around}->{methods}}, $MODIFIERS{$code}->{orig} ); + $_build_wrapped_method->($MODIFIERS{$code}); } } @@ -188,10 +245,6 @@ to this class. This simply blesses the C<&code> reference passed to it. -=item B - -This wraps an existing method so that it can handle method modifiers. - =back =head2 Informational @@ -202,6 +255,20 @@ This wraps an existing method so that it can handle method modifiers. =item B +=item B + +=back + +=head1 Class::MOP::Method::Wrapped METHODS + +=head2 Construction + +=over 4 + +=item B + +This simply blesses the C<&code> reference passed to it. + =back =head2 Modifiers diff --git a/lib/Class/MOP/SafeMixin.pm b/lib/Class/MOP/SafeMixin.pm deleted file mode 100644 index 0c823eb..0000000 --- a/lib/Class/MOP/SafeMixin.pm +++ /dev/null @@ -1,189 +0,0 @@ - -package Class::MOP::SafeMixin; - -use strict; -use warnings; - -use Scalar::Util 'blessed'; -use Carp 'confess'; - -our $VERSION = '0.01'; - -use base 'Class::MOP::Class'; - -sub mixin { - # fetch the metaclass for the - # caller and the mixin arg - my $metaclass = shift; - my $mixin = $metaclass->initialize(shift); - - # according to Scala, the - # the superclass of our class - # must be a subclass of the - # superclass of the mixin (see above) - my ($super_meta) = $metaclass->superclasses(); - my ($super_mixin) = $mixin->superclasses(); - ($super_meta->isa($super_mixin)) - || confess "The superclass must extend a subclass of the superclass of the mixin" - if defined $super_mixin && defined $super_meta; - - # collect all the attributes - # and clone them so they can - # associate with the new class - my @attributes = map { - $mixin->get_attribute($_)->clone() - } $mixin->get_attribute_list; - - my %methods = map { - my $method = $mixin->get_method($_); - # we want to ignore accessors since - # they will be created with the attrs - (blessed($method) && $method->isa('Class::MOP::Attribute::Accessor')) - ? () : ($_ => $method) - } $mixin->get_method_list; - - # NOTE: - # I assume that locally defined methods - # and attributes get precedence over those - # from the mixin. - - # add all the attributes in .... - foreach my $attr (@attributes) { - $metaclass->add_attribute($attr) - unless $metaclass->has_attribute($attr->name); - } - - # add all the methods in .... - foreach my $method_name (keys %methods) { - $metaclass->alias_method($method_name => $methods{$method_name}) - unless $metaclass->has_method($method_name); - } -} - -1; - -__END__ - -=pod - -=head1 NAME - -Class::MOP::SafeMixin - A meta-object for safe mixin-style composition - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -This is a meta-object which provides B mixin-style composition -of classes. The key word here is "safe" because we enforce a number -of rules about mixing in which prevent some of the instability -inherent in other mixin systems. However, it should be noted that we -still allow you enough rope with which to shoot yourself in the foot -if you so desire. - -=over 4 - -=item * - -In order to mix classes together, they must inherit from a common -superclass. This assures at least some level of similarity between -the classes being mixed together, which should result in a more -stable end product. - -The only exception to this rule is if the class being mixed in has -no superclasses at all. In this case we assume the mixin is valid. - -=item * - -Since we enforce a common ancestral relationship, we need to be -mindful of method and attribute conflicts. The common ancestor -increases the potential of method conflicts because it is common -for subclasses to override their parents methods. However, it is -less common for attributes to be overriden. The way these are -resolved is to use a Trait/Role-style conflict mechanism. - -If two classes are mixed together, any method or attribute conflicts -will result in a failure of the mixin and a fatal exception. It is -not possible to resolve a method or attribute conflict dynamically. -This is because to do so would open the possibility of breaking -classes in very subtle and dangerous ways, particularly in the area -of method interdependencies. The amount of implementation knowledge -which would need to be known by the mixee would (IMO) increase the -complexity of the feature exponentially for each class mixed in. - -However fear not, there is a solution (see below) ... - -=item * - -Safe mixin's offer the possibility of CLOS style I, I -and I methods with which method conflicts can be resolved. - -A method, which would normally conflict, but which is labeled with -either a I, I or I attribute, will instead be -combined with the original method in the way implied by the attribute. - -The result of this is a generalized event-handling system for classes. -Which can be used to create things more specialized, such as plugins -and decorators. - -=back - -=head2 What kinda crack are you on ?!?!?!? - -This approach may seem crazy, but I am fairly confident that it will -work, and that it will not tie your hands unnessecarily. All these -features have been used with certain degrees of success in the object -systems of other languages, but none (IMO) provided a complete -solution. - -In CLOS, I, I and I methods provide a high -degree of flexibility for adding behavior to methods, but do not address -any concerns regarding classes since in CLOS, classes and methods are -separate components of the system. - -In Scala, mixins are restricted by their ancestral relationships, which -results in a need to have seperate "traits" to get around this restriction. -In addition, Scala does not seem to have any means of method conflict -resolution for mixins (at least not that I can find). - -In Perl 6, the role system forces manual disambiguation which (as -mentioned above) can cause issues with method interdependecies when -composing roles together. This problem will grow exponentially in one -direction with each role composed and in the other direction with the -number of roles that role itself is composed of. The result is that the -complexity of the system becomes unmanagable for all but very simple or -very shallow roles. Now, this is not to say that roles are unusable, in -fact, this feature (IMO) promotes good useage of roles by keeping them -both small and simple. But, the same behaviors cannot be applied to -class mixins without hitting these barriers all too quickly. - -The same too can be said of the original Traits system, with its -features for aliasing and exclusion of methods. - -So after close study of these systems, and in some cases actually -implementing said systems, I have come to the see that each on it's -own is not robust enough and that combining the best parts of each -gives us (what I hope is) a better, safer and saner system. - -=head1 METHODS - -=over 4 - -=item B - -=back - -=head1 AUTHOR - -Stevan Little Estevan@iinteractive.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006 by Infinity Interactive, Inc. - -L - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut diff --git a/lib/metaclass.pm b/lib/metaclass.pm index 819bdac..b09417e 100644 --- a/lib/metaclass.pm +++ b/lib/metaclass.pm @@ -40,7 +40,7 @@ __END__ =head1 NAME -metaclass - a pragma for installing using Class::MOP metaclasses +metaclass - a pragma for installing and using Class::MOP metaclasses =head1 SYNOPSIS diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t index 226907b..9f5d9f2 100644 --- a/t/010_self_introspection.t +++ b/t/010_self_introspection.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 124; +use Test::More tests => 126; use Test::Exception; BEGIN { @@ -35,7 +35,8 @@ my @methods = qw( superclasses class_precedence_list has_method get_method add_method remove_method alias_method - get_method_list compute_all_applicable_methods find_all_methods_by_name + get_method_list compute_all_applicable_methods + find_all_methods_by_name find_next_method_by_name add_before_method_modifier add_after_method_modifier add_around_method_modifier diff --git a/t/017_add_method_modifier.t b/t/017_add_method_modifier.t index fde84a2..7ac25f6 100644 --- a/t/017_add_method_modifier.t +++ b/t/017_add_method_modifier.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More no_plan => 53; +use Test::More tests => 17; use Test::Exception; BEGIN { @@ -26,10 +26,9 @@ BEGIN { )); sub new { (shift)->meta->new_object(@_) } - + sub deposit { my ($self, $amount) = @_; - #warn "deposited $amount in $self"; $self->balance($self->balance + $amount); } @@ -38,7 +37,6 @@ BEGIN { my $current_balance = $self->balance(); ($current_balance >= $amount) || confess "Account overdrawn"; - #warn "withdrew $amount from $self"; $self->balance($current_balance - $amount); } @@ -46,7 +44,8 @@ BEGIN { use strict; use warnings; - + use metaclass; + use base 'BankAccount'; CheckingAccount->meta->add_attribute('$:overdraft_account' => ( @@ -56,14 +55,11 @@ BEGIN { CheckingAccount->meta->add_before_method_modifier('withdraw' => sub { my ($self, $amount) = @_; - #warn "hello from before"; my $overdraft_amount = $amount - $self->balance(); if ($overdraft_amount > 0) { - #warn "overdrawn $overdraft_amount"; $self->overdraft_account->withdraw($overdraft_amount); $self->deposit($overdraft_amount); } - #warn "balance after overdraft : " . $self->balance; }); ::ok(CheckingAccount->meta->has_method('withdraw'), '... checking account now has a withdraw method'); @@ -94,9 +90,14 @@ is($checking_account->overdraft_account, $savings_account, '... got the right ov is($checking_account->balance, 100, '... got the right checkings balance'); lives_ok { - $checking_account->withdraw(200); + $checking_account->withdraw(50); } '... withdrew from checking successfully'; +is($checking_account->balance, 50, '... got the right checkings balance after withdrawl'); +is($savings_account->balance, 350, '... got the right savings balance after checking withdrawl (no overdraft)'); +lives_ok { + $checking_account->withdraw(200); +} '... withdrew from checking successfully'; is($checking_account->balance, 0, '... got the right checkings balance after withdrawl'); -is($savings_account->balance, 250, '... got the right savings balance after overdraft withdrawl'); +is($savings_account->balance, 200, '... got the right savings balance after overdraft withdrawl'); diff --git a/t/031_method_modifiers.t b/t/031_method_modifiers.t index 583d1fa..73c915a 100644 --- a/t/031_method_modifiers.t +++ b/t/031_method_modifiers.t @@ -92,15 +92,15 @@ BEGIN { } '... added the before modifier okay'; lives_ok { - $wrapped->add_around_modifier(sub { push @tracelog => 'around 3'; $_[0]->(); }); + $wrapped->add_around_modifier(sub { push @tracelog => 'around 1'; $_[0]->(); }); $wrapped->add_around_modifier(sub { push @tracelog => 'around 2'; $_[0]->(); }); - $wrapped->add_around_modifier(sub { push @tracelog => 'around 1'; $_[0]->(); }); + $wrapped->add_around_modifier(sub { push @tracelog => 'around 3'; $_[0]->(); }); } '... added the around modifier okay'; lives_ok { - $wrapped->add_after_modifier(sub { push @tracelog => 'after 3' }); + $wrapped->add_after_modifier(sub { push @tracelog => 'after 1' }); $wrapped->add_after_modifier(sub { push @tracelog => 'after 2' }); - $wrapped->add_after_modifier(sub { push @tracelog => 'after 1' }); + $wrapped->add_after_modifier(sub { push @tracelog => 'after 3' }); } '... added the after modifier okay'; $wrapped->(); @@ -108,9 +108,9 @@ BEGIN { \@tracelog, [ 'before 3', 'before 2', 'before 1', # last-in-first-out order - 'around 1', 'around 2', 'around 3', # last-in-first-out order + 'around 3', 'around 2', 'around 1', # last-in-first-out order 'primary', - 'after 3', 'after 2', 'after 1', # first-in-first-out order + 'after 1', 'after 2', 'after 3', # first-in-first-out order ], '... got the right tracelog from all our before/around/after methods'); } diff --git a/t/300_basic_safe_mixin.t b/t/300_basic_safe_mixin.t deleted file mode 100644 index 8311fd5..0000000 --- a/t/300_basic_safe_mixin.t +++ /dev/null @@ -1,71 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More no_plan => 1; - -BEGIN { - use_ok('Class::MOP'); - use_ok('Class::MOP::SafeMixin'); -} - -## Mixin a class without a superclass. -{ - package FooMixin; - sub foo { 'FooMixin::foo' } - - package Foo; - use metaclass 'Class::MOP::SafeMixin'; - Foo->meta->mixin('FooMixin'); - sub new { (shift)->meta->new_object(@_) } -} - -my $foo = Foo->new(); -isa_ok($foo, 'Foo'); - -can_ok($foo, 'foo'); -is($foo->foo, 'FooMixin::foo', '... got the right value from the mixin method'); - -## Mixin a class who shares a common ancestor -{ - package Baz; - our @ISA = ('Foo'); - sub baz { 'Baz::baz' } - - package Bar; - our @ISA = ('Foo'); - - package Foo::Baz; - our @ISA = ('Foo'); - eval { Foo::Baz->meta->mixin('Baz') }; - ::ok(!$@, '... the classes superclass must extend a subclass of the superclass of the mixins'); - -} - -my $foo_baz = Foo::Baz->new(); -isa_ok($foo_baz, 'Foo::Baz'); -isa_ok($foo_baz, 'Foo'); - -can_ok($foo_baz, 'baz'); -is($foo_baz->baz(), 'Baz::baz', '... got the right value from the mixin method'); - -{ - package Foo::Bar; - our @ISA = ('Foo', 'Bar'); - - package Foo::Bar::Baz; - our @ISA = ('Foo::Bar'); - eval { Foo::Bar::Baz->meta->mixin('Baz') }; - ::ok(!$@, '... the classes superclass must extend a subclass of the superclass of the mixins'); -} - -my $foo_bar_baz = Foo::Bar::Baz->new(); -isa_ok($foo_bar_baz, 'Foo::Bar::Baz'); -isa_ok($foo_bar_baz, 'Foo::Bar'); -isa_ok($foo_bar_baz, 'Foo'); -isa_ok($foo_bar_baz, 'Bar'); - -can_ok($foo_bar_baz, 'baz'); -is($foo_bar_baz->baz(), 'Baz::baz', '... got the right value from the mixin method'); -