This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Complement of change #21740 for Windows.
[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 *
39store(hash, key_sv, value)
40 PREINIT:
41 STRLEN len;
42 const char *key;
43 SV *copy;
44 SV **result;
45 INPUT:
46 HV *hash
47 SV *key_sv
48 SV *value
49 CODE:
50 key = SvPV(key_sv, len);
51 copy = newSV(0);
52 result = hv_store(hash, key, SvUTF8(key_sv) ? -len : len, copy, 0);
53 SvSetMagicSV(*result, value);
54 if (!result) {
55 SvREFCNT_dec(copy);
56 XSRETURN_EMPTY;
57 }
58 /* It's about to become mortal, so need to increase reference count.
59 */
60 RETVAL = SvREFCNT_inc(*result);
61 OUTPUT:
62 RETVAL
63
64
65SV *
66fetch(hash, key_sv)
67 PREINIT:
68 STRLEN len;
69 const char *key;
70 SV **result;
71 INPUT:
72 HV *hash
73 SV *key_sv
74 CODE:
75 key = SvPV(key_sv, len);
76 result = hv_fetch(hash, key, SvUTF8(key_sv) ? -len : len, 0);
77 if (!result) {
78 XSRETURN_EMPTY;
79 }
80 /* Force mg_get */
81 RETVAL = newSVsv(*result);
82 OUTPUT:
83 RETVAL
84
0314122a
NC
85=pod
86
87sub TIEHASH { bless {}, $_[0] }
88sub STORE { $_[0]->{$_[1]} = $_[2] }
89sub FETCH { $_[0]->{$_[1]} }
90sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
91sub NEXTKEY { each %{$_[0]} }
92sub EXISTS { exists $_[0]->{$_[1]} }
93sub DELETE { delete $_[0]->{$_[1]} }
94sub CLEAR { %{$_[0]} = () }
95
96=cut
97
3e61d65a
JH
98MODULE = XS::APItest PACKAGE = XS::APItest
99
100PROTOTYPES: DISABLE
101
102void
103print_double(val)
104 double val
105 CODE:
106 printf("%5.3f\n",val);
107
108int
109have_long_double()
110 CODE:
111#ifdef HAS_LONG_DOUBLE
112 RETVAL = 1;
113#else
114 RETVAL = 0;
115#endif
cabb36f0
CN
116 OUTPUT:
117 RETVAL
3e61d65a
JH
118
119void
120print_long_double()
121 CODE:
122#ifdef HAS_LONG_DOUBLE
fc0bf671 123# if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
3e61d65a
JH
124 long double val = 7.0;
125 printf("%5.3" PERL_PRIfldbl "\n",val);
126# else
127 double val = 7.0;
128 printf("%5.3f\n",val);
129# endif
130#endif
131
132void
3e61d65a
JH
133print_int(val)
134 int val
135 CODE:
136 printf("%d\n",val);
137
138void
139print_long(val)
140 long val
141 CODE:
142 printf("%ld\n",val);
143
144void
145print_float(val)
146 float val
147 CODE:
148 printf("%5.3f\n",val);
9d911683
NIS
149
150void
151print_flush()
152 CODE:
153 fflush(stdout);