Commit | Line | Data |
3e61d65a |
1 | #include "EXTERN.h" |
2 | #include "perl.h" |
3 | #include "XSUB.h" |
4 | |
0314122a |
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 | |
b60cf05a |
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 * |
858117f8 |
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 * |
b60cf05a |
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); |
858117f8 |
77 | SvSetMagicSV(copy, value); |
b60cf05a |
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 |
0314122a |
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 | |
3e61d65a |
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 |
cabb36f0 |
139 | OUTPUT: |
140 | RETVAL |
3e61d65a |
141 | |
142 | void |
143 | print_long_double() |
144 | CODE: |
145 | #ifdef HAS_LONG_DOUBLE |
fc0bf671 |
146 | # if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE) |
3e61d65a |
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 |
3e61d65a |
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); |
9d911683 |
172 | |
173 | void |
174 | print_flush() |
175 | CODE: |
176 | fflush(stdout); |