This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Allow overriding of the p4 settings via environment variables
[perl5.git] / ext / XS / APItest / APItest.xs
CommitLineData
3e61d65a
JH
1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4
0314122a
NC
5
6MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
7
8bool
9exists(hash, key_sv)
10 PREINIT:
11 STRLEN len;
12 const char *key;
13 INPUT:
14 HV *hash
15 SV *key_sv
16 CODE:
17 key = SvPV(key_sv, len);
18 RETVAL = hv_exists(hash, key, SvUTF8(key_sv) ? -len : len);
19 OUTPUT:
20 RETVAL
21
b60cf05a
NC
22SV *
23delete(hash, key_sv)
24 PREINIT:
25 STRLEN len;
26 const char *key;
27 INPUT:
28 HV *hash
29 SV *key_sv
30 CODE:
31 key = SvPV(key_sv, len);
32 /* It's already mortal, so need to increase reference count. */
33 RETVAL = SvREFCNT_inc(hv_delete(hash, key,
34 SvUTF8(key_sv) ? -len : len, 0));
35 OUTPUT:
36 RETVAL
37
38SV *
858117f8
NC
39store_ent(hash, key, value)
40 PREINIT:
41 SV *copy;
42 HE *result;
43 INPUT:
44 HV *hash
45 SV *key
46 SV *value
47 CODE:
48 copy = newSV(0);
49 result = hv_store_ent(hash, key, copy, 0);
50 SvSetMagicSV(copy, value);
51 if (!result) {
52 SvREFCNT_dec(copy);
53 XSRETURN_EMPTY;
54 }
55 /* It's about to become mortal, so need to increase reference count.
56 */
57 RETVAL = SvREFCNT_inc(HeVAL(result));
58 OUTPUT:
59 RETVAL
60
61
62SV *
b60cf05a
NC
63store(hash, key_sv, value)
64 PREINIT:
65 STRLEN len;
66 const char *key;
67 SV *copy;
68 SV **result;
69 INPUT:
70 HV *hash
71 SV *key_sv
72 SV *value
73 CODE:
74 key = SvPV(key_sv, len);
75 copy = newSV(0);
76 result = hv_store(hash, key, SvUTF8(key_sv) ? -len : len, copy, 0);
858117f8 77 SvSetMagicSV(copy, value);
b60cf05a
NC
78 if (!result) {
79 SvREFCNT_dec(copy);
80 XSRETURN_EMPTY;
81 }
82 /* It's about to become mortal, so need to increase reference count.
83 */
84 RETVAL = SvREFCNT_inc(*result);
85 OUTPUT:
86 RETVAL
87
88
89SV *
90fetch(hash, key_sv)
91 PREINIT:
92 STRLEN len;
93 const char *key;
94 SV **result;
95 INPUT:
96 HV *hash
97 SV *key_sv
98 CODE:
99 key = SvPV(key_sv, len);
100 result = hv_fetch(hash, key, SvUTF8(key_sv) ? -len : len, 0);
101 if (!result) {
102 XSRETURN_EMPTY;
103 }
104 /* Force mg_get */
105 RETVAL = newSVsv(*result);
106 OUTPUT:
107 RETVAL
0314122a
NC
108=pod
109
110sub TIEHASH { bless {}, $_[0] }
111sub STORE { $_[0]->{$_[1]} = $_[2] }
112sub FETCH { $_[0]->{$_[1]} }
113sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
114sub NEXTKEY { each %{$_[0]} }
115sub EXISTS { exists $_[0]->{$_[1]} }
116sub DELETE { delete $_[0]->{$_[1]} }
117sub CLEAR { %{$_[0]} = () }
118
119=cut
120
3e61d65a
JH
121MODULE = XS::APItest PACKAGE = XS::APItest
122
123PROTOTYPES: DISABLE
124
125void
126print_double(val)
127 double val
128 CODE:
129 printf("%5.3f\n",val);
130
131int
132have_long_double()
133 CODE:
134#ifdef HAS_LONG_DOUBLE
135 RETVAL = 1;
136#else
137 RETVAL = 0;
138#endif
cabb36f0
CN
139 OUTPUT:
140 RETVAL
3e61d65a
JH
141
142void
143print_long_double()
144 CODE:
145#ifdef HAS_LONG_DOUBLE
fc0bf671 146# if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
3e61d65a
JH
147 long double val = 7.0;
148 printf("%5.3" PERL_PRIfldbl "\n",val);
149# else
150 double val = 7.0;
151 printf("%5.3f\n",val);
152# endif
153#endif
154
155void
3e61d65a
JH
156print_int(val)
157 int val
158 CODE:
159 printf("%d\n",val);
160
161void
162print_long(val)
163 long val
164 CODE:
165 printf("%ld\n",val);
166
167void
168print_float(val)
169 float val
170 CODE:
171 printf("%5.3f\n",val);
9d911683
NIS
172
173void
174print_flush()
175 CODE:
176 fflush(stdout);