From: Fuji, Goro Date: Mon, 8 Nov 2010 02:30:43 +0000 (+0900) Subject: Fix 'Int' type constraint for dualvars (like $!) X-Git-Tag: 0.83~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7f881031a63a80846be81c6f06e7285095582782;p=gitmo%2FMouse.git Fix 'Int' type constraint for dualvars (like $!) --- diff --git a/t/001_mouse/071_tc_dualvar.t b/t/001_mouse/071_tc_dualvar.t new file mode 100644 index 0000000..44f468f --- /dev/null +++ b/t/001_mouse/071_tc_dualvar.t @@ -0,0 +1,30 @@ +#!perl -w +use strict; +use Test::More; +use Errno qw(ENOENT EPERM); +{ + package Foo; + use Mouse; + has intval => ( + is => 'rw', + isa => 'Int', + ); + has numval => ( + is => 'rw', + isa => 'Num', + ); +} + +my $foo = Foo->new(); + +for my $e(ENOENT, EPERM) { + $! = $e; + eval { $foo->intval($!) }; + like $@, qr/Validation failed for 'Int'/, 'Int for dualvar'; + + $! = $e; + eval { $foo->numval($!) }; + like $@, qr/Validation failed for 'Num'/, 'Num for dualvar'; +} +done_testing; + diff --git a/xs-src/MouseTypeConstraints.xs b/xs-src/MouseTypeConstraints.xs index 78ce1fd..f7e99a8 100644 --- a/xs-src/MouseTypeConstraints.xs +++ b/xs-src/MouseTypeConstraints.xs @@ -70,21 +70,21 @@ mouse_tc_Bool(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { assert(sv); if(sv_true(sv)){ - if(SvIOKp(sv)){ + if(SvPOKp(sv)){ /* "1" */ + return SvCUR(sv) == 1 && SvPVX(sv)[0] == '1'; + } + else if(SvIOKp(sv)){ return SvIVX(sv) == 1; } else if(SvNOKp(sv)){ return SvNVX(sv) == 1.0; } - else if(SvPOKp(sv)){ /* "1" */ - return SvCUR(sv) == 1 && SvPVX(sv)[0] == '1'; - } else{ return FALSE; } } else{ - /* any false value must be boolean */ + /* any false value is a boolean */ return TRUE; } } @@ -140,18 +140,16 @@ S_nv_is_integer(pTHX_ NV const nv) { int mouse_tc_Int(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { assert(sv); - if(SvIOKp(sv)){ + if(SvPOKp(sv)){ + int const num_type = grok_number(SvPVX(sv), SvCUR(sv), NULL); + return num_type && !(num_type & IS_NUMBER_NOT_INT); + } + else if(SvIOKp(sv)){ return TRUE; } else if(SvNOKp(sv)) { return S_nv_is_integer(aTHX_ SvNVX(sv)); } - else if(SvPOKp(sv)){ - int const num_type = grok_number(SvPVX(sv), SvCUR(sv), NULL); - if(num_type){ - return !(num_type & IS_NUMBER_NOT_INT); - } - } return FALSE; } @@ -162,7 +160,7 @@ mouse_tc_Str(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { } int -mouse_tc_ClassName(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv){ +mouse_tc_ClassName(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv){ assert(sv); return is_class_loaded(sv); } @@ -694,7 +692,7 @@ BOOT: (SV*)gv_fetchpvs( MTC_CLASS "::(\"\"", GV_ADDMULTI, SVt_PVCV ), code_ref ); } - + /* '0+' => '_identity' */ { SV* const code_ref = sv_2mortal(newRV_inc(