From: Dave Rolsky <autarch@urth.org>
Date: Mon, 1 Sep 2008 15:03:42 +0000 (+0000)
Subject: Make sure all the XS methods die when called as a class method, and test for this
X-Git-Tag: 0.65~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=988fb42e6098c592d1bf64e4c497434417b39d97;p=gitmo%2FClass-MOP.git

Make sure all the XS methods die when called as a class method, and test for this
---

diff --git a/Changes b/Changes
index b914f77..56505da 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,15 @@
 Revision history for Perl extension Class-MOP.
 
+0.65
+    * Class::MOP::Method
+      - Added name and package_name XS accessors, and make sure all
+        the XS and Perl versions work the same way. (Dave Rolsky)
+
+    * MOP.xs
+      - The XS versions of various methods just returned undef when
+        called class methods, rather than dying like the pure Perl
+        versions. (Dave Rolsky)
+
 0.64_07 Fri August 29, 2008
     * Class::MOP
       - Silenced warnings that managed to break Moose tests when XS
diff --git a/MOP.xs b/MOP.xs
index 942b378..ae34df5 100644
--- a/MOP.xs
+++ b/MOP.xs
@@ -85,6 +85,9 @@ get_all_package_symbols(self, ...)
         SV *type_filter = NULL;
         register HE *he;
     PPCODE:
+        if (! SvROK(self)) {
+            die("Cannot call get_all_package_symbols as a class method");
+        }
 
         switch ( GIMME_V ) {
             case G_VOID: return; break;
@@ -95,7 +98,7 @@ get_all_package_symbols(self, ...)
 
         PUTBACK;
 
-        if (SvROK(self) && (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)))
+        if (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package))
             stash = gv_stashsv(HeVAL(he),0);
 
         if ( stash ) {
@@ -169,7 +172,11 @@ name(self)
     PREINIT:
         register HE *he;
     PPCODE:
-        if (SvROK(self) && (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)))
+        if (! SvROK(self)) {
+            die("Cannot call name as a class method");
+        }
+
+        if (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package))
             XPUSHs(HeVAL(he));
         else
             ST(0) = &PL_sv_undef;
@@ -182,7 +189,11 @@ name(self)
     PREINIT:
         register HE *he;
     PPCODE:
-        if (SvROK(self) && (he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name)))
+        if (! SvROK(self)) {
+            die("Cannot call name as a class method");
+        }
+
+        if (he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name))
             XPUSHs(HeVAL(he));
         else
             ST(0) = &PL_sv_undef;
diff --git a/t/020_attribute.t b/t/020_attribute.t
index 9d9c771..4dfbc2e 100644
--- a/t/020_attribute.t
+++ b/t/020_attribute.t
@@ -5,13 +5,15 @@ use warnings;
 
 use Scalar::Util 'reftype', 'blessed';
 
-use Test::More tests => 101;
+use Test::More tests => 100;
 use Test::Exception;
 
-BEGIN {
-    use_ok('Class::MOP');
-    use_ok('Class::MOP::Attribute');
-}
+use Class::MOP;
+use Class::MOP::Attribute;
+
+
+dies_ok { Class::MOP::Attribute->name } q{... can't call name() as a class method};
+
 
 {
     my $attr = Class::MOP::Attribute->new('$foo');
diff --git a/t/080_meta_package.t b/t/080_meta_package.t
index 2f4271c..4a8b03e 100644
--- a/t/080_meta_package.t
+++ b/t/080_meta_package.t
@@ -6,10 +6,12 @@ use warnings;
 use Test::More tests => 97;
 use Test::Exception;
 
-BEGIN {
-    use_ok('Class::MOP');        
-    use_ok('Class::MOP::Package');            
-}
+use Class::MOP;
+use Class::MOP::Package;
+
+
+dies_ok { Class::MOP::Package->get_all_package_symbols } q{... can't call get_all_package_symbols() as a class method};
+dies_ok { Class::MOP::Package->name } q{... can't call name() as a class method};
 
 {
     package Foo;