From: Stevan Little Date: Sat, 18 Mar 2006 05:50:23 +0000 (+0000) Subject: changes-to-this X-Git-Tag: 0_22~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0eff2c1615ec0101bb42e8c516b01907757e5fe9;p=gitmo%2FClass-MOP.git changes-to-this --- diff --git a/Changes b/Changes index 43f191c..606dafb 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,11 @@ Revision history for Perl extension Class-MOP. +0.22 + * Class::MOP::Class + - localized $@ in the *_package_variable functions + because otherwise, it does ugly things in Moose. + - added test case for this + 0.21 Wed. March 15, 2006 * Class::MOP::Class - fixed issue where metaclasses are reaped from diff --git a/MANIFEST b/MANIFEST index e446d6d..31a58ad 100644 --- a/MANIFEST +++ b/MANIFEST @@ -48,6 +48,7 @@ t/105_ClassEncapsulatedAttributes_test.t t/106_LazyClass_test.t t/107_C3MethodDispatchOrder_test.t t/200_Class_C3_compatibility.t +t/300_random_eval_bug.t t/pod.t t/pod_coverage.t t/lib/BinaryTree.pm diff --git a/README b/README index dd873f0..700052e 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -Class::MOP version 0.21 +Class::MOP version 0.22 =========================== See the individual module documentation for more information diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index e922cd1..a9c36d9 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -11,7 +11,7 @@ use Class::MOP::Class; use Class::MOP::Attribute; use Class::MOP::Method; -our $VERSION = '0.21'; +our $VERSION = '0.22'; ## ---------------------------------------------------------------------------- ## Setting up our environment ... diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 15468e5..2750b4f 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -9,7 +9,7 @@ use Scalar::Util 'blessed', 'reftype'; use Sub::Name 'subname'; use B 'svref_2object'; -our $VERSION = '0.07'; +our $VERSION = '0.08'; # Self-introspection @@ -523,6 +523,11 @@ sub add_package_variable { *{$self->name . '::' . $name} = $initial_value; } else { + # NOTE: + # We HAVE to localize $@ or all + # hell breaks loose. It is not + # good, believe me, not good. + local $@; eval $sigil . $self->name . '::' . $name; confess "Could not create package variable ($variable) because : $@" if $@; } @@ -543,7 +548,11 @@ sub get_package_variable { || confess "variable name does not have a sigil"; my ($sigil, $name) = ($variable =~ /^(.)(.*)$/); no strict 'refs'; - # try to fetch it first,.. see what happens + # NOTE: + # We HAVE to localize $@ or all + # hell breaks loose. It is not + # good, believe me, not good. + local $@; my $ref = eval '\\' . $sigil . $self->name . '::' . $name; confess "Could not get the package variable ($variable) because : $@" if $@; # if we didn't die, then we can return it diff --git a/t/300_random_eval_bug.t b/t/300_random_eval_bug.t new file mode 100644 index 0000000..dc7785b --- /dev/null +++ b/t/300_random_eval_bug.t @@ -0,0 +1,51 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 2; + +BEGIN { + use_ok('Class::MOP'); +} + +=pod + +This tests a bug which is fixed in 0.22 by +localizing all the $@'s around any evals. +This a real pain to track down. + +Moral of the story: + + ALWAYS localize your globals :) + +=cut + +{ + package Company; + use strict; + use warnings; + use metaclass; + + sub new { + my ($class) = @_; + return bless {} => $class; + } + + sub employees { + die "This didnt work"; + } + + sub DESTROY { + my $self = shift; + foreach my $method ($self->meta->find_all_methods_by_name('DEMOLISH')) { + $method->{code}->($self); + } + } +} + +eval { + my $c = Company->new(); + $c->employees(); +}; +ok($@, '... we die correctly with bad args'); \ No newline at end of file