File Coverage

const-xs.inc
Criterion Covered Total %
statement 24 38 63.1
branch 11 24 45.8
condition n/a
subroutine n/a
pod n/a
total 35 62 56.4


line stmt bran cond sub pod time code
1             BOOT:
2             {
3             #ifdef dTHX
4             dTHX;
5             #endif
6 3           HV *symbol_table = get_hv("Ouroboros::", GV_ADD);
7 3           AV *push = get_av("Ouroboros::CONSTS", GV_ADD);
8             HE *he;
9              
10             static const struct iv_s values_for_iv[] =
11             {
12             { "SVt_NULL", 8, SVt_NULL },
13             { "SVt_IV", 6, SVt_IV },
14             { "SVt_NV", 6, SVt_NV },
15             { "SVt_PV", 6, SVt_PV },
16             { "SVt_PVIV", 8, SVt_PVIV },
17             { "SVt_PVNV", 8, SVt_PVNV },
18             { "SVt_PVMG", 8, SVt_PVMG },
19             { "SVt_REGEXP", 10, SVt_REGEXP },
20             { "SVt_PVGV", 8, SVt_PVGV },
21             { "SVt_PVLV", 8, SVt_PVLV },
22             { "SVt_PVAV", 8, SVt_PVAV },
23             { "SVt_PVHV", 8, SVt_PVHV },
24             { "SVt_PVCV", 8, SVt_PVCV },
25             { "SVt_PVFM", 8, SVt_PVFM },
26             { "SVt_PVIO", 8, SVt_PVIO },
27             { "SVt_LAST", 8, SVt_LAST },
28             { NULL, 0, 0 } };
29 3           const struct iv_s *value_for_iv = values_for_iv;
30              
31             static const struct uv_s values_for_uv[] =
32             {
33             #ifdef SV_CATBYTES
34             { "SV_CATBYTES", 11, SV_CATBYTES },
35             #endif
36             #ifdef SV_CATUTF8
37             { "SV_CATUTF8", 10, SV_CATUTF8 },
38             #endif
39             #ifdef SV_CONST_RETURN
40             { "SV_CONST_RETURN", 15, SV_CONST_RETURN },
41             #endif
42             #ifdef SV_COW_DROP_PV
43             { "SV_COW_DROP_PV", 14, SV_COW_DROP_PV },
44             #endif
45             #ifdef SV_FORCE_UTF8_UPGRADE
46             { "SV_FORCE_UTF8_UPGRADE", 21, SV_FORCE_UTF8_UPGRADE },
47             #endif
48             #ifdef SV_GMAGIC
49             { "SV_GMAGIC", 9, SV_GMAGIC },
50             #endif
51             #ifdef SV_HAS_TRAILING_NUL
52             { "SV_HAS_TRAILING_NUL", 19, SV_HAS_TRAILING_NUL },
53             #endif
54             #ifdef SV_IMMEDIATE_UNREF
55             { "SV_IMMEDIATE_UNREF", 18, SV_IMMEDIATE_UNREF },
56             #endif
57             #ifdef SV_NOSTEAL
58             { "SV_NOSTEAL", 10, SV_NOSTEAL },
59             #endif
60             #ifdef SV_SMAGIC
61             { "SV_SMAGIC", 9, SV_SMAGIC },
62             #endif
63             #ifdef GV_ADD
64             { "GV_ADD", 6, GV_ADD },
65             #endif
66             #ifdef GV_ADDMG
67             { "GV_ADDMG", 8, GV_ADDMG },
68             #endif
69             #ifdef GV_ADDMULTI
70             { "GV_ADDMULTI", 11, GV_ADDMULTI },
71             #endif
72             #ifdef GV_NOADD_NOINIT
73             { "GV_NOADD_NOINIT", 15, GV_NOADD_NOINIT },
74             #endif
75             #ifdef GV_NOEXPAND
76             { "GV_NOEXPAND", 11, GV_NOEXPAND },
77             #endif
78             #ifdef GV_NOINIT
79             { "GV_NOINIT", 9, GV_NOINIT },
80             #endif
81             #ifdef GV_SUPER
82             { "GV_SUPER", 8, GV_SUPER },
83             #endif
84             #ifdef PERL_MAGIC_arylen
85             { "PERL_MAGIC_arylen", 17, PERL_MAGIC_arylen },
86             #endif
87             #ifdef PERL_MAGIC_arylen_p
88             { "PERL_MAGIC_arylen_p", 19, PERL_MAGIC_arylen_p },
89             #endif
90             #ifdef PERL_MAGIC_backref
91             { "PERL_MAGIC_backref", 18, PERL_MAGIC_backref },
92             #endif
93             #ifdef PERL_MAGIC_bm
94             { "PERL_MAGIC_bm", 13, PERL_MAGIC_bm },
95             #endif
96             #ifdef PERL_MAGIC_checkcall
97             { "PERL_MAGIC_checkcall", 20, PERL_MAGIC_checkcall },
98             #endif
99             #ifdef PERL_MAGIC_collxfrm
100             { "PERL_MAGIC_collxfrm", 19, PERL_MAGIC_collxfrm },
101             #endif
102             #ifdef PERL_MAGIC_dbfile
103             { "PERL_MAGIC_dbfile", 17, PERL_MAGIC_dbfile },
104             #endif
105             #ifdef PERL_MAGIC_dbline
106             { "PERL_MAGIC_dbline", 17, PERL_MAGIC_dbline },
107             #endif
108             #ifdef PERL_MAGIC_debugvar
109             { "PERL_MAGIC_debugvar", 19, PERL_MAGIC_debugvar },
110             #endif
111             #ifdef PERL_MAGIC_defelem
112             { "PERL_MAGIC_defelem", 18, PERL_MAGIC_defelem },
113             #endif
114             #ifdef PERL_MAGIC_env
115             { "PERL_MAGIC_env", 14, PERL_MAGIC_env },
116             #endif
117             #ifdef PERL_MAGIC_envelem
118             { "PERL_MAGIC_envelem", 18, PERL_MAGIC_envelem },
119             #endif
120             #ifdef PERL_MAGIC_ext
121             { "PERL_MAGIC_ext", 14, PERL_MAGIC_ext },
122             #endif
123             #ifdef PERL_MAGIC_fm
124             { "PERL_MAGIC_fm", 13, PERL_MAGIC_fm },
125             #endif
126             #ifdef PERL_MAGIC_foo
127             { "PERL_MAGIC_foo", 14, PERL_MAGIC_foo },
128             #endif
129             #ifdef PERL_MAGIC_hints
130             { "PERL_MAGIC_hints", 16, PERL_MAGIC_hints },
131             #endif
132             #ifdef PERL_MAGIC_hintselem
133             { "PERL_MAGIC_hintselem", 20, PERL_MAGIC_hintselem },
134             #endif
135             #ifdef PERL_MAGIC_isa
136             { "PERL_MAGIC_isa", 14, PERL_MAGIC_isa },
137             #endif
138             #ifdef PERL_MAGIC_isaelem
139             { "PERL_MAGIC_isaelem", 18, PERL_MAGIC_isaelem },
140             #endif
141             #ifdef PERL_MAGIC_lvref
142             { "PERL_MAGIC_lvref", 16, PERL_MAGIC_lvref },
143             #endif
144             #ifdef PERL_MAGIC_nkeys
145             { "PERL_MAGIC_nkeys", 16, PERL_MAGIC_nkeys },
146             #endif
147             #ifdef PERL_MAGIC_overload_table
148             { "PERL_MAGIC_overload_table", 25, PERL_MAGIC_overload_table },
149             #endif
150             #ifdef PERL_MAGIC_pos
151             { "PERL_MAGIC_pos", 14, PERL_MAGIC_pos },
152             #endif
153             #ifdef PERL_MAGIC_qr
154             { "PERL_MAGIC_qr", 13, PERL_MAGIC_qr },
155             #endif
156             #ifdef PERL_MAGIC_regdata
157             { "PERL_MAGIC_regdata", 18, PERL_MAGIC_regdata },
158             #endif
159             #ifdef PERL_MAGIC_regdatum
160             { "PERL_MAGIC_regdatum", 19, PERL_MAGIC_regdatum },
161             #endif
162             #ifdef PERL_MAGIC_regex_global
163             { "PERL_MAGIC_regex_global", 23, PERL_MAGIC_regex_global },
164             #endif
165             #ifdef PERL_MAGIC_rhash
166             { "PERL_MAGIC_rhash", 16, PERL_MAGIC_rhash },
167             #endif
168             #ifdef PERL_MAGIC_shared
169             { "PERL_MAGIC_shared", 17, PERL_MAGIC_shared },
170             #endif
171             #ifdef PERL_MAGIC_shared_scalar
172             { "PERL_MAGIC_shared_scalar", 24, PERL_MAGIC_shared_scalar },
173             #endif
174             #ifdef PERL_MAGIC_sig
175             { "PERL_MAGIC_sig", 14, PERL_MAGIC_sig },
176             #endif
177             #ifdef PERL_MAGIC_sigelem
178             { "PERL_MAGIC_sigelem", 18, PERL_MAGIC_sigelem },
179             #endif
180             #ifdef PERL_MAGIC_substr
181             { "PERL_MAGIC_substr", 17, PERL_MAGIC_substr },
182             #endif
183             #ifdef PERL_MAGIC_sv
184             { "PERL_MAGIC_sv", 13, PERL_MAGIC_sv },
185             #endif
186             #ifdef PERL_MAGIC_symtab
187             { "PERL_MAGIC_symtab", 17, PERL_MAGIC_symtab },
188             #endif
189             #ifdef PERL_MAGIC_taint
190             { "PERL_MAGIC_taint", 16, PERL_MAGIC_taint },
191             #endif
192             #ifdef PERL_MAGIC_tied
193             { "PERL_MAGIC_tied", 15, PERL_MAGIC_tied },
194             #endif
195             #ifdef PERL_MAGIC_tiedelem
196             { "PERL_MAGIC_tiedelem", 19, PERL_MAGIC_tiedelem },
197             #endif
198             #ifdef PERL_MAGIC_tiedscalar
199             { "PERL_MAGIC_tiedscalar", 21, PERL_MAGIC_tiedscalar },
200             #endif
201             #ifdef PERL_MAGIC_utf8
202             { "PERL_MAGIC_utf8", 15, PERL_MAGIC_utf8 },
203             #endif
204             #ifdef PERL_MAGIC_uvar
205             { "PERL_MAGIC_uvar", 15, PERL_MAGIC_uvar },
206             #endif
207             #ifdef PERL_MAGIC_uvar_elem
208             { "PERL_MAGIC_uvar_elem", 20, PERL_MAGIC_uvar_elem },
209             #endif
210             #ifdef PERL_MAGIC_vec
211             { "PERL_MAGIC_vec", 14, PERL_MAGIC_vec },
212             #endif
213             #ifdef PERL_MAGIC_vstring
214             { "PERL_MAGIC_vstring", 18, PERL_MAGIC_vstring },
215             #endif
216             { NULL, 0, 0 } };
217 3           const struct uv_s *value_for_uv = values_for_uv;
218 51 100         while (value_for_iv->name) {
219 48           he = constant_add_symbol(aTHX_ symbol_table, value_for_iv->name,
220             value_for_iv->namelen, newSViv(value_for_iv->value));
221 48           av_push(push, newSVhek(HeKEY_hek(he)));
222 48           ++value_for_iv;
223             }
224 183 100         while (value_for_uv->name) {
225 180           he = constant_add_symbol(aTHX_ symbol_table, value_for_uv->name,
226             value_for_uv->namelen, newSVuv(value_for_uv->value));
227 180           av_push(push, newSVhek(HeKEY_hek(he)));
228 180           ++value_for_uv;
229             }
230             if (C_ARRAY_LENGTH(values_for_notfound) > 1) {
231             #ifndef SYMBIAN
232 3           HV *const constant_missing = get_missing_hash(aTHX);
233             #endif
234 3           const struct notfound_s *value_for_notfound = values_for_notfound;
235             do {
236              
237             /* Need to add prototypes, else parsing will vary by platform. */
238 3           HE *he = (HE*) hv_common_key_len(symbol_table,
239             value_for_notfound->name,
240             value_for_notfound->namelen,
241             HV_FETCH_LVALUE, NULL, 0);
242             SV *sv;
243             #ifndef SYMBIAN
244             HEK *hek;
245             #endif
246 3 50         if (!he) {
247 0           Perl_croak(aTHX_
248             "Couldn't add key '%s' to %%Ouroboros::",
249             value_for_notfound->name);
250             }
251 3           sv = HeVAL(he);
252 3 50         if (!SvOK(sv) && SvTYPE(sv) != SVt_PVGV) {
    50          
    50          
    50          
253             /* Nothing was here before, so mark a prototype of "" */
254 3           sv_setpvn(sv, "", 0);
255 0 0         } else if (SvPOK(sv) && SvCUR(sv) == 0) {
    0          
256             /* There is already a prototype of "" - do nothing */
257             } else {
258             /* Someone has been here before us - have to make a real
259             typeglob. */
260             /* It turns out to be incredibly hard to deal with all the
261             corner cases of sub foo (); and reporting errors correctly,
262             so lets cheat a bit. Start with a constant subroutine */
263 0           CV *cv = newCONSTSUB(symbol_table,
264             value_for_notfound->name,
265             &PL_sv_yes);
266             /* and then turn it into a non constant declaration only. */
267 0           SvREFCNT_dec(CvXSUBANY(cv).any_ptr);
268 0           CvCONST_off(cv);
269 0           CvXSUB(cv) = NULL;
270 0           CvXSUBANY(cv).any_ptr = NULL;
271             }
272             #ifndef SYMBIAN
273 3           hek = HeKEY_hek(he);
274 3 50         if (!hv_common(constant_missing, NULL, HEK_KEY(hek),
275             HEK_LEN(hek), HEK_FLAGS(hek), HV_FETCH_ISSTORE,
276             &PL_sv_yes, HEK_HASH(hek)))
277 0           Perl_croak(aTHX_ "Couldn't add key '%s' to missing_hash",
278             value_for_notfound->name);
279             #endif
280 3           av_push(push, newSVhek(hek));
281 3 50         } while ((++value_for_notfound)->name);
282             }
283             /* As we've been creating subroutines, we better invalidate any cached
284             methods */
285 3           mro_method_changed_in(symbol_table);
286             }
287              
288             void
289             constant(sv)
290             INPUT:
291             SV * sv;
292             PPCODE:
293             #ifndef SYMBIAN
294             /* It's not obvious how to calculate this at C pre-processor time.
295             However, any compiler optimiser worth its salt should be able to
296             remove the dead code, and hopefully the now-obviously-unused static
297             function too. */
298 0           HV *constant_missing = (C_ARRAY_LENGTH(values_for_notfound) > 1)
299             ? get_missing_hash(aTHX) : NULL;
300 0 0         if ((C_ARRAY_LENGTH(values_for_notfound) > 1)
301 0           ? hv_exists_ent(constant_missing, sv, 0) : 0) {
302 0           sv = newSVpvf("Your vendor has not defined Ouroboros macro %" SVf
303             ", used", sv);
304             } else
305             #endif
306             {
307 0           sv = newSVpvf("%"SVf" is not a valid Ouroboros macro",
308             sv);
309             }
310 0           PUSHs(sv_2mortal(sv));