File Coverage

xsubs/include.xs
Criterion Covered Total %
statement 31 31 100.0
branch 34 36 94.4
condition n/a
subroutine n/a
pod n/a
total 65 67 97.0


line stmt bran cond sub pod time code
1             ################################################################################
2             #
3             # Copyright (c) 2002-2020 Marcus Holland-Moritz. All rights reserved.
4             # This program is free software; you can redistribute it and/or modify
5             # it under the same terms as Perl itself.
6             #
7             ################################################################################
8              
9              
10             ################################################################################
11             #
12             # METHOD: Include / Define / Assert
13             #
14             # WRITTEN BY: Marcus Holland-Moritz ON: Mar 2002
15             # CHANGED BY: ON:
16             #
17             ################################################################################
18              
19             void
20             CBC::Include(...)
21             ALIAS:
22             Define = 1
23             Assert = 2
24              
25             PREINIT:
26 115           CBC_METHOD_VAR;
27             LinkedList list;
28             int hasRval;
29             SV *rval, *inval;
30              
31             PPCODE:
32 115           switch (ix)
33             {
34             case 1: /* Define */
35 40           CBC_METHOD_SET("Define");
36 40           list = THIS->cfg.defines;
37 40           break;
38             case 2: /* Assert */
39 36           CBC_METHOD_SET("Assert");
40 36           list = THIS->cfg.assertions;
41 36           break;
42             default: /* Include */
43 39           CBC_METHOD_SET("Include");
44 39           list = THIS->cfg.includes;
45 39           break;
46             }
47              
48             CT_DEBUG_METHOD;
49              
50 115 100         hasRval = GIMME_V != G_VOID && items <= 1;
    100          
    50          
    100          
51              
52 115 100         if (GIMME_V == G_VOID && items <= 1)
    100          
    100          
53             {
54 3 50         WARN_VOID_CONTEXT;
55 3           XSRETURN_EMPTY;
56             }
57              
58 112 100         if (items > 1 && !SvROK(ST(1)))
    100          
59 30           {
60             int i;
61 36           inval = NULL;
62              
63 98 100         for (i = 1; i < items; i++)
64             {
65 68 100         if (SvROK(ST(i)))
66 6           Perl_croak(aTHX_ "Argument %d to %s must not be a reference", i, method);
67              
68 62           LL_push(list, string_new_fromSV(aTHX_ ST(i)));
69             }
70             }
71             else
72             {
73 76 100         if (items > 2)
74 6           Perl_croak(aTHX_ "Invalid number of arguments to %s", method);
75              
76 70 100         inval = items == 2 ? ST(1) : NULL;
77             }
78              
79 100 100         if (inval != NULL || hasRval)
    100          
80 70 100         handle_string_list(aTHX_ method, list, inval, hasRval ? &rval : NULL);
81              
82 88 100         if (hasRval)
83 10           ST(0) = sv_2mortal(rval);
84              
85 88           reset_preprocessor(&THIS->cpi);
86              
87 91           XSRETURN(1);
88              
89