File Coverage

xsubs/arg.xs
Criterion Covered Total %
statement 17 17 100.0
branch 17 18 94.4
condition n/a
subroutine n/a
pod n/a
total 34 35 97.1


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: arg
13             #
14             # WRITTEN BY: Marcus Holland-Moritz ON: Jun 2004
15             # CHANGED BY: ON:
16             #
17             ################################################################################
18             #
19             # DESCRIPTION: Turn string arguments into blessed object, so we can recognize
20             # them later on.
21             #
22             ################################################################################
23              
24             void
25             CBC::arg(...)
26             PREINIT:
27 81           CBC_METHOD(arg);
28             int i;
29              
30             PPCODE:
31             CT_DEBUG_METHOD;
32              
33 81 100         CHECK_VOID_CONTEXT;
    100          
    100          
34              
35 163 100         for (i = 1; i < items; i++)
36             {
37             const char *argstr;
38             STRLEN len;
39             HookArgType type;
40             SV *sv;
41              
42 94 50         argstr = SvPV(ST(i), len);
43              
44 94 100         if (strEQ(argstr, "SELF"))
45 20           type = HOOK_ARG_SELF;
46 74 100         else if (strEQ(argstr, "TYPE"))
47 23           type = HOOK_ARG_TYPE;
48 51 100         else if (strEQ(argstr, "DATA"))
49 31           type = HOOK_ARG_DATA;
50 20 100         else if (strEQ(argstr, "HOOK"))
51 14           type = HOOK_ARG_HOOK;
52             else
53 6           Perl_croak(aTHX_ "Unknown argument type '%s' in %s", argstr, method);
54              
55 88           sv = newRV_noinc(newSViv(type));
56 88           sv_bless(sv, gv_stashpv(ARGTYPE_PACKAGE, 1));
57 88           ST(i-1) = sv_2mortal(sv);
58             }
59              
60 69           XSRETURN(items-1);
61