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 02b2e5c..3fa0e74 100644 (file)
--- a/ext/XS-Typemap/Typemap.xs
+++ b/ext/XS-Typemap/Typemap.xs
@@ -30,10 +30,8 @@ typedef int intTLONG; /* T_LONG */
 typedef short shortOPQ;   /* T_OPAQUE */
 typedef int intOpq;   /* T_OPAQUEPTR */
 typedef unsigned intUnsigned; /* T_U_INT */
-
-/* Craig reports problems with the PerlIO related tests (VMS?) */
-/* 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 {
@@ -69,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)
@@ -115,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)
@@ -149,7 +157,7 @@ XS_unpack_anotherstructPtrPtr(SV *in)
     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 */
@@ -168,7 +176,7 @@ XS_unpack_anotherstructPtrPtr(SV *in)
         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);
+            Perl_croak(aTHX_ "Array element %"UVuf" is not a HASH reference", i);
 
         elem = hv_fetchs(inhash, "a", 0);
         if (elem == NULL)
@@ -235,10 +243,8 @@ AV_FIXED *  T_AVREF_REFCOUNT_FIXED
 HV_FIXED *      T_HVREF_REFCOUNT_FIXED
 CV_FIXED *      T_CVREF_REFCOUNT_FIXED
 SVREF_FIXED     T_SVREF_REFCOUNT_FIXED
-
-# Craig reports problems with PerlIO related typemap tests (VMS?)
-#inputfh          T_IN
-#outputfh         T_OUT
+inputfh          T_IN
+outputfh         T_OUT
 
 END_OF_TYPEMAP
 
@@ -430,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
 
@@ -550,6 +572,13 @@ T_PV( in )
  OUTPUT:
   RETVAL
 
+char *
+T_PV_null()
+ CODE:
+  RETVAL = NULL;
+ OUTPUT:
+  RETVAL
+
 
 ## T_PTR
 
@@ -905,35 +934,30 @@ T_STDIO_print( stream, string )
 
 ## T_INOUT
 
-## Craig reports issues with PerlIO related typemap tests (VMS?)
-
-## PerlIO *
-## T_INOUT(in)
-##   PerlIO *in;
-##  CODE:
-##   RETVAL = in; /* silly test but better than nothing */
-##  OUTPUT: RETVAL
+PerlIO *
+T_INOUT(in)
+  PerlIO *in;
+ CODE:
+  RETVAL = in; /* silly test but better than nothing */
+ OUTPUT: RETVAL
 
 
 ## T_IN
 
-## Craig reports issues with PerlIO related typemap tests (VMS?)
-
-## inputfh
-## T_IN(in)
-##   inputfh in;
-##  CODE:
-##   RETVAL = in; /* silly test but better than nothing */
-##  OUTPUT: RETVAL
+inputfh
+T_IN(in)
+  inputfh in;
+ CODE:
+  RETVAL = in; /* silly test but better than nothing */
+ OUTPUT: RETVAL
 
 
 ## T_OUT
 
-## Craig reports issues with PerlIO related typemap tests (VMS?)
-## outputfh
-## T_OUT(in)
-##   outputfh in;
-##  CODE:
-##   RETVAL = in; /* silly test but better than nothing */
-##  OUTPUT: RETVAL
+outputfh
+T_OUT(in)
+  outputfh in;
+ CODE:
+  RETVAL = in; /* silly test but better than nothing */
+ OUTPUT: RETVAL