From: Fuji, Goro <gfuji@cpan.org>
Date: Thu, 23 Sep 2010 10:15:07 +0000 (+0900)
Subject: Inheitance of non-Mouse classes now produces wranings
X-Git-Tag: 0.71~29
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=902174eb6dc2afbe8a2b8fb0a27446b3276787d8;p=gitmo%2FMouse.git

Inheitance of non-Mouse classes now produces wranings
---

diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm
index 2b535db..187ba00 100644
--- a/lib/Mouse/Meta/Class.pm
+++ b/lib/Mouse/Meta/Class.pm
@@ -56,16 +56,25 @@ sub superclasses {
     if (@_) {
         foreach my $super(@_){
             Mouse::Util::load_class($super);
-            my $meta = Mouse::Util::get_metaclass_by_name($super);
 
-            next if not defined $meta;
+            my $meta = Mouse::Util::get_metaclass_by_name($super);
+            unless(defined $meta) {
+                # checks if $super is a foreign class (i.e. non-Mouse class)
+                my $mm = $super->can('meta');
+                if(!($mm && $mm == \&Mouse::Util::meta)) {
+                    if($super->can('new') or $super->can('DESTROY')) {
+                        $self->inherit_from_foreign_class($super);
+                    }
+                }
+                next;
+            }
 
             if(Mouse::Util::is_a_metarole($meta)){
                 $self->throw_error("You cannot inherit from a Mouse Role ($super)");
             }
 
+            # checks and fixes in metaclass compatiility
             next if $self->isa(ref $meta); # _superclass_meta_is_compatible
-
             $self->_reconcile_with_superclass_meta($meta);
         }
         @{ $self->{superclasses} } = @_;
@@ -73,6 +82,15 @@ sub superclasses {
 
     return @{ $self->{superclasses} };
 }
+
+sub inherit_from_foreign_class {
+    my($class, $super) = @_;
+    Carp::carp("You inherit from non-Mouse class ($super),"
+        . " but it is unlikely to work correctly."
+        . " Please concider to use MouseX::Foreign");
+    return;
+}
+
 my @MetaClassTypes = (
     'attribute',   # Mouse::Meta::Attribute
     'method',      # Mouse::Meta::Method
diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm
index bb8faa4..be07d80 100755
--- a/lib/Mouse/Meta/Module.pm
+++ b/lib/Mouse/Meta/Module.pm
@@ -38,6 +38,9 @@ sub reinitialize {
     ($package_name && !ref($package_name))
         || $class->throw_error("You must pass a package name and it cannot be blessed");
 
+    if(exists $METAS{$package_name}) {
+        unshift @args, %{ $METAS{$package_name} };
+    }
     delete $METAS{$package_name};
     return $class->initialize($package_name, @args);
 }
diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm
index 307531a..6d107da 100644
--- a/lib/Mouse/Util.pm
+++ b/lib/Mouse/Util.pm
@@ -346,6 +346,7 @@ sub dump :method {
     $dd->Maxdepth(defined($maxdepth) ? $maxdepth : 3);
     $dd->Indent(1);
     $dd->Sortkeys(1);
+    $dd->Quotekeys(0);
     return $dd->Dump();
 }
 
diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs
index 431d7c5..8bb69c5 100644
--- a/xs-src/Mouse.xs
+++ b/xs-src/Mouse.xs
@@ -445,6 +445,16 @@ mouse_get_modifier_storage(pTHX_
     return (AV*)SvRV(storage_ref);
 }
 
+static void
+XS_Mouse_value_holder(pTHX_ CV* const cv PERL_UNUSED_DECL) {
+    dVAR; dXSARGS;
+    SV* const value = (SV*)XSANY.any_ptr;
+    assert(value);
+    PERL_UNUSED_VAR(items);
+    ST(0) = value;
+    XSRETURN(1);
+}
+
 DECL_BOOT(Mouse__Util);
 DECL_BOOT(Mouse__Util__TypeConstraints);
 DECL_BOOT(Mouse__Meta__Method__Accessor__XS);
@@ -455,6 +465,7 @@ MODULE = Mouse  PACKAGE = Mouse
 PROTOTYPES: DISABLE
 
 BOOT:
+{
     mouse_package   = newSVpvs_share("package");
     mouse_namespace = newSVpvs_share("namespace");
     mouse_methods   = newSVpvs_share("methods");
@@ -468,7 +479,7 @@ BOOT:
     CALL_BOOT(Mouse__Util__TypeConstraints);
     CALL_BOOT(Mouse__Meta__Method__Accessor__XS);
     CALL_BOOT(Mouse__Meta__Attribute);
-
+}
 
 MODULE = Mouse  PACKAGE = Mouse::Meta::Module
 
@@ -523,9 +534,24 @@ CODE:
     (void)set_slot(methods, name, code); /* $self->{methods}{$name} = $code */
 }
 
+void
+add_class_accessor(SV* self, SV* name)
+CODE:
+{
+    SV* const klass = mouse_call0(self, mouse_name);
+    const char* fq_name = form("%"SVf"::%"SVf, klass, name);
+    STRLEN keylen;
+    const char* const key = SvPV_const(name, keylen);
+    mouse_simple_accessor_generate(aTHX_ fq_name, key, keylen,
+        XS_Mouse_inheritable_class_accessor, NULL, 0);
+}
+
 MODULE = Mouse  PACKAGE = Mouse::Meta::Class
 
 BOOT:
+{
+    CV* xsub;
+
     INSTALL_SIMPLE_READER(Class, roles);
     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Class, is_anon_class, anon_serial_id);
     INSTALL_SIMPLE_READER(Class, is_immutable);
@@ -537,10 +563,17 @@ BOOT:
     INSTALL_CLASS_HOLDER(Class, constructor_class,    "Mouse::Meta::Method::Constructor::XS");
     INSTALL_CLASS_HOLDER(Class, destructor_class,     "Mouse::Meta::Method::Destructor::XS");
 
-    newCONSTSUB(gv_stashpvs("Mouse::Meta::Method::Constructor::XS", TRUE), "_generate_constructor",
-        newRV_inc((SV*)get_cvs("Mouse::Object::new", TRUE)));
-    newCONSTSUB(gv_stashpvs("Mouse::Meta::Method::Destructor::XS", TRUE), "_generate_destructor",
-        newRV_inc((SV*)get_cvs("Mouse::Object::DESTROY", TRUE)));
+    xsub = newXS("Mouse::Meta::Method::Constructor::XS::_generate_constructor",
+        XS_Mouse_value_holder, file);
+    CvXSUBANY(xsub).any_ptr
+        = newRV_inc((SV*)get_cvs("Mouse::Object::new", GV_ADD));
+
+    xsub = newXS("Mouse::Meta::Method::Destructor::XS::_generate_destructor",
+        XS_Mouse_value_holder, file);
+    CvXSUBANY(xsub).any_ptr
+        = newRV_inc((SV*)get_cvs("Mouse::Object::DESTROY", GV_ADD));
+}
+
 
 void
 linearized_isa(SV* self)