vcs.maemo.org Git - pkg-perl/blob - deb-src/libextutils-parsexs-perl/libextutils-parsexs-perl-2.220200/t/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_ \"%s: %s is not a reference\",
  65                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
  66                         \"$var\")
  67 T_AVREF
  68         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
  69             $var = (AV*)SvRV($arg);
  70         else
  71             Perl_croak(aTHX_ \"%s: %s is not an array reference\",
  72                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
  73                         \"$var\")
  74 T_HVREF
  75         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV)
  76             $var = (HV*)SvRV($arg);
  77         else
  78             Perl_croak(aTHX_ \"%s: %s is not a hash reference\",
  79                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
  80                         \"$var\")
  81 T_CVREF
  82         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVCV)
  83             $var = (CV*)SvRV($arg);
  84         else
  85             Perl_croak(aTHX_ \"%s: %s is not a code reference\",
  86                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
  87                         \"$var\")
  88 T_SYSRET
  89         $var NOT IMPLEMENTED
  90 T_UV
  91         $var = ($type)SvUV($arg)
  92 T_IV
  93         $var = ($type)SvIV($arg)
  94 T_INT
  95         $var = (int)SvIV($arg)
  96 T_ENUM
  97         $var = ($type)SvIV($arg)
  98 T_BOOL
  99         $var = (bool)SvTRUE($arg)
 100 T_U_INT
 101         $var = (unsigned int)SvUV($arg)
 102 T_SHORT
 103         $var = (short)SvIV($arg)
 104 T_U_SHORT
 105         $var = (unsigned short)SvUV($arg)
 106 T_LONG
 107         $var = (long)SvIV($arg)
 108 T_U_LONG
 109         $var = (unsigned long)SvUV($arg)
 110 T_CHAR
 111         $var = (char)*SvPV_nolen($arg)
 112 T_U_CHAR
 113         $var = (unsigned char)SvUV($arg)
 114 T_FLOAT
 115         $var = (float)SvNV($arg)
 116 T_NV
 117         $var = ($type)SvNV($arg)
 118 T_DOUBLE
 119         $var = (double)SvNV($arg)
 120 T_PV
 121         $var = ($type)SvPV_nolen($arg)
 122 T_PTR
 123         $var = INT2PTR($type,SvIV($arg))
 124 T_PTRREF
 125         if (SvROK($arg)) {
 126             IV tmp = SvIV((SV*)SvRV($arg));
 127             $var = INT2PTR($type,tmp);
 128         }
 129         else
 130             Perl_croak(aTHX_ \"%s: %s is not a reference\",
 131                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 132                         \"$var\")
 133 T_REF_IV_REF
 134         if (sv_isa($arg, \"${ntype}\")) {
 135             IV tmp = SvIV((SV*)SvRV($arg));
 136             $var = *INT2PTR($type *, tmp);
 137         }
 138         else
 139             Perl_croak(aTHX_ \"%s: %s is not of type %s\",
 140                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 141                         \"$var\", \"$ntype\")
 142 T_REF_IV_PTR
 143         if (sv_isa($arg, \"${ntype}\")) {
 144             IV tmp = SvIV((SV*)SvRV($arg));
 145             $var = INT2PTR($type, tmp);
 146         }
 147         else
 148             Perl_croak(aTHX_ \"%s: %s is not of type %s\",
 149                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 150                         \"$var\", \"$ntype\")
 151 T_PTROBJ
 152         if (sv_derived_from($arg, \"${ntype}\")) {
 153             IV tmp = SvIV((SV*)SvRV($arg));
 154             $var = INT2PTR($type,tmp);
 155         }
 156         else
 157             Perl_croak(aTHX_ \"%s: %s is not of type %s\",
 158                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 159                         \"$var\", \"$ntype\")
 160 T_PTRDESC
 161         if (sv_isa($arg, \"${ntype}\")) {
 162             IV tmp = SvIV((SV*)SvRV($arg));
 163             ${type}_desc = (\U${type}_DESC\E*) tmp;
 164             $var = ${type}_desc->ptr;
 165         }
 166         else
 167             Perl_croak(aTHX_ \"%s: %s is not of type %s\",
 168                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 169                         \"$var\", \"$ntype\")
 170 T_REFREF
 171         if (SvROK($arg)) {
 172             IV tmp = SvIV((SV*)SvRV($arg));
 173             $var = *INT2PTR($type,tmp);
 174         }
 175         else
 176             Perl_croak(aTHX_ \"%s: %s is not a reference\",
 177                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 178                         \"$var\")
 179 T_REFOBJ
 180         if (sv_isa($arg, \"${ntype}\")) {
 181             IV tmp = SvIV((SV*)SvRV($arg));
 182             $var = *INT2PTR($type,tmp);
 183         }
 184         else
 185             Perl_croak(aTHX_ \"%s: %s is not of type %s\",
 186                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 187                         \"$var\", \"$ntype\")
 188 T_OPAQUE
 189         $var = *($type *)SvPV_nolen($arg)
 190 T_OPAQUEPTR
 191         $var = ($type)SvPV_nolen($arg)
 192 T_PACKED
 193         $var = XS_unpack_$ntype($arg)
 194 T_PACKEDARRAY
 195         $var = XS_unpack_$ntype($arg)
 196 T_CALLBACK
 197         $var = make_perl_cb_$type($arg)
 198 T_ARRAY
 199         U32 ix_$var = $argoff;
 200         $var = $ntype(items -= $argoff);
 201         while (items--) {
 202             DO_ARRAY_ELEM;
 203             ix_$var++;
 204         }
 205         /* this is the number of elements in the array */
 206         ix_$var -= $argoff
 207 T_STDIO
 208         $var = PerlIO_findFILE(IoIFP(sv_2io($arg)))
 209 T_IN
 210         $var = IoIFP(sv_2io($arg))
 211 T_INOUT
 212         $var = IoIFP(sv_2io($arg))
 213 T_OUT
 214         $var = IoOFP(sv_2io($arg))
 215 #############################################################################
 216 OUTPUT
 217 T_SV
 218         $arg = $var;
 219 T_SVREF
 220         $arg = newRV((SV*)$var);
 221 T_AVREF
 222         $arg = newRV((SV*)$var);
 223 T_HVREF
 224         $arg = newRV((SV*)$var);
 225 T_CVREF
 226         $arg = newRV((SV*)$var);
 227 T_IV
 228         sv_setiv($arg, (IV)$var);
 229 T_UV
 230         sv_setuv($arg, (UV)$var);
 231 T_INT
 232         sv_setiv($arg, (IV)$var);
 233 T_SYSRET
 234         if ($var != -1) {
 235             if ($var == 0)
 236                 sv_setpvn($arg, "0 but true", 10);
 237             else
 238                 sv_setiv($arg, (IV)$var);
 239         }
 240 T_ENUM
 241         sv_setiv($arg, (IV)$var);
 242 T_BOOL
 243         $arg = boolSV($var);
 244 T_U_INT
 245         sv_setuv($arg, (UV)$var);
 246 T_SHORT
 247         sv_setiv($arg, (IV)$var);
 248 T_U_SHORT
 249         sv_setuv($arg, (UV)$var);
 250 T_LONG
 251         sv_setiv($arg, (IV)$var);
 252 T_U_LONG
 253         sv_setuv($arg, (UV)$var);
 254 T_CHAR
 255         sv_setpvn($arg, (char *)&$var, 1);
 256 T_U_CHAR
 257         sv_setuv($arg, (UV)$var);
 258 T_FLOAT
 259         sv_setnv($arg, (double)$var);
 260 T_NV
 261         sv_setnv($arg, (NV)$var);
 262 T_DOUBLE
 263         sv_setnv($arg, (double)$var);
 264 T_PV
 265         sv_setpv((SV*)$arg, $var);
 266 T_PTR
 267         sv_setiv($arg, PTR2IV($var));
 268 T_PTRREF
 269         sv_setref_pv($arg, Nullch, (void*)$var);
 270 T_REF_IV_REF
 271         sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
 272 T_REF_IV_PTR
 273         sv_setref_pv($arg, \"${ntype}\", (void*)$var);
 274 T_PTROBJ
 275         sv_setref_pv($arg, \"${ntype}\", (void*)$var);
 276 T_PTRDESC
 277         sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
 278 T_REFREF
 279         NOT_IMPLEMENTED
 280 T_REFOBJ
 281         NOT IMPLEMENTED
 282 T_OPAQUE
 283         sv_setpvn($arg, (char *)&$var, sizeof($var));
 284 T_OPAQUEPTR
 285         sv_setpvn($arg, (char *)$var, sizeof(*$var));
 286 T_PACKED
 287         XS_pack_$ntype($arg, $var);
 288 T_PACKEDARRAY
 289         XS_pack_$ntype($arg, $var, count_$ntype);
 290 T_DATAUNIT
 291         sv_setpvn($arg, $var.chp(), $var.size());
 292 T_CALLBACK
 293         sv_setpvn($arg, $var.context.value().chp(),
 294                 $var.context.value().size());
 295 T_ARRAY
 296         {
 297             U32 ix_$var;
 298             EXTEND(SP,size_$var);
 299             for (ix_$var = 0; ix_$var < size_$var; ix_$var++) {
 300                 ST(ix_$var) = sv_newmortal();
 301         DO_ARRAY_ELEM
 302             }
 303         }
 304 T_STDIO
 305         {
 306             GV *gv = newGVgen("$Package");
 307             PerlIO *fp = PerlIO_importFILE($var,0);
 308             if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) )
 309                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
 310             else
 311                 $arg = &PL_sv_undef;
 312         }
 313 T_IN
 314         {
 315             GV *gv = newGVgen("$Package");
 316             if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
 317                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
 318             else
 319                 $arg = &PL_sv_undef;
 320         }
 321 T_INOUT
 322         {
 323             GV *gv = newGVgen("$Package");
 324             if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
 325                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
 326             else
 327                 $arg = &PL_sv_undef;
 328         }
 329 T_OUT
 330         {
 331             GV *gv = newGVgen("$Package");
 332             if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
 333                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
 334             else
 335                 $arg = &PL_sv_undef;
 336         }