This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Whoops. We weren't actually testing hv_store_ent
[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 bool
9 exists(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
22 SV *
23 delete(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
38 SV *
39 store_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
62 SV *
63 store(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);
77         SvSetMagicSV(copy, value);
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
89 SV *
90 fetch(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
108 =pod
109
110 sub TIEHASH  { bless {}, $_[0] }
111 sub STORE    { $_[0]->{$_[1]} = $_[2] }
112 sub FETCH    { $_[0]->{$_[1]} }
113 sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
114 sub NEXTKEY  { each %{$_[0]} }
115 sub EXISTS   { exists $_[0]->{$_[1]} }
116 sub DELETE   { delete $_[0]->{$_[1]} }
117 sub CLEAR    { %{$_[0]} = () }
118
119 =cut
120
121 MODULE = XS::APItest            PACKAGE = XS::APItest
122
123 PROTOTYPES: DISABLE
124
125 void
126 print_double(val)
127         double val
128         CODE:
129         printf("%5.3f\n",val);
130
131 int
132 have_long_double()
133         CODE:
134 #ifdef HAS_LONG_DOUBLE
135         RETVAL = 1;
136 #else
137         RETVAL = 0;
138 #endif
139         OUTPUT:
140         RETVAL
141
142 void
143 print_long_double()
144         CODE:
145 #ifdef HAS_LONG_DOUBLE
146 #   if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
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
155 void
156 print_int(val)
157         int val
158         CODE:
159         printf("%d\n",val);
160
161 void
162 print_long(val)
163         long val
164         CODE:
165         printf("%ld\n",val);
166
167 void
168 print_float(val)
169         float val
170         CODE:
171         printf("%5.3f\n",val);
172         
173 void
174 print_flush()
175         CODE:
176         fflush(stdout);