File Coverage

src/types.c
Criterion Covered Total %
statement 51 211 24.1
branch 28 212 13.2
condition n/a
subroutine n/a
pod n/a
total 79 423 18.6


line stmt bran cond sub pod time code
1             enum {
2             TYPE_BASE_ANY = 0,
3             TYPE_BASE_DEFINED = 1,
4             TYPE_BASE_REF = 2,
5             TYPE_BASE_BOOL = 3,
6             TYPE_BASE_INT = 4,
7             TYPE_BASE_PZINT = 5,
8             TYPE_BASE_NUM = 6,
9             TYPE_BASE_PZNUM = 7,
10             TYPE_BASE_STR = 8,
11             TYPE_BASE_NESTR = 9,
12             TYPE_BASE_CLASSNAME = 10,
13             TYPE_BASE_OBJECT = 12,
14             TYPE_BASE_SCALARREF = 13,
15             TYPE_BASE_CODEREF = 14,
16              
17             TYPE_OTHER = 15,
18              
19             TYPE_ARRAYREF = 16,
20             TYPE_HASHREF = 32,
21             };
22              
23             static bool
24 13           _S_pv_is_integer (char* const pv) {
25             dTHX;
26             const char* p;
27 13           p = &pv[0];
28              
29             /* -?[0-9]+ */
30 13 50         if(*p == '-') p++;
31              
32 13 50         if (!*p) return FALSE;
33              
34 26 50         while(*p){
35 26 100         if(!isDIGIT(*p)){
36 13           return FALSE;
37             }
38 13           p++;
39             }
40 0           return TRUE;
41             }
42              
43             static bool
44 9           _S_nv_is_integer (NV const nv) {
45             dTHX;
46 9 50         if(nv == (NV)(IV)nv){
47 0           return TRUE;
48             }
49             else {
50             char buf[64]; /* Must fit sprintf/Gconvert of longest NV */
51 9           intptr_t ignored = (intptr_t)Gconvert(nv, NV_DIG, 0, buf);
52             (void)ignored;
53 9           return _S_pv_is_integer(buf);
54             }
55             }
56              
57             bool
58 0           _is_class_loaded (SV* const klass) {
59             dTHX;
60             HV *stash;
61             GV** gvp;
62             HE* he;
63              
64 0 0         if ( !SvPOKp(klass) || !SvCUR(klass) ) { /* XXX: SvPOK does not work with magical scalars */
    0          
65 0           return FALSE;
66             }
67              
68 0           stash = gv_stashsv( klass, FALSE );
69 0 0         if ( !stash ) {
70 0           return FALSE;
71             }
72              
73 0 0         if (( gvp = (GV**)hv_fetchs(stash, "VERSION", FALSE) )) {
74 0 0         if ( isGV(*gvp) && GvSV(*gvp) && SvOK(GvSV(*gvp)) ){
    0          
    0          
75 0           return TRUE;
76             }
77             }
78              
79 0 0         if (( gvp = (GV**)hv_fetchs(stash, "ISA", FALSE) )) {
80 0 0         if ( isGV(*gvp) && GvAV(*gvp) && av_len(GvAV(*gvp)) != -1 ) {
    0          
    0          
81 0           return TRUE;
82             }
83             }
84              
85 0           hv_iterinit(stash);
86 0 0         while (( he = hv_iternext(stash) )) {
87 0           GV* const gv = (GV*)HeVAL(he);
88 0 0         if ( isGV(gv) ) {
89 0 0         if ( GvCVu(gv) ) { /* is GV and has CV */
    0          
90 0           hv_iterinit(stash); /* reset */
91 0           return TRUE;
92             }
93             }
94 0 0         else if ( SvOK(gv) ) { /* is a stub or constant */
95 0           hv_iterinit(stash); /* reset */
96 0           return TRUE;
97             }
98             }
99 0           return FALSE;
100             }
101              
102             /* Full version of check_type */
103             static bool
104 340           check_type(SV* const val, int flags, CV* check_cv)
105             {
106             dTHX;
107             assert(val);
108              
109 340 50         if ( ( flags & TYPE_OTHER ) == TYPE_OTHER ) {
110 0 0         if ( !check_cv ) {
111 0           warn( "Type constraint check coderef gone AWOL so just assuming value passes" );
112 0           return 1;
113             }
114              
115             SV* result;
116              
117 0           dSP;
118 0           ENTER;
119 0           SAVETMPS;
120 0 0         PUSHMARK(SP);
121 0 0         EXTEND(SP, 1);
122 0           PUSHs(sv_2mortal(val));
123 0           PUTBACK;
124 0           int count = call_sv((SV *)check_cv, G_SCALAR|G_EVAL);
125 0           SPAGAIN;
126 0 0         result = count ? POPs : &PL_sv_undef;
127 0           bool return_val = SvTRUE(result);
128 0 0         FREETMPS;
129 0           LEAVE;
130            
131 0           return return_val;
132             }
133            
134 340 50         if ( flags & TYPE_ARRAYREF ) {
135 0 0         if ( !IsArrayRef(val) ) {
    0          
    0          
136 0           return FALSE;
137             }
138 0 0         if ( flags == TYPE_ARRAYREF ) {
139 0           return TRUE;
140             }
141 0           int newflags = flags & ( TYPE_ARRAYREF - 1 );
142 0           AV* const av = (AV*)SvRV(val);
143 0           I32 const len = av_len(av) + 1;
144             I32 i;
145 0 0         for (i = 0; i < len; i++) {
146 0           SV* const subval = *av_fetch(av, i, TRUE);
147 0 0         if ( ! check_type(subval, newflags, NULL) ) {
148 0           return FALSE;
149             }
150             }
151 0           return TRUE;
152             }
153              
154 340 50         if ( flags & TYPE_HASHREF ) {
155 0 0         if ( !IsHashRef(val) ) {
    0          
    0          
156 0           return FALSE;
157             }
158 0 0         if ( flags == TYPE_HASHREF ) {
159 0           return TRUE;
160             }
161 0           int newflags = flags & ( TYPE_HASHREF - 1 );
162 0           HV* const hv = (HV*)SvRV(val);
163             HE* he;
164 0           hv_iterinit(hv);
165 0 0         while ((he = hv_iternext(hv))) {
166 0           SV* const subval = hv_iterval(hv, he);
167 0 0         if ( ! check_type(subval, newflags, NULL) ) {
168 0           hv_iterinit(hv); /* reset */
169 0           return FALSE;
170             }
171             }
172 0           return TRUE;
173             }
174            
175 340           switch ( flags ) {
176 0           case TYPE_BASE_ANY:
177 0           return TRUE;
178 0           case TYPE_BASE_DEFINED:
179 0           return SvOK(val);
180 0           case TYPE_BASE_REF:
181 0 0         return SvOK(val) && SvROK(val);
    0          
182 0           case TYPE_BASE_BOOL: {
183 0 0         if ( SvROK(val) || isGV(val) ) {
    0          
184 0           return FALSE;
185             }
186 0 0         else if ( sv_true( val ) ) {
187 0 0         if ( SvPOKp(val) ) {
188             /* String "1" */
189 0 0         return SvCUR(val) == 1 && SvPVX(val)[0] == '1';
    0          
190             }
191 0 0         else if ( SvIOKp(val) ) {
192             /* Integer 1 */
193 0           return SvIVX(val) == 1;
194             }
195 0 0         else if( SvNOKp(val) ) {
196             /* Float 1.0 */
197 0           return SvNVX(val) == 1.0;
198             }
199             else {
200             /* Another way to check for string "1"??? */
201             STRLEN len;
202 0           char* ptr = SvPV(val, len);
203 0 0         return len == 1 && ptr[0] == '1';
    0          
204             }
205             }
206             else {
207             /* Any non-reference non-true value (0, undef, "", "0")
208             * is a valid Bool. */
209 0           return TRUE;
210             }
211             }
212 340           case TYPE_BASE_INT:
213 340 50         if ( SvOK(val) && !SvROK(val) && !isGV(val) ) {
    100          
    50          
214 339 50         if ( SvPOK(val) ) {
215 0           return _S_pv_is_integer( SvPVX(val) );
216             }
217 339 50         else if ( SvIOK(val) ) {
218 339           return TRUE;
219             }
220 0 0         else if ( SvNOK(val) ) {
221 0           return _S_nv_is_integer( SvNVX(val) );
222             }
223             }
224 1           return FALSE;
225 0           case TYPE_BASE_PZINT: {
226 0 0         if ( (!SvOK(val)) || SvROK(val) || isGV(val) ) {
    0          
    0          
227 0           return FALSE;
228             }
229 0 0         if ( SvPOKp(val) ){
230 0 0         if ( ! _S_pv_is_integer( SvPVX(val) ) ) {
231 0           return FALSE;
232             }
233             }
234 0 0         else if ( SvIOKp(val) ) {
235             /* ok */
236             }
237 0 0         else if ( SvNOKp(val) ) {
238 0 0         if ( ! _S_nv_is_integer( SvNVX(val) ) ) {
239 0           return FALSE;
240             }
241             }
242             STRLEN len;
243 0           char* i = SvPVx(val, len);
244 0 0         return ( (len > 0 && i[0] != '-') ? TRUE : FALSE );
    0          
245             }
246 0           case TYPE_BASE_NUM:
247             /* In Perl We Trust */
248 0           return looks_like_number(val);
249 0           case TYPE_BASE_PZNUM:
250 0 0         if ( ! looks_like_number(val) ) {
251 0           return FALSE;
252             }
253 0           NV numeric = SvNV(val);
254 0           return numeric >= 0.0;
255 0           case TYPE_BASE_STR:
256 0 0         return SvOK(val) && !SvROK(val) && !isGV(val);
    0          
    0          
257 0           case TYPE_BASE_NESTR:
258 0 0         if ( SvOK(val) && !SvROK(val) && !isGV(val) ) {
    0          
    0          
259 0           STRLEN l = sv_len(val);
260 0           return ( (l==0) ? FALSE : TRUE );
261             }
262 0           return FALSE;
263 0           case TYPE_BASE_CLASSNAME:
264 0           return _is_class_loaded(val);
265 0           case TYPE_BASE_OBJECT:
266 0 0         return IsObject(val);
    0          
267 0           case TYPE_BASE_SCALARREF:
268 0 0         return IsScalarRef(val);
    0          
    0          
269 0           case TYPE_BASE_CODEREF:
270 0 0         return IsCodeRef(val);
    0          
    0          
271 0           case TYPE_OTHER:
272 0           croak("PANIC!");
273 0           default:
274 0           croak("PANIC!");
275             }
276             }
277              
278             /* Macro version which falls back to the full version */
279             #define CHECK_TYPE(ok, val, flags, check_cv) \
280             STMT_START { \
281             switch (flags) { \
282             case TYPE_BASE_ANY: \
283             (ok) = TRUE; \
284             break; \
285             \
286             case TYPE_BASE_DEFINED: \
287             (ok) = SvOK(val); \
288             break; \
289             \
290             case TYPE_BASE_REF: \
291             (ok) = SvOK(val) && SvROK(val); \
292             break; \
293             \
294             case TYPE_BASE_BOOL: { \
295             if (SvROK(val) || isGV(val)) { \
296             (ok) = FALSE; \
297             } \
298             else if (sv_true(val)) { \
299             if (SvPOKp(val)) { \
300             (ok) = \
301             SvCUR(val) == 1 && \
302             SvPVX(val)[0] == '1'; \
303             } \
304             else if (SvIOKp(val)) { \
305             (ok) = (SvIVX(val) == 1); \
306             } \
307             else if (SvNOKp(val)) { \
308             (ok) = (SvNVX(val) == 1.0); \
309             } \
310             else { \
311             STRLEN len; \
312             char *ptr = SvPV(val, len); \
313             (ok) = (len == 1 && ptr[0] == '1'); \
314             } \
315             } \
316             else { \
317             (ok) = TRUE; \
318             } \
319             break; \
320             } \
321             \
322             case TYPE_BASE_INT: \
323             if (SvOK(val) && !SvROK(val) && !isGV(val)) { \
324             if (SvPOK(val)) { \
325             (ok) = _S_pv_is_integer(SvPVX(val)); \
326             } \
327             else if (SvIOK(val)) { \
328             (ok) = TRUE; \
329             } \
330             else if (SvNOK(val)) { \
331             (ok) = _S_nv_is_integer(SvNVX(val)); \
332             } \
333             else { \
334             (ok) = FALSE; \
335             } \
336             } \
337             else { \
338             (ok) = FALSE; \
339             } \
340             break; \
341             \
342             case TYPE_BASE_PZINT: { \
343             if (!SvOK(val) || SvROK(val) || isGV(val)) { \
344             (ok) = FALSE; \
345             break; \
346             } \
347             if (SvPOKp(val)) { \
348             if (!_S_pv_is_integer(SvPVX(val))) { \
349             (ok) = FALSE; \
350             break; \
351             } \
352             } \
353             else if (SvNOKp(val)) { \
354             if (!_S_nv_is_integer(SvNVX(val))) { \
355             (ok) = FALSE; \
356             break; \
357             } \
358             } \
359             STRLEN len; \
360             char *i = SvPVx(val, len); \
361             (ok) = (len > 0 && i[0] != '-'); \
362             break; \
363             } \
364             \
365             case TYPE_BASE_NUM: \
366             (ok) = looks_like_number(val); \
367             break; \
368             \
369             case TYPE_BASE_PZNUM: \
370             if (!looks_like_number(val)) { \
371             (ok) = FALSE; \
372             } \
373             else { \
374             NV n = SvNV(val); \
375             (ok) = (n >= 0.0); \
376             } \
377             break; \
378             \
379             case TYPE_BASE_STR: \
380             (ok) = SvOK(val) && !SvROK(val) && !isGV(val); \
381             break; \
382             \
383             case TYPE_BASE_NESTR: \
384             if (SvOK(val) && !SvROK(val) && !isGV(val)) { \
385             STRLEN l = sv_len(val); \
386             (ok) = (l != 0); \
387             } \
388             else { \
389             (ok) = FALSE; \
390             } \
391             break; \
392             \
393             case TYPE_BASE_CLASSNAME: \
394             (ok) = _is_class_loaded(val); \
395             break; \
396             \
397             case TYPE_BASE_OBJECT: \
398             (ok) = IsObject(val); \
399             break; \
400             \
401             case TYPE_BASE_SCALARREF: \
402             (ok) = IsScalarRef(val); \
403             break; \
404             \
405             case TYPE_BASE_CODEREF: \
406             (ok) = IsCodeRef(val); \
407             break; \
408             \
409             case TYPE_ARRAYREF: \
410             (ok) = IsArrayRef(val); \
411             break; \
412             \
413             case TYPE_HASHREF: \
414             (ok) = IsHashRef(val); \
415             break; \
416             \
417             default: \
418             (ok) = check_type(val, flags, check_cv); \
419             break; \
420             } \
421             } STMT_END
422              
423             #define TRY_COERCE_TYPE(ok, val, flags, check_cv, coercion_cv) \
424             STMT_START { \
425             if (!(ok) && (coercion_cv) != NULL) { \
426             dSP; \
427             ENTER; SAVETMPS; \
428             PUSHMARK(SP); \
429             XPUSHs(val); \
430             PUTBACK; \
431             SV *newval = NULL; \
432             I32 count = call_sv((SV*)(coercion_cv), G_SCALAR); \
433             SPAGAIN; \
434             if (count > 0) { \
435             newval = newSVsv(POPs); \
436             if (check_type(newval, flags, check_cv)) { \
437             ok = TRUE; \
438             val = newval; \
439             } \
440             } \
441             FREETMPS; LEAVE; \
442             } \
443             } STMT_END
444              
445             const char *
446 9           type_name(I32 type_flags)
447             {
448             static char buf[64];
449              
450             /* Extract container flags */
451 9           bool is_array = (type_flags & TYPE_ARRAYREF) != 0;
452 9           bool is_hash = (type_flags & TYPE_HASHREF) != 0;
453              
454             /* Not supported */
455 9 50         if (is_array && is_hash) {
    0          
456 0           return "Unknown";
457             }
458              
459             /* Extract base type (low 4 bits) */
460 9           I32 base = type_flags & 0x0F;
461              
462             const char *base_name;
463              
464 9           switch (base) {
465 0           case TYPE_BASE_ANY: base_name = "Any"; break;
466 0           case TYPE_BASE_DEFINED: base_name = "Defined"; break;
467 0           case TYPE_BASE_REF: base_name = "Ref"; break;
468 0           case TYPE_BASE_BOOL: base_name = "Bool"; break;
469 9           case TYPE_BASE_INT: base_name = "Int"; break;
470 0           case TYPE_BASE_PZINT: base_name = "PositiveOrZeroInt"; break;
471 0           case TYPE_BASE_NUM: base_name = "Num"; break;
472 0           case TYPE_BASE_PZNUM: base_name = "PositiveOrZeroNum"; break;
473 0           case TYPE_BASE_STR: base_name = "Str"; break;
474 0           case TYPE_BASE_NESTR: base_name = "NonEmptyStr"; break;
475 0           case TYPE_BASE_CLASSNAME: base_name = "ClassName"; break;
476 0           case TYPE_BASE_OBJECT: base_name = "Object"; break;
477 0           case TYPE_BASE_SCALARREF: base_name = "ScalarRef"; break;
478 0           case TYPE_BASE_CODEREF: base_name = "CodeRef"; break;
479 0           case TYPE_OTHER: base_name = "Unknown"; break;
480 0           default: base_name = "Unknown"; break;
481             }
482              
483 9 50         if (is_array) {
484 0           snprintf(buf, sizeof(buf), "ArrayRef[%s]", base_name);
485 0           return buf;
486             }
487              
488 9 50         if (is_hash) {
489 0           snprintf(buf, sizeof(buf), "HashRef[%s]", base_name);
490 0           return buf;
491             }
492              
493 9           return base_name;
494             }
495              
496             void
497 9           type_error(SV *val, char *varname, I32 ix,
498             I32 element_type, SV *element_type_tiny)
499             {
500             dTHX;
501 9           dSP;
502              
503             /* Normalize val */
504 9 50         if (!val)
505 0           val = &PL_sv_undef;
506              
507             /* Build full_varname */
508             SV *full_varname;
509              
510 9 50         if (varname) {
511 9 50         if (ix < 0) {
512 0           full_varname = newSVpv(varname, 0);
513             }
514             else {
515 9           full_varname = newSVpvf("%s[%" IVdf "]", varname, (IV)ix);
516             }
517             }
518             else {
519 0           full_varname = newSVpvs("$_");
520             }
521              
522 9           ENTER;
523 9           SAVETMPS;
524              
525 9 50         PUSHMARK(SP);
526              
527 9 50         if (element_type_tiny && SvROK(element_type_tiny) && SvOBJECT(SvRV(element_type_tiny)))
    0          
    0          
528             {
529             /* invocant: blessed Type::Tiny object */
530 0 0         XPUSHs(element_type_tiny);
531             /* undef as type name because _failed_check can extract from invocant */
532 0 0         XPUSHs(&PL_sv_undef);
533             /* failing value */
534 0 0         XPUSHs(sv_2mortal(newSVsv(val)));
535             /* varname => $full_varname */
536 0 0         XPUSHs(sv_2mortal(newSVpvs("varname")));
537 0 0         XPUSHs(sv_2mortal(full_varname));
538 0           PUTBACK;
539              
540 0           call_method("_failed_check", G_VOID | G_DISCARD);
541             }
542             else {
543             /* invocant: undef */
544 9 50         XPUSHs(&PL_sv_undef);
545             /* type name */
546 9           SV *type_name_sv = sv_2mortal(newSVpv(type_name(element_type), 0));
547 9 50         XPUSHs(type_name_sv);
548             /* failing value */
549 9 50         XPUSHs(sv_2mortal(newSVsv(val)));
550             /* varname => $full_varname */
551 9 50         XPUSHs(sv_2mortal(newSVpvs("varname")));
552 9 50         XPUSHs(sv_2mortal(full_varname));
553 9           PUTBACK;
554              
555 9           call_pv("Type::Tiny::_failed_check", G_VOID | G_DISCARD);
556             }
557              
558             /* Never returns normally */
559 0 0         FREETMPS;
560 0           LEAVE;
561 0           }
562