threads is no longer customized, as of commit c0ff91434b

[perl5.git] / ext / XS-Typemap / Typemap.xs

diff --git a/ext/XS-Typemap/Typemap.xs b/ext/XS-Typemap/Typemap.xs
index 6fd19a8..3fa0e74 100644 (file)
--- a/ext/XS-Typemap/Typemap.xs
+++ b/ext/XS-Typemap/Typemap.xs
@@ -30,8 +30,8 @@ typedef int intTLONG; /* T_LONG */
 typedef short shortOPQ;   /* T_OPAQUE */
 typedef int intOpq;   /* T_OPAQUEPTR */
 typedef unsigned intUnsigned; /* T_U_INT */
-typedef PerlIO inputfh; /* T_IN */
-typedef PerlIO outputfh; /* T_OUT */
+typedef PerlIO * inputfh; /* T_IN */
+typedef PerlIO * outputfh; /* T_OUT */
 
 /* A structure to test T_OPAQUEPTR and T_PACKED */
 struct t_opaqueptr {
@@ -67,14 +67,19 @@ intArray * intArrayPtr( int nelem ) {
 }
 
 /* test T_PACKED */
-#define XS_pack_anotherstructPtr(out, in)                  \
-    STMT_START {                                           \
-      HV *hash = newHV();                                  \
-      hv_stores(hash, "a", newSViv((in)->a));              \
-      hv_stores(hash, "b", newSViv((in)->b));              \
-      hv_stores(hash, "c", newSVnv((in)->c));              \
-      sv_setsv((out), sv_2mortal(newRV_noinc((SV*)hash))); \
-    } STMT_END
+STATIC void
+XS_pack_anotherstructPtr(SV *out, anotherstruct *in)
+{
+    dTHX;
+    HV *hash = newHV();
+    if (NULL == hv_stores(hash, "a", newSViv(in->a)))
+      croak("Failed to store data in hash");
+    if (NULL == hv_stores(hash, "b", newSViv(in->b)))
+      croak("Failed to store data in hash");
+    if (NULL == hv_stores(hash, "c", newSVnv(in->c)))
+      croak("Failed to store data in hash");
+    sv_setsv(out, sv_2mortal(newRV_noinc((SV*)hash)));
+}
 
 STATIC anotherstruct *
 XS_unpack_anotherstructPtr(SV *in)
@@ -113,19 +118,24 @@ XS_unpack_anotherstructPtr(SV *in)
 }
 
 /* test T_PACKEDARRAY */
-#define XS_pack_anotherstructPtrPtr(out, in, cnt)          \
-    STMT_START {                                           \
-      UV i;                                                \
-      AV *ary = newAV();                                   \
-      for (i = 0; i < cnt; ++i) {                          \
-        HV *hash = newHV();                                \
-        hv_stores(hash, "a", newSViv((in)[i]->a));         \
-        hv_stores(hash, "b", newSViv((in)[i]->b));         \
-        hv_stores(hash, "c", newSVnv((in)[i]->c));         \
-        av_push(ary, newRV_noinc((SV*)hash));              \
-      }                                                    \
-      sv_setsv((out), sv_2mortal(newRV_noinc((SV*)ary)));  \
-    } STMT_END
+STATIC void
+XS_pack_anotherstructPtrPtr(SV *out, anotherstruct **in, UV cnt)
+{
+    dTHX;
+    UV i;
+    AV *ary = newAV();
+    for (i = 0; i < cnt; ++i) {
+        HV *hash = newHV();
+        if (NULL == hv_stores(hash, "a", newSViv(in[i]->a)))
+          croak("Failed to store data in hash");
+        if (NULL == hv_stores(hash, "b", newSViv(in[i]->b)))
+          croak("Failed to store data in hash");
+        if (NULL == hv_stores(hash, "c", newSVnv(in[i]->c)))
+          croak("Failed to store data in hash");
+        av_push(ary, newRV_noinc((SV*)hash));
+    }
+    sv_setsv(out, sv_2mortal(newRV_noinc((SV*)ary)));
+}
 
 STATIC anotherstruct **
 XS_unpack_anotherstructPtrPtr(SV *in)
@@ -143,11 +153,11 @@ XS_unpack_anotherstructPtrPtr(SV *in)
     tmp = in;
     SvGETMAGIC(tmp);
     if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVAV)
-       inary = (AV*)SvRV(tmp);
+        inary = (AV*)SvRV(tmp);
     else
         Perl_croak(aTHX_ "Argument is not an ARRAY reference");
 
-    nitems = av_len(inary) + 1;
+    nitems = av_tindex(inary) + 1;
 
     /* FIXME dunno if supposed to use perl mallocs here */
     /* N+1 elements so we know the last one is NULL */
@@ -157,32 +167,31 @@ XS_unpack_anotherstructPtrPtr(SV *in)
      *          since we're testing perl, if we croak() here, stuff is
      *          rotten anyway! */
     for (i = 0; i < nitems; ++i) {
-      Newxz(out[i], 1, anotherstruct);
-      elem = av_fetch(inary, i, 0);
-      if (elem == NULL)
-        Perl_croak(aTHX_ "Shouldn't happen: av_fetch returns NULL");
-      tmp = *elem;
-      SvGETMAGIC(tmp);
-      if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVHV)
-         inhash = (HV*)SvRV(tmp);
-      else
-          Perl_croak(aTHX_ "Array element %u is not a HASH reference", i);
-
-      elem = hv_fetchs(inhash, "a", 0);
-      if (elem == NULL)
-        Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
-      out[i]->a = SvIV(*elem);
-
-      elem = hv_fetchs(inhash, "b", 0);
-      if (elem == NULL)
-        Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
-      out[i]->b = SvIV(*elem);
-
-      elem = hv_fetchs(inhash, "c", 0);
-      if (elem == NULL)
-        Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
-      out[i]->c = SvNV(*elem);
-
+        Newxz(out[i], 1, anotherstruct);
+        elem = av_fetch(inary, i, 0);
+        if (elem == NULL)
+            Perl_croak(aTHX_ "Shouldn't happen: av_fetch returns NULL");
+        tmp = *elem;
+        SvGETMAGIC(tmp);
+        if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVHV)
+            inhash = (HV*)SvRV(tmp);
+        else
+            Perl_croak(aTHX_ "Array element %"UVuf" is not a HASH reference", i);
+
+        elem = hv_fetchs(inhash, "a", 0);
+        if (elem == NULL)
+            Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
+        out[i]->a = SvIV(*elem);
+
+        elem = hv_fetchs(inhash, "b", 0);
+        if (elem == NULL)
+            Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
+        out[i]->b = SvIV(*elem);
+
+        elem = hv_fetchs(inhash, "c", 0);
+        if (elem == NULL)
+            Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
+        out[i]->c = SvNV(*elem);
     }
 
     return out;
@@ -193,10 +202,10 @@ XS_unpack_anotherstructPtrPtr(SV *in)
 void
 XS_release_anotherstructPtrPtr(anotherstruct **in)
 {
-  unsigned int i = 0;
-  while (in[i] != NULL)
-    Safefree(in[i++]);
-  Safefree(in);
+    unsigned int i = 0;
+    while (in[i] != NULL)
+        Safefree(in[i++]);
+    Safefree(in);
 }
 
 
@@ -427,6 +436,22 @@ T_BOOL( in )
  OUTPUT:
   RETVAL
 
+bool
+T_BOOL_2( in )
+  bool in
+ CODE:
+    PERL_UNUSED_VAR(RETVAL);
+ OUTPUT:
+   in
+
+void
+T_BOOL_OUT( out, in )
+  bool out
+  bool in
+ CODE:
+ out = in;
+ OUTPUT:
+   out
 
 ## T_U_INT
 
@@ -547,6 +572,13 @@ T_PV( in )
  OUTPUT:
   RETVAL
 
+char *
+T_PV_null()
+ CODE:
+  RETVAL = NULL;
+ OUTPUT:
+  RETVAL
+
 
 ## T_PTR