From: Jesse Luehrs <doy@tozt.net>
Date: Thu, 23 Sep 2010 04:59:40 +0000 (-0500)
Subject: also allow suppressing the meta method during CMOP::Class->create
X-Git-Tag: 1.09~39
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c63cad06c1893d37e85590343a83d1df6c8e9c70;p=gitmo%2FClass-MOP.git

also allow suppressing the meta method during CMOP::Class->create
---

diff --git a/Changes b/Changes
index 2bfa201..51a211d 100644
--- a/Changes
+++ b/Changes
@@ -2,8 +2,8 @@ Revision history for Perl extension Class-MOP.
 
   [ENHANCEMENTS]
 
-  * It's now possible to tell the metaclass pragma to not install a 'meta'
-    method into classes that use it. (doy)
+  * It's now possible to tell Class::MOP::Class->create and the metaclass
+    pragma to not install a 'meta' method into classes they manipulate. (doy)
 
   [OTHER]
 
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 15f6801..5743fa2 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -483,6 +483,7 @@ sub create {
         superclasses
         attributes
         methods
+        no_meta
         version
         authority
     )};
@@ -501,7 +502,7 @@ sub create {
                 if caller =~ /Class::MOP|metaclass/;
         }
         $class->initialize(ref($_[0]) || $_[0]);
-    });
+    }) unless $options{no_meta};
 
     $meta->superclasses(@{$options{superclasses}})
         if exists $options{superclasses};
@@ -1410,6 +1411,10 @@ hash reference are method names and values are subroutine references.
 
 An optional array reference of L<Class::MOP::Attribute> objects.
 
+=item * no_meta
+
+If true, a C<meta> method will not be installed into the class.
+
 =back
 
 =item B<< Class::MOP::Class->create_anon_class(%options) >>
diff --git a/t/090_no_meta_method.t b/t/090_no_meta_method.t
index a28c027..631442d 100644
--- a/t/090_no_meta_method.t
+++ b/t/090_no_meta_method.t
@@ -6,15 +6,26 @@ use Test::Exception;
 use Class::MOP;
 
 {
-    package Foo;
-    use metaclass no_meta => 1;
+    {
+        package Foo;
+        use metaclass no_meta => 1;
+    }
+
+    my $meta = Class::MOP::class_of('Foo');
+    ok(!$meta->has_method('meta'), "no meta method was installed");
+    $meta->add_method(meta => sub { die 'META' });
+    lives_ok { $meta->find_method_by_name('meta') } "can do meta-level stuff";
+    lives_ok { $meta->make_immutable } "can do meta-level stuff";
+    lives_ok { $meta->class_precedence_list } "can do meta-level stuff";
 }
 
-my $meta = Class::MOP::class_of('Foo');
-ok(!$meta->has_method('meta'), "no meta method was installed");
-$meta->add_method(meta => sub { die 'META' });
-lives_ok { $meta->find_method_by_name('meta') } "can do meta-level stuff";
-lives_ok { $meta->make_immutable } "can do meta-level stuff";
-lives_ok { $meta->class_precedence_list } "can do meta-level stuff";
+{
+    my $meta = Class::MOP::Class->create('Bar', no_meta => 1);
+    ok(!$meta->has_method('meta'), "no meta method was installed");
+    $meta->add_method(meta => sub { die 'META' });
+    lives_ok { $meta->find_method_by_name('meta') } "can do meta-level stuff";
+    lives_ok { $meta->make_immutable } "can do meta-level stuff";
+    lives_ok { $meta->class_precedence_list } "can do meta-level stuff";
+}
 
 done_testing;