add strict_constructor => Bool optin to make_immutable (EXPERIMENTAL) blead
gfx [Sat, 26 Dec 2009 09:02:44 +0000 (18:02 +0900)]
lib/Mouse/Meta/Class.pm
xs-src/Mouse.xs

index 4940eb0..952f598 100644 (file)
@@ -245,6 +245,8 @@ sub make_immutable {
 
     $self->{is_immutable}++;
 
+    $self->{_strict_constructor} = $args{strict_constructor};
+
     if ($args{inline_constructor}) {
         my $c = $self->constructor_class;
         Mouse::Util::load_class($c);
index 74ef113..cea3275 100644 (file)
@@ -20,6 +20,9 @@ enum mouse_xc_flags_t {
     MOUSEf_XC_IS_ANON        = 0x0002,
     MOUSEf_XC_HAS_BUILDARGS  = 0x0004,
 
+    MOUSEf_XC_HAS_STRICT_CONSTRUCTOR
+                             = 0x0008,
+
     MOUSEf_XC_mask           = 0xFFFF /* not used */
 };
 
@@ -113,6 +116,10 @@ mouse_class_update_xc(pTHX_ SV* const metaclass PERL_UNUSED_DECL, HV* const stas
         flags |= MOUSEf_XC_HAS_BUILDARGS;
     }
 
+    if(predicate_calls(metaclass, "_has_strict_constructor")){
+        flags |= MOUSEf_XC_HAS_STRICT_CONSTRUCTOR;
+    }
+
     av_store(xc, MOUSE_XC_FLAGS,       newSVuv(flags));
     av_store(xc, MOUSE_XC_ATTRALL,     (SV*)attrall);
     av_store(xc, MOUSE_XC_BUILDALL,    (SV*)buildall);
@@ -334,7 +341,7 @@ mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const
         }
     }
 
-    if(used < HvUSEDKEYS(args)){
+    if(MOUSE_xc_flags(xc) & MOUSEf_XC_HAS_STRICT_CONSTRUCTOR && used < HvUSEDKEYS(args)){
         mouse_report_unmatched_keys(aTHX_ meta, attrs, args);
     }
 
@@ -488,6 +495,7 @@ BOOT:
     INSTALL_SIMPLE_READER(Class, roles);
     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Class, is_anon_class, anon_serial_id);
     INSTALL_SIMPLE_READER(Class, is_immutable);
+    INSTALL_SIMPLE_READER_WITH_KEY(Class, has_strict_constructor, _strict_constructor);
 
     INSTALL_CLASS_HOLDER(Class, method_metaclass,     "Mouse::Meta::Method");
     INSTALL_CLASS_HOLDER(Class, attribute_metaclass,  "Mouse::Meta::Attribute");