File Coverage

xs/complex.c
Criterion Covered Total %
statement 90 90 100.0
branch 68 98 69.3
condition n/a
subroutine n/a
pod n/a
total 158 188 84.0


line stmt bran cond sub pod time code
1             #include "EXTERN.h"
2             #include "perl.h"
3             #include "XSUB.h"
4             #include "ppport.h"
5             #include "ffi_platypus.h"
6             #include "ffi_platypus_guts.h"
7              
8             static double
9 84           decompose(SV *sv, int imag)
10             {
11             /* Re(z) */
12 84           dSP;
13              
14             int count;
15 84           double result = 0.0;
16              
17 84           ENTER;
18 84           SAVETMPS;
19 84 50         PUSHMARK(SP);
20 84 50         XPUSHs(sv);
21 84           PUTBACK;
22              
23 84 100         count = call_pv(imag ? "Math::Complex::Im" : "Math::Complex::Re", G_ARRAY);
24              
25 84           SPAGAIN;
26              
27 84 50         if(count >= 1)
28 84 100         result = POPn;
29              
30 84           PUTBACK;
31 84 50         FREETMPS;
32 84           LEAVE;
33              
34 84           return result;
35             }
36              
37             static void
38 36           set(SV *sv, SV *new_value, int imag)
39             {
40 36           dSP;
41              
42 36           ENTER;
43 36           SAVETMPS;
44 36 50         PUSHMARK(SP);
45 36 50         XPUSHs(sv);
46 36 50         XPUSHs(new_value);
47 36           PUTBACK;
48              
49 36 100         call_pv(imag ? "Math::Complex::Im" : "Math::Complex::Re", G_DISCARD);
50              
51 36 50         FREETMPS;
52 36           LEAVE;
53 36           }
54              
55             void
56 111           ffi_pl_perl_to_complex_float(SV *sv, float *ptr)
57             {
58 111 100         if(sv_isobject(sv) && sv_derived_from(sv, "Math::Complex"))
    50          
59             {
60 21           ptr[0] = decompose(sv, 0);
61 21           ptr[1] = decompose(sv, 1);
62             }
63 90 100         else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV)
    50          
64 69           {
65 69           AV *av = (AV*) SvRV(sv);
66             SV **real_sv, **imag_sv;
67 69           real_sv = av_fetch(av, 0, 0);
68 69           imag_sv = av_fetch(av, 1, 0);
69 69 100         ptr[0] = real_sv != NULL ? SvNV(*real_sv) : 0.0;
    50          
70 69 100         ptr[1]= imag_sv != NULL ? SvNV(*imag_sv) : 0.0;
    50          
71             }
72 21 100         else if(SvOK(sv))
    50          
    50          
73             {
74 18 50         ptr[0] = SvNV(sv);
75 18           ptr[1] = 0.0;
76             }
77             else
78             {
79 3           ptr[0] = 0.0;
80 3           ptr[1] = 0.0;
81             }
82 111           }
83              
84             void
85 69           ffi_pl_complex_float_to_perl(SV *sv, float *ptr)
86             {
87 69 100         if(SvOK(sv) && sv_isobject(sv) && sv_derived_from(sv, "Math::Complex"))
    50          
    50          
    100          
    50          
88             {
89             /* the complex variable is a Math::Complex object */
90 9           set(sv, sv_2mortal(newSVnv(ptr[0])), 0);
91 9           set(sv, sv_2mortal(newSVnv(ptr[1])), 1);
92             }
93 60 100         else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV)
    50          
94 57           {
95             /* the compex variable is already an array */
96 57           AV *av = (AV*) SvRV(sv);
97 57           av_store(av, 0, newSVnv(ptr[0]));
98 57           av_store(av, 1, newSVnv(ptr[1]));
99             }
100             else
101             {
102             /* the complex variable is something else and an array needs to be created */
103             SV *values[2];
104             AV *av;
105 3           values[0] = newSVnv(ptr[0]);
106 3           values[1] = newSVnv(ptr[1]);
107 3           av = av_make(2, values);
108 3           sv_setsv(sv, newRV_noinc((SV*)av));
109             }
110 69           }
111              
112             void
113 111           ffi_pl_perl_to_complex_double(SV *sv, double *ptr)
114             {
115 111 100         if(sv_isobject(sv) && sv_derived_from(sv, "Math::Complex"))
    50          
116             {
117 21           ptr[0] = decompose(sv, 0);
118 21           ptr[1] = decompose(sv, 1);
119             }
120 90 100         else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV)
    50          
121 69           {
122 69           AV *av = (AV*) SvRV(sv);
123             SV **real_sv, **imag_sv;
124 69           real_sv = av_fetch(av, 0, 0);
125 69           imag_sv = av_fetch(av, 1, 0);
126 69 100         ptr[0] = real_sv != NULL ? SvNV(*real_sv) : 0.0;
    50          
127 69 100         ptr[1]= imag_sv != NULL ? SvNV(*imag_sv) : 0.0;
    50          
128             }
129 21 100         else if(SvOK(sv))
    50          
    50          
130             {
131 18 50         ptr[0] = SvNV(sv);
132 18           ptr[1] = 0.0;
133             }
134             else
135             {
136 3           ptr[0] = 0.0;
137 3           ptr[1] = 0.0;
138             }
139 111           }
140              
141             void
142 69           ffi_pl_complex_double_to_perl(SV *sv, double *ptr)
143             {
144 69 100         if(SvOK(sv) && sv_isobject(sv) && sv_derived_from(sv, "Math::Complex"))
    50          
    50          
    100          
    50          
145             {
146             /* the complex variable is a Math::Complex object */
147 9           set(sv, sv_2mortal(newSVnv(ptr[0])), 0);
148 9           set(sv, sv_2mortal(newSVnv(ptr[1])), 1);
149             }
150 60 100         else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV)
    50          
151 57           {
152             /* the compex variable is already an array */
153 57           AV *av = (AV*) SvRV(sv);
154 57           av_store(av, 0, newSVnv(ptr[0]));
155 57           av_store(av, 1, newSVnv(ptr[1]));
156             }
157             else
158             {
159             /* the complex variable is something else and an array needs to be created */
160             SV *values[2];
161             AV *av;
162 3           values[0] = newSVnv(ptr[0]);
163 3           values[1] = newSVnv(ptr[1]);
164 3           av = av_make(2, values);
165 3           sv_setsv(sv, newRV_noinc((SV*)av));
166             }
167 69           }
168