This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove Win32 compiler warnings
[perl5.git] / ext / XS / APItest / APItest.xs
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5
6 MODULE = XS::APItest:Hash               PACKAGE = XS::APItest::Hash
7
8 #define UTF8KLEN(sv, len)   (SvUTF8(sv) ? -(I32)len : (I32)len)
9
10 bool
11 exists(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);
20         RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
21         OUTPUT:
22         RETVAL
23
24 SV *
25 delete(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.  */
35         RETVAL = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), 0));
36         OUTPUT:
37         RETVAL
38
39 SV *
40 store_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
63 SV *
64 store(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);
77         result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
78         SvSetMagicSV(copy, value);
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
90 SV *
91 fetch(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);
101         result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
102         if (!result) {
103             XSRETURN_EMPTY;
104         }
105         /* Force mg_get  */
106         RETVAL = newSVsv(*result);
107         OUTPUT:
108         RETVAL
109 =pod
110
111 sub TIEHASH  { bless {}, $_[0] }
112 sub STORE    { $_[0]->{$_[1]} = $_[2] }
113 sub FETCH    { $_[0]->{$_[1]} }
114 sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
115 sub NEXTKEY  { each %{$_[0]} }
116 sub EXISTS   { exists $_[0]->{$_[1]} }
117 sub DELETE   { delete $_[0]->{$_[1]} }
118 sub CLEAR    { %{$_[0]} = () }
119
120 =cut
121
122 MODULE = XS::APItest            PACKAGE = XS::APItest
123
124 PROTOTYPES: DISABLE
125
126 void
127 print_double(val)
128         double val
129         CODE:
130         printf("%5.3f\n",val);
131
132 int
133 have_long_double()
134         CODE:
135 #ifdef HAS_LONG_DOUBLE
136         RETVAL = 1;
137 #else
138         RETVAL = 0;
139 #endif
140         OUTPUT:
141         RETVAL
142
143 void
144 print_long_double()
145         CODE:
146 #ifdef HAS_LONG_DOUBLE
147 #   if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
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
156 void
157 print_int(val)
158         int val
159         CODE:
160         printf("%d\n",val);
161
162 void
163 print_long(val)
164         long val
165         CODE:
166         printf("%ld\n",val);
167
168 void
169 print_float(val)
170         float val
171         CODE:
172         printf("%5.3f\n",val);
173         
174 void
175 print_flush()
176         CODE:
177         fflush(stdout);