File Coverage

xs/installer.h
Criterion Covered Total %
statement 26 26 100.0
branch 52 128 40.6
condition n/a
subroutine n/a
pod n/a
total 78 154 50.6


line stmt bran cond sub pod time code
1             #ifndef __INHERITED_XS_INSTALLER_H_
2             #define __INHERITED_XS_INSTALLER_H_
3              
4             inline void
5 84           CAIXS_payload_attach(pTHX_ CV* cv, AV* payload_av) {
6             #ifndef MULTIPLICITY
7 84           CvXSUBANY(cv).any_ptr = (void*)AvARRAY(payload_av);
8             #endif
9              
10 84           sv_magicext((SV*)cv, (SV*)payload_av, PERL_MAGIC_ext, &sv_payload_marker, NULL, 0);
11 84           SvREFCNT_dec_NN((SV*)payload_av);
12 84           SvRMAGICAL_off((SV*)cv);
13 84           }
14              
15             template static
16             shared_keys*
17 84           CAIXS_payload_init(pTHX_ CV* cv) {
18 84           AV* payload_av = newAV();
19              
20 84           av_extend(payload_av, ALLOC_SIZE[type]);
21 84           AvFILLp(payload_av) = ALLOC_SIZE[type];
22              
23 84           CAIXS_payload_attach(aTHX_ cv, payload_av);
24 84           return (shared_keys*)AvARRAY(payload_av);
25             }
26              
27             template static
28             CV*
29 86           CAIXS_install_cv(pTHX_ SV* full_name) {
30             STRLEN len;
31              
32 86 50         const char* full_name_buf = SvPV_const(full_name, len);
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    0          
    0          
    50          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    50          
33             #ifdef CAIX_BINARY_UNSAFE
34             if (strnlen(full_name_buf, len) < len) {
35             croak("Attempted to install binary accessor, but they're not supported on this perl");
36             }
37             #endif
38              
39 86           CV* cv = Perl_newXS_len_flags(aTHX_ full_name_buf, len, (&CAIXS_entersub_wrapper), __FILE__, NULL, NULL, SvUTF8(full_name));
40 86 50         if (!cv) croak("Can't install XS accessor");
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    0          
    0          
    50          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    50          
41              
42 86           return cv;
43             }
44              
45             template
46             struct CImpl {
47 472           static shared_keys* CAIXS_install_accessor(pTHX_ AccessorOpts val, SV* full_name) {
48 24           if (TYPE_INHERITED && (opts & IsReadonly)) goto next;
49             if (type == Constructor) goto next;
50              
51 224 100         if ((val & opts) == opts) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    50          
    50          
    50          
    50          
    50          
52 15           CV* cv = CAIXS_install_cv(aTHX_ full_name);
53 15           return CAIXS_payload_init(aTHX_ cv);
54             }
55              
56             next:
57 233           return CImpl::CAIXS_install_accessor(aTHX_ val, full_name);
58             }};
59              
60             template
61             struct CImpl {
62 69           static shared_keys* CAIXS_install_accessor(pTHX_ int val, SV* full_name) {
63 69           CV* cv = CAIXS_install_cv(aTHX_ full_name);
64 69           return CAIXS_payload_init(aTHX_ cv);
65             }};
66              
67             #endif /* __INHERITED_XS_INSTALLER_H_ */