From: Stevan Little <stevan.little@iinteractive.com>
Date: Sun, 18 May 2008 23:46:13 +0000 (+0000)
Subject: Class::MOP::Method and co. are now stricter and require the package_name and name... 
X-Git-Tag: 0_64~58
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b38f3848bc87e7e9cbffa5439cf386185c1bbc2b;p=gitmo%2FClass-MOP.git

Class::MOP::Method and co. are now stricter and require the package_name and name attributes
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 6546902..29bd467 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -528,6 +528,9 @@ Class::MOP::Method->meta->add_method('wrap' => sub {
     ('CODE' eq (Scalar::Util::reftype($code) || ''))
         || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
 
+    ($options{package_name} && $options{name})
+        || confess "You must supply the package_name and name parameters";
+
     # return the new object
     $class->meta->new_object(body => $code, %options);
 });
@@ -562,6 +565,8 @@ Class::MOP::Method::Generated->meta->add_attribute(
 
 Class::MOP::Method::Generated->meta->add_method('new' => sub {
     my ($class, %options) = @_;
+    ($options{package_name} && $options{name})
+        || confess "You must supply the package_name and name parameters";    
     my $self = $class->meta->new_object(%options);
     $self->initialize_body;  
     $self;
@@ -599,6 +604,9 @@ Class::MOP::Method::Accessor->meta->add_method('new' => sub {
     (Scalar::Util::blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute'))
         || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
 
+    ($options{package_name} && $options{name})
+        || confess "You must supply the package_name and name parameters";
+
     # return the new object
     my $self = $class->meta->new_object(%options);
     
@@ -643,6 +651,9 @@ Class::MOP::Method::Constructor->meta->add_method('new' => sub {
         || confess "You must pass a metaclass instance if you want to inline"
             if $options{is_inline};
 
+    ($options{package_name} && $options{name})
+        || confess "You must supply the package_name and name parameters";
+
     # return the new object
     my $self = $class->meta->new_object(%options);
     
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 06914b4..fa811f4 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -326,7 +326,11 @@ sub get_method_map {
 
         #warn "Checking $pkg against $class_name && $name against __ANON__";
 
-        $map->{$symbol} = $method_metaclass->wrap($code);
+        $map->{$symbol} = $method_metaclass->wrap(
+            $code,
+            package_name => $class_name,
+            name         => $symbol,
+        );
     }
 
     return $map;
diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm
index 5642d70..bbacdcf 100644
--- a/lib/Class/MOP/Method.pm
+++ b/lib/Class/MOP/Method.pm
@@ -25,6 +25,9 @@ sub wrap {
     ('CODE' eq (reftype($code) || ''))
         || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
     
+    ($params{package_name} && $params{name})
+        || confess "You must supply the package_name and name parameters";
+    
     bless { 
         '&!body'         => $code,
         '$!package_name' => $params{package_name},
diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm
index d927a4b..656dd9a 100644
--- a/lib/Class/MOP/Method/Accessor.pm
+++ b/lib/Class/MOP/Method/Accessor.pm
@@ -25,6 +25,9 @@ sub new {
     (blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute'))
         || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
 
+    ($options{package_name} && $options{name})
+        || confess "You must supply the package_name and name parameters";
+
     my $self = bless {
         # from our superclass
         '&!body'          => undef,
diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm
index 9395892..893a513 100644
--- a/lib/Class/MOP/Method/Constructor.pm
+++ b/lib/Class/MOP/Method/Constructor.pm
@@ -20,6 +20,9 @@ sub new {
         || confess "You must pass a metaclass instance if you want to inline"
             if $options{is_inline};
 
+    ($options{package_name} && $options{name})
+        || confess "You must supply the package_name and name parameters";
+
     my $self = bless {
         # from our superclass
         '&!body'                 => undef,
diff --git a/lib/Class/MOP/Method/Generated.pm b/lib/Class/MOP/Method/Generated.pm
index 99e1ccc..4042e32 100644
--- a/lib/Class/MOP/Method/Generated.pm
+++ b/lib/Class/MOP/Method/Generated.pm
@@ -15,6 +15,9 @@ sub new {
     my $class   = shift;
     my %options = @_;  
         
+    ($options{package_name} && $options{name})
+        || confess "You must supply the package_name and name parameters";     
+        
     my $self = bless {
         # from our superclass
         '&!body'          => undef,
diff --git a/t/030_method.t b/t/030_method.t
index f803363..a081038 100644
--- a/t/030_method.t
+++ b/t/030_method.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 25;
+use Test::More tests => 28;
 use Test::Exception;
 
 BEGIN {
@@ -11,7 +11,11 @@ BEGIN {
     use_ok('Class::MOP::Method');
 }
 
-my $method = Class::MOP::Method->wrap(sub { 1 });
+my $method = Class::MOP::Method->wrap(
+    sub { 1 },
+    package_name => 'main',
+    name         => '__ANON__',
+);
 is($method->meta, Class::MOP::Method->meta, '... instance and class both lead to the same meta');
 
 is($method->package_name, 'main', '... our package is main::');
@@ -50,4 +54,21 @@ dies_ok {
 
 dies_ok {
     Class::MOP::Method->wrap([])
-} '... bad args for &wrap';
\ No newline at end of file
+} '... bad args for &wrap';
+
+dies_ok {
+    Class::MOP::Method->wrap(sub { 'FAIL' })
+} '... bad args for &wrap';
+
+dies_ok {
+    Class::MOP::Method->wrap(sub { 'FAIL' }, package_name => 'main')
+} '... bad args for &wrap';
+
+dies_ok {
+    Class::MOP::Method->wrap(sub { 'FAIL' }, name => '__ANON__')
+} '... bad args for &wrap';
+
+
+
+
+
diff --git a/t/031_method_modifiers.t b/t/031_method_modifiers.t
index 73c915a..d2b695d 100644
--- a/t/031_method_modifiers.t
+++ b/t/031_method_modifiers.t
@@ -15,7 +15,11 @@ BEGIN {
 {
 	my $trace = '';
 
-	my $method = Class::MOP::Method->wrap(sub { $trace .= 'primary' });
+	my $method = Class::MOP::Method->wrap(
+	    sub { $trace .= 'primary' },
+	    package_name => 'main',
+	    name         => '__ANON__',
+	);
 	isa_ok($method, 'Class::MOP::Method');
 
 	$method->();
@@ -49,7 +53,11 @@ BEGIN {
 
 # test around method
 {
-	my $method = Class::MOP::Method->wrap(sub { 4 });
+	my $method = Class::MOP::Method->wrap(
+	    sub { 4 },
+	    package_name => 'main',
+	    name         => '__ANON__',	
+	);
 	isa_ok($method, 'Class::MOP::Method');
 	
 	is($method->(), 4, '... got the right value from the wrapped method');	
@@ -78,7 +86,11 @@ BEGIN {
 {
 	my @tracelog;
 	
-	my $method = Class::MOP::Method->wrap(sub { push @tracelog => 'primary' });
+	my $method = Class::MOP::Method->wrap(
+	    sub { push @tracelog => 'primary' },
+	    package_name => 'main',
+	    name         => '__ANON__',	
+	);
 	isa_ok($method, 'Class::MOP::Method');
 	
 	my $wrapped = Class::MOP::Method::Wrapped->wrap($method);