This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[patch@25305] lib/ExtUtils/t/Constant.t VMS fixes
[perl5.git] / lib / ExtUtils / typemap
1 # basic C types
2 int                     T_IV
3 unsigned                T_UV
4 unsigned int            T_UV
5 long                    T_IV
6 unsigned long           T_UV
7 short                   T_IV
8 unsigned short          T_UV
9 char                    T_CHAR
10 unsigned char           T_U_CHAR
11 char *                  T_PV
12 unsigned char *         T_PV
13 const char *            T_PV
14 caddr_t                 T_PV
15 wchar_t *               T_PV
16 wchar_t                 T_IV
17 # bool_t is defined in <rpc/rpc.h>
18 bool_t                  T_IV
19 size_t                  T_UV
20 ssize_t                 T_IV
21 time_t                  T_NV
22 unsigned long *         T_OPAQUEPTR
23 char **                 T_PACKEDARRAY
24 void *                  T_PTR
25 Time_t *                T_PV
26 SV *                    T_SV
27 SVREF                   T_SVREF
28 AV *                    T_AVREF
29 HV *                    T_HVREF
30 CV *                    T_CVREF
31
32 IV                      T_IV
33 UV                      T_UV
34 NV                      T_NV
35 I32                     T_IV
36 I16                     T_IV
37 I8                      T_IV
38 STRLEN                  T_UV
39 U32                     T_U_LONG
40 U16                     T_U_SHORT
41 U8                      T_UV
42 Result                  T_U_CHAR
43 Boolean                 T_BOOL
44 float                   T_FLOAT
45 double                  T_DOUBLE
46 SysRet                  T_SYSRET
47 SysRetLong              T_SYSRET
48 FILE *                  T_STDIO
49 PerlIO *                T_INOUT
50 FileHandle              T_PTROBJ
51 InputStream             T_IN
52 InOutStream             T_INOUT
53 OutputStream            T_OUT
54 bool                    T_BOOL
55
56 #############################################################################
57 INPUT
58 T_SV
59         $var = $arg
60 T_SVREF
61         if (SvROK($arg))
62             $var = (SV*)SvRV($arg);
63         else
64             Perl_croak(aTHX_ \"$var is not a reference\")
65 T_AVREF
66         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
67             $var = (AV*)SvRV($arg);
68         else
69             Perl_croak(aTHX_ \"$var is not an array reference\")
70 T_HVREF
71         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV)
72             $var = (HV*)SvRV($arg);
73         else
74             Perl_croak(aTHX_ \"$var is not a hash reference\")
75 T_CVREF
76         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVCV)
77             $var = (CV*)SvRV($arg);
78         else
79             Perl_croak(aTHX_ \"$var is not a code reference\")
80 T_SYSRET
81         $var NOT IMPLEMENTED
82 T_UV
83         $var = ($type)SvUV($arg)
84 T_IV
85         $var = ($type)SvIV($arg)
86 T_INT
87         $var = (int)SvIV($arg)
88 T_ENUM
89         $var = ($type)SvIV($arg)
90 T_BOOL
91         $var = (bool)SvTRUE($arg)
92 T_U_INT
93         $var = (unsigned int)SvUV($arg)
94 T_SHORT
95         $var = (short)SvIV($arg)
96 T_U_SHORT
97         $var = (unsigned short)SvUV($arg)
98 T_LONG
99         $var = (long)SvIV($arg)
100 T_U_LONG
101         $var = (unsigned long)SvUV($arg)
102 T_CHAR
103         $var = (char)*SvPV_nolen($arg)
104 T_U_CHAR
105         $var = (unsigned char)SvUV($arg)
106 T_FLOAT
107         $var = (float)SvNV($arg)
108 T_NV
109         $var = ($type)SvNV($arg)
110 T_DOUBLE
111         $var = (double)SvNV($arg)
112 T_PV
113         $var = ($type)SvPV_nolen($arg)
114 T_PTR
115         $var = INT2PTR($type,SvIV($arg))
116 T_PTRREF
117         if (SvROK($arg)) {
118             IV tmp = SvIV((SV*)SvRV($arg));
119             $var = INT2PTR($type,tmp);
120         }
121         else
122             Perl_croak(aTHX_ \"$var is not a reference\")
123 T_REF_IV_REF
124         if (sv_isa($arg, \"${ntype}\")) {
125             IV tmp = SvIV((SV*)SvRV($arg));
126             $var = *INT2PTR($type *, tmp);
127         }
128         else
129             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
130 T_REF_IV_PTR
131         if (sv_isa($arg, \"${ntype}\")) {
132             IV tmp = SvIV((SV*)SvRV($arg));
133             $var = INT2PTR($type, tmp);
134         }
135         else
136             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
137 T_PTROBJ
138         if (sv_derived_from($arg, \"${ntype}\")) {
139             IV tmp = SvIV((SV*)SvRV($arg));
140             $var = INT2PTR($type,tmp);
141         }
142         else
143             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
144 T_PTRDESC
145         if (sv_isa($arg, \"${ntype}\")) {
146             IV tmp = SvIV((SV*)SvRV($arg));
147             ${type}_desc = (\U${type}_DESC\E*) tmp;
148             $var = ${type}_desc->ptr;
149         }
150         else
151             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
152 T_REFREF
153         if (SvROK($arg)) {
154             IV tmp = SvIV((SV*)SvRV($arg));
155             $var = *INT2PTR($type,tmp);
156         }
157         else
158             Perl_croak(aTHX_ \"$var is not a reference\")
159 T_REFOBJ
160         if (sv_isa($arg, \"${ntype}\")) {
161             IV tmp = SvIV((SV*)SvRV($arg));
162             $var = *INT2PTR($type,tmp);
163         }
164         else
165             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
166 T_OPAQUE
167         $var = *($type *)SvPV_nolen($arg)
168 T_OPAQUEPTR
169         $var = ($type)SvPV_nolen($arg)
170 T_PACKED
171         $var = XS_unpack_$ntype($arg)
172 T_PACKEDARRAY
173         $var = XS_unpack_$ntype($arg)
174 T_CALLBACK
175         $var = make_perl_cb_$type($arg)
176 T_ARRAY
177         U32 ix_$var = $argoff;
178         $var = $ntype(items -= $argoff);
179         while (items--) {
180             DO_ARRAY_ELEM;
181             ix_$var++;
182         }
183         /* this is the number of elements in the array */
184         ix_$var -= $argoff
185 T_STDIO
186         $var = PerlIO_findFILE(IoIFP(sv_2io($arg)))
187 T_IN
188         $var = IoIFP(sv_2io($arg))
189 T_INOUT
190         $var = IoIFP(sv_2io($arg))
191 T_OUT
192         $var = IoOFP(sv_2io($arg))
193 #############################################################################
194 OUTPUT
195 T_SV
196         $arg = $var;
197 T_SVREF
198         $arg = newRV((SV*)$var);
199 T_AVREF
200         $arg = newRV((SV*)$var);
201 T_HVREF
202         $arg = newRV((SV*)$var);
203 T_CVREF
204         $arg = newRV((SV*)$var);
205 T_IV
206         sv_setiv($arg, (IV)$var);
207 T_UV
208         sv_setuv($arg, (UV)$var);
209 T_INT
210         sv_setiv($arg, (IV)$var);
211 T_SYSRET
212         if ($var != -1) {
213             if ($var == 0)
214                 sv_setpvn($arg, "0 but true", 10);
215             else
216                 sv_setiv($arg, (IV)$var);
217         }
218 T_ENUM
219         sv_setiv($arg, (IV)$var);
220 T_BOOL
221         $arg = boolSV($var);
222 T_U_INT
223         sv_setuv($arg, (UV)$var);
224 T_SHORT
225         sv_setiv($arg, (IV)$var);
226 T_U_SHORT
227         sv_setuv($arg, (UV)$var);
228 T_LONG
229         sv_setiv($arg, (IV)$var);
230 T_U_LONG
231         sv_setuv($arg, (UV)$var);
232 T_CHAR
233         sv_setpvn($arg, (char *)&$var, 1);
234 T_U_CHAR
235         sv_setuv($arg, (UV)$var);
236 T_FLOAT
237         sv_setnv($arg, (double)$var);
238 T_NV
239         sv_setnv($arg, (NV)$var);
240 T_DOUBLE
241         sv_setnv($arg, (double)$var);
242 T_PV
243         sv_setpv((SV*)$arg, $var);
244 T_PTR
245         sv_setiv($arg, PTR2IV($var));
246 T_PTRREF
247         sv_setref_pv($arg, Nullch, (void*)$var);
248 T_REF_IV_REF
249         sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
250 T_REF_IV_PTR
251         sv_setref_pv($arg, \"${ntype}\", (void*)$var);
252 T_PTROBJ
253         sv_setref_pv($arg, \"${ntype}\", (void*)$var);
254 T_PTRDESC
255         sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
256 T_REFREF
257         NOT_IMPLEMENTED
258 T_REFOBJ
259         NOT IMPLEMENTED
260 T_OPAQUE
261         sv_setpvn($arg, (char *)&$var, sizeof($var));
262 T_OPAQUEPTR
263         sv_setpvn($arg, (char *)$var, sizeof(*$var));
264 T_PACKED
265         XS_pack_$ntype($arg, $var);
266 T_PACKEDARRAY
267         XS_pack_$ntype($arg, $var, count_$ntype);
268 T_DATAUNIT      
269         sv_setpvn($arg, $var.chp(), $var.size());
270 T_CALLBACK
271         sv_setpvn($arg, $var.context.value().chp(),
272                 $var.context.value().size());
273 T_ARRAY
274         {
275             U32 ix_$var;
276             EXTEND(SP,size_$var);
277             for (ix_$var = 0; ix_$var < size_$var; ix_$var++) {
278                 ST(ix_$var) = sv_newmortal();
279         DO_ARRAY_ELEM
280             }
281         }
282 T_STDIO
283         {
284             GV *gv = newGVgen("$Package");
285             PerlIO *fp = PerlIO_importFILE($var,0);
286             if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) )
287                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
288             else
289                 $arg = &PL_sv_undef;
290         }
291 T_IN
292         {
293             GV *gv = newGVgen("$Package");
294             if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
295                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
296             else
297                 $arg = &PL_sv_undef;
298         }
299 T_INOUT
300         {
301             GV *gv = newGVgen("$Package");
302             if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
303                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
304             else
305                 $arg = &PL_sv_undef;
306         }
307 T_OUT
308         {
309             GV *gv = newGVgen("$Package");
310             if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
311                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
312             else
313                 $arg = &PL_sv_undef;
314         }