From: Jesse Luehrs <doy@tozt.net>
Date: Thu, 23 Sep 2010 01:26:07 +0000 (-0500)
Subject: make lack of a meta method testable
X-Git-Tag: 1.09~41
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=10c5d753f5f8041189aa8fddaf3b9b41ef948f50;p=gitmo%2FClass-MOP.git

make lack of a meta method testable
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index cbae697..3a29be4 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -25,6 +25,10 @@ BEGIN {
         ? sub () { 0 }
         : sub () { 1 };
 
+    *DEBUG_NO_META = ($ENV{DEBUG_NO_META})
+        ? sub () { 1 }
+        : sub () { 0 };
+
     # this is either part of core or set up appropriately by MRO::Compat
     *check_package_cache_flag = \&mro::get_pkg_gen;
 }
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 67d903b..15f6801 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -492,6 +492,14 @@ sub create {
 
     # FIXME totally lame
     $meta->add_method('meta' => sub {
+        if (Class::MOP::DEBUG_NO_META()) {
+            my ($self) = @_;
+            if (my $meta = try { $self->SUPER::meta }) {
+                return $meta if $meta->isa('Class::MOP::Class');
+            }
+            confess "'meta' method called by MOP internals"
+                if caller =~ /Class::MOP|metaclass/;
+        }
         $class->initialize(ref($_[0]) || $_[0]);
     });
 
diff --git a/lib/metaclass.pm b/lib/metaclass.pm
index f165b86..02bfb5c 100644
--- a/lib/metaclass.pm
+++ b/lib/metaclass.pm
@@ -6,6 +6,7 @@ use warnings;
 
 use Carp         'confess';
 use Scalar::Util 'blessed';
+use Try::Tiny;
 
 our $VERSION   = '1.08';
 $VERSION = eval $VERSION;
@@ -48,6 +49,14 @@ sub import {
         # since metaclass instances are
         # singletons, this is not really a
         # big deal anyway.
+        if (Class::MOP::DEBUG_NO_META()) {
+            my ($self) = @_;
+            if (my $meta = try { $self->SUPER::meta }) {
+                return $meta if $meta->isa('Class::MOP::Class');
+            }
+            confess "'meta' method called by MOP internals"
+                if caller =~ /Class::MOP|metaclass/;
+        }
         $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
     }) if $should_install;
 }
diff --git a/xt/author/pod_coverage.t b/xt/author/pod_coverage.t
index 42d7426..c4edf97 100644
--- a/xt/author/pod_coverage.t
+++ b/xt/author/pod_coverage.t
@@ -15,7 +15,12 @@ my @modules = all_modules();
 plan tests => scalar @modules;
 
 my %trustme = (
-    'Class::MOP' => [ 'HAVE_ISAREV', 'subname', 'in_global_destruction' ],
+    'Class::MOP' => [
+        'DEBUG_NO_META',
+        'HAVE_ISAREV',
+        'subname',
+        'in_global_destruction',
+    ],
     'Class::MOP::Attribute' => ['process_accessors'],
     'Class::MOP::Class'     => [
         # deprecated