Fix magic handling in type constraints (reported by sunnavy)
gfx [Sun, 31 Jan 2010 07:44:43 +0000 (16:44 +0900)]
t/001_mouse/066-magic.t [new file with mode: 0644]
xs-src/MouseTypeConstraints.xs

diff --git a/t/001_mouse/066-magic.t b/t/001_mouse/066-magic.t
new file mode 100644 (file)
index 0000000..b4460d0
--- /dev/null
@@ -0,0 +1,42 @@
+#!perl
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+use Tie::Scalar;
+
+{
+    package MyClass;
+    use Mouse;
+
+    has foo => (
+        is  => 'rw',
+        isa => 'Int',
+    );
+    has bar => (
+        is  => 'rw',
+        isa => 'Maybe[Int]',
+    );
+}
+
+sub ts_init {
+    tie $_[0], 'Tie::StdScalar', $_[1];
+}
+
+ts_init(my $x, 10);
+
+my $o = MyClass->new();
+is(eval{ $o->foo($x) }, 10)
+    or diag("Error: $@");
+
+ts_init($x, 'foo');
+
+eval{
+    $o->bar($x);
+};
+isnt $@, '';
+
+ts_init $x, 42;
+is(eval{ $o->bar($x) }, 42)
+    or diag("Error: $@");
+
index 08df0e8..8b94c85 100644 (file)
 
 typedef int (*check_fptr_t)(pTHX_ SV* const data, SV* const sv);
 
+/*
+    NOTE: mouse_tc_check() handles GETMAGIC
+*/
 int
 mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) {
     CV* const cv = (CV*)SvRV(tc_code);
     assert(SvTYPE(cv) == SVt_PVCV);
 
+    SvGETMAGIC(sv);
     if(CvXSUB(cv) == XS_Mouse_constraint_check){ /* built-in type constraints */
         MAGIC* const mg = (MAGIC*)CvXSUBANY(cv).any_ptr;
 
@@ -244,7 +248,6 @@ mouse_parameterized_ArrayRef(pTHX_ SV* const param, SV* const sv) {
         I32 i;
         for(i = 0; i < len; i++){
             SV* const value = *av_fetch(av, i, TRUE);
-            SvGETMAGIC(value);
             if(!mouse_tc_check(aTHX_ param, value)){
                 return FALSE;
             }
@@ -263,7 +266,6 @@ mouse_parameterized_HashRef(pTHX_ SV* const param, SV* const sv) {
         hv_iterinit(hv);
         while((he = hv_iternext(hv))){
             SV* const value = hv_iterval(hv, he);
-            SvGETMAGIC(value);
             if(!mouse_tc_check(aTHX_ param, value)){
                 hv_iterinit(hv); /* reset */
                 return FALSE;