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