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 * |
39 | store(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 | |
65 | SV * |
66 | fetch(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 |
85 | =pod |
86 | |
87 | sub TIEHASH { bless {}, $_[0] } |
88 | sub STORE { $_[0]->{$_[1]} = $_[2] } |
89 | sub FETCH { $_[0]->{$_[1]} } |
90 | sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} } |
91 | sub NEXTKEY { each %{$_[0]} } |
92 | sub EXISTS { exists $_[0]->{$_[1]} } |
93 | sub DELETE { delete $_[0]->{$_[1]} } |
94 | sub CLEAR { %{$_[0]} = () } |
95 | |
96 | =cut |
97 | |
3e61d65a |
98 | MODULE = XS::APItest PACKAGE = XS::APItest |
99 | |
100 | PROTOTYPES: DISABLE |
101 | |
102 | void |
103 | print_double(val) |
104 | double val |
105 | CODE: |
106 | printf("%5.3f\n",val); |
107 | |
108 | int |
109 | have_long_double() |
110 | CODE: |
111 | #ifdef HAS_LONG_DOUBLE |
112 | RETVAL = 1; |
113 | #else |
114 | RETVAL = 0; |
115 | #endif |
cabb36f0 |
116 | OUTPUT: |
117 | RETVAL |
3e61d65a |
118 | |
119 | void |
120 | print_long_double() |
121 | CODE: |
122 | #ifdef HAS_LONG_DOUBLE |
fc0bf671 |
123 | # if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE) |
3e61d65a |
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 | |
132 | void |
3e61d65a |
133 | print_int(val) |
134 | int val |
135 | CODE: |
136 | printf("%d\n",val); |
137 | |
138 | void |
139 | print_long(val) |
140 | long val |
141 | CODE: |
142 | printf("%ld\n",val); |
143 | |
144 | void |
145 | print_float(val) |
146 | float val |
147 | CODE: |
148 | printf("%5.3f\n",val); |
9d911683 |
149 | |
150 | void |
151 | print_flush() |
152 | CODE: |
153 | fflush(stdout); |