#if PERL_BCDVERSION >= 0x5008005
#define LooksLikeNumber(sv) looks_like_number(sv)
#else
-#define LooksLikeNumber(sv) ( SvPOKp(sv) ? looks_like_number(sv) : SvNIOKp(sv) )
+#define LooksLikeNumber(sv) ( SvPOKp(sv) ? looks_like_number(sv) : (I32)SvNIOKp(sv) )
#endif
#ifndef SvRXOK
return LooksLikeNumber(sv);
}
+static int
+S_nv_is_integer(pTHX_ NV const nv) {
+ if(nv == (NV)(IV)nv){
+ return TRUE;
+ }
+ else {
+ char buf[64]; /* Must fit sprintf/Gconvert of longest NV */
+ char* p;
+ Gconvert(nv, NV_DIG, 0, buf);
+ p = &buf[0];
+
+ /* -?[0-9]+ */
+ if(*p == '-') p++;
+
+ while(*p){
+ if(!isDIGIT(*p)){
+ return FALSE;
+ }
+ p++;
+ }
+ return TRUE;
+ }
+}
+
int
mouse_tc_Int(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
assert(sv);
if(SvIOKp(sv)){
return TRUE;
}
- else if(SvNOKp(sv)){
- NV const nv = SvNVX(sv);
- return nv > 0 ? (nv == (NV)(UV)nv) : (nv == (NV)(IV)nv);
+ 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);
SV* const tc = *av_fetch(types, i, TRUE);
SV* const c = get_slots(tc, "compiled_type_constraint");
if(!(c && mouse_tc_CodeRef(aTHX_ NULL, c))){
- sv_dump(self);
- croak("'%"SVf"' has no compiled type constraint", self);
+ mouse_throw_error(self, c, "'%"SVf"' has no compiled type constraint", self);
}
av_push(union_checks, newSVsv(c));
}
(void)set_slots(self, "compiled_type_constraint", check);
}
+bool
+check(SV* self, SV* sv)
+CODE:
+{
+ SV* const check = get_slots(self, "compiled_type_constraint");
+ if(!(check && mouse_tc_CodeRef(aTHX_ NULL, check))){
+ mouse_throw_error(self, check, "'%"SVf"' has no compiled type constraint", self);
+ }
+ RETVAL = mouse_tc_check(aTHX_ check, sv) ? TRUE : FALSE;
+}
+OUTPUT:
+ RETVAL
+