allow not importing a meta method
Jesse Luehrs [Tue, 6 Jul 2010 05:50:15 +0000 (00:50 -0500)]
lib/metaclass.pm
t/090_no_meta_method.t [new file with mode: 0644]

index 1eca64d..f165b86 100644 (file)
@@ -41,6 +41,7 @@ sub import {
 
     # create a meta object so we can install &meta
     my $meta = $metaclass->initialize($package => %options);
+    my $should_install = !delete $options{no_meta};
     $meta->add_method('meta' => sub {
         # we must re-initialize so that it
         # works as expected in subclasses,
@@ -48,7 +49,7 @@ sub import {
         # singletons, this is not really a
         # big deal anyway.
         $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
-    });
+    }) if $should_install;
 }
 
 1;
diff --git a/t/090_no_meta_method.t b/t/090_no_meta_method.t
new file mode 100644 (file)
index 0000000..a28c027
--- /dev/null
@@ -0,0 +1,20 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+use Class::MOP;
+
+{
+    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";
+
+done_testing;