From: Dave Rolsky <autarch@urth.org>
Date: Fri, 16 Sep 2011 15:39:00 +0000 (-0500)
Subject: Add a Method->is_stub method and some tests for it
X-Git-Tag: 2.0300~64
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=213c00cce310530ddd044ca84a087e0c906e5a96;p=gitmo%2FMoose.git

Add a Method->is_stub method and some tests for it
---

diff --git a/mop.c b/mop.c
index 5b14f8f..abbc6bb 100644
--- a/mop.c
+++ b/mop.c
@@ -210,6 +210,7 @@ static struct {
     DECLARE_KEY(insertion_order),
     DECLARE_KEY(instance_metaclass),
     DECLARE_KEY(is_inline),
+    DECLARE_KEY(is_stub),
     DECLARE_KEY(method_metaclass),
     DECLARE_KEY(methods),
     DECLARE_KEY(name),
diff --git a/mop.h b/mop.h
index 6dcd91d..734184f 100644
--- a/mop.h
+++ b/mop.h
@@ -49,6 +49,7 @@ typedef enum {
     KEY_insertion_order,
     KEY_instance_metaclass,
     KEY_is_inline,
+    KEY_is_stub,
     KEY_method_metaclass,
     KEY_methods,
     KEY_name,
diff --git a/t/cmop/method.t b/t/cmop/method.t
index f70df12..dd15b8a 100644
--- a/t/cmop/method.t
+++ b/t/cmop/method.t
@@ -27,6 +27,8 @@ is( $method->original_name, '__ANON__',
 is( $method->original_fully_qualified_name, 'main::__ANON__',
     '... the original_fully_qualified_name is the same as fully_qualified_name'
 );
+ok( !$method->is_stub,
+    '... the method is not a stub' );
 
 isnt( exception { Class::MOP::Method->wrap }, undef, q{... can't call wrap() without some code} );
 isnt( exception { Class::MOP::Method->wrap( [] ) }, undef, q{... can't call wrap() without some code} );
@@ -146,4 +148,25 @@ is($wrapped->name, '__ANON__', 'method name copied properly');
 my $wrapped2 = Method::Subclass->wrap($method, foo => 'baz', name => 'FOO');
 is($wrapped2->name, 'FOO', 'got a new method name');
 
+{
+    package Foo;
+
+    sub full {1}
+    sub stub;
+}
+
+{
+    my $meta = Class::MOP::Class->initialize('Foo');
+
+    ok( $meta->has_method($_), "Foo class has $_ method" )
+        for qw( full stub );
+
+    my $full = $meta->get_method('full');
+    ok( !$full->is_stub, 'full is not a stub' );
+
+    my $stub = $meta->get_method('stub');
+
+    ok( $stub->is_stub, 'stub is a stub' );
+}
+
 done_testing;
diff --git a/xs/Method.xs b/xs/Method.xs
index 590cd06..5ffa467 100644
--- a/xs/Method.xs
+++ b/xs/Method.xs
@@ -8,3 +8,16 @@ BOOT:
     INSTALL_SIMPLE_READER(Method, name);
     INSTALL_SIMPLE_READER(Method, package_name);
     INSTALL_SIMPLE_READER(Method, body);
+
+bool
+is_stub(self)
+    SV *self
+
+    PREINIT:
+        CV *const body = (CV *)SvRV( HeVAL( hv_fetch_ent((HV *)SvRV(self), KEY_FOR(body), 0, HASH_FOR(body)) ) );
+
+    CODE:
+        RETVAL = !( CvISXSUB(body) || CvROOT(body) );
+
+    OUTPUT:
+        RETVAL