File Coverage

xs/installer.h
Criterion Covered Total %
statement 27 27 100.0
branch 48 120 40.0
condition n/a
subroutine n/a
pod n/a
total 75 147 51.0


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 72           if ((opts & (IsReadonly | IsWeak)) == (IsReadonly | IsWeak)) goto next;
50             if (type == Constructor) goto next;
51              
52 152 100         if ((val & opts) == opts) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    50          
53 15           CV* cv = CAIXS_install_cv(aTHX_ full_name);
54 15           return CAIXS_payload_init(aTHX_ cv);
55             }
56              
57             next:
58 233           return CImpl::CAIXS_install_accessor(aTHX_ val, full_name);
59             }};
60              
61             template
62             struct CImpl {
63 69           static shared_keys* CAIXS_install_accessor(pTHX_ int val, SV* full_name) {
64 69           CV* cv = CAIXS_install_cv(aTHX_ full_name);
65 69           return CAIXS_payload_init(aTHX_ cv);
66             }};
67              
68             #endif /* __INHERITED_XS_INSTALLER_H_ */