Add tests for cinv

Author: jonahbeckford

tests/clib/test_functions.c

@@ -414,6 +414,11 @@ void mul_complexd(ctypes_complex_double *l, ctypes_complex_double *r, ctypes_com
   *out = ctypes_compat_cmul(*l, *r);
 }
 
+void inv_complexd(ctypes_complex_double *a, ctypes_complex_double *out)
+{
+  *out = ctypes_compat_cinv(*a);
+}
+
 void rotdist_complexd(ctypes_complex_double *c, double *r, double *out) {
   ctypes_complex_double x = ctypes_compat_cmul(*c, (ctypes_compat_make_complex(cos(*r), sin(*r))));
   *out = fabs(ctypes_compat_creal(x)) + fabs(ctypes_compat_cimag(x));
@@ -429,6 +434,11 @@ void mul_complexld(ctypes_complex_long_double *l, ctypes_complex_long_double *r,
   *out = ctypes_compat_cmull(*l,  *r);
 }
 
+void inv_complexld(ctypes_complex_long_double *a, ctypes_complex_long_double *out)
+{
+  *out = ctypes_compat_cinvl(*a);
+}
+
 void rotdist_complexld(ctypes_complex_long_double *c, long double *r, long double *out) {
   ctypes_complex_long_double x = ctypes_compat_cmull(*c, (ctypes_compat_make_complexl(cosl(*r), sinl(*r))));
   *out = fabsl(ctypes_compat_creall(x)) + fabsl(ctypes_compat_cimagl(x));
@@ -439,6 +449,11 @@ void add_complexf(ctypes_complex_float *l, ctypes_complex_float *r, ctypes_compl
   *out = ctypes_compat_caddf(*l, *r);
 }
 
+void inv_complexf(ctypes_complex_float *a, ctypes_complex_float *out)
+{
+  *out = ctypes_compat_cinvf(*a);
+}
+
 void mul_complexf(ctypes_complex_float *l, ctypes_complex_float *r, ctypes_complex_float *out)
 {
   *out = ctypes_compat_cmulf(*l, *r);
@@ -459,6 +474,11 @@ ctypes_complex_long_double mul_complexld_val(ctypes_complex_long_double l, ctype
   return ctypes_compat_cmull(l, r);
 }
 
+ctypes_complex_long_double inv_complexld_val(ctypes_complex_long_double a)
+{
+  return ctypes_compat_cinvl(a);
+}
+
 long double rotdist_complexld_val(ctypes_complex_long_double c, long double r) {
   ctypes_complex_long_double x = ctypes_compat_cmull(c, (ctypes_compat_make_complexl(cosl(r), sinl(r))));
   return fabsl(ctypes_compat_creall(x)) + fabsl(ctypes_compat_cimagl(x));
@@ -474,6 +494,11 @@ ctypes_complex_double mul_complexd_val(ctypes_complex_double l, ctypes_complex_d
   return ctypes_compat_cmul(l, r);
 }
 
+ctypes_complex_double inv_complexd_val(ctypes_complex_double a)
+{
+  return ctypes_compat_cinv(a);
+}
+
 double rotdist_complexd_val(ctypes_complex_double c, double r) {
   ctypes_complex_double x = ctypes_compat_cmul(c, (ctypes_compat_make_complex(cos(r), sin(r))));
   return fabs(ctypes_compat_creal(x)) + fabs(ctypes_compat_cimag(x));
@@ -489,6 +514,11 @@ ctypes_complex_float mul_complexf_val(ctypes_complex_float l, ctypes_complex_flo
   return ctypes_compat_cmulf(l, r);
 }
 
+ctypes_complex_float inv_complexf_val(ctypes_complex_float a)
+{
+  return ctypes_compat_cinvf(a);
+}
+
 float rotdist_complexf_val(ctypes_complex_float c, float r) {
   ctypes_complex_float x = ctypes_compat_cmulf(c, (ctypes_compat_make_complexf(cosf(r), sinf(r))));
   return fabsf(ctypes_compat_crealf(x)) + fabsf(ctypes_compat_cimagf(x));

tests/clib/test_functions.h

@@ -162,21 +162,27 @@ DLL_EXTERN double retrieve_DBL_MIN(void);
 DLL_EXTERN double retrieve_DBL_MAX(void);
 DLL_EXTERN void add_complexd(ctypes_complex_double *, ctypes_complex_double *, ctypes_complex_double *);
 DLL_EXTERN void mul_complexd(ctypes_complex_double *, ctypes_complex_double *, ctypes_complex_double *);
+DLL_EXTERN void inv_complexd(ctypes_complex_double *, ctypes_complex_double *);
 DLL_EXTERN void rotdist_complexd(ctypes_complex_double *, double *, double *);
 DLL_EXTERN void add_complexld(ctypes_complex_long_double *, ctypes_complex_long_double *, ctypes_complex_long_double *);
 DLL_EXTERN void mul_complexld(ctypes_complex_long_double *, ctypes_complex_long_double *, ctypes_complex_long_double *);
+DLL_EXTERN void inv_complexld(ctypes_complex_long_double *, ctypes_complex_long_double *);
 DLL_EXTERN void rotdist_complexld(ctypes_complex_long_double *, long double *, long double *);
 DLL_EXTERN void add_complexf(ctypes_complex_float *, ctypes_complex_float *, ctypes_complex_float *);
 DLL_EXTERN void mul_complexf(ctypes_complex_float *, ctypes_complex_float *, ctypes_complex_float *);
+DLL_EXTERN void inv_complexf(ctypes_complex_float *, ctypes_complex_float *);
 DLL_EXTERN void rotdist_complexf(ctypes_complex_float *, float *, float *);
 DLL_EXTERN ctypes_complex_double add_complexd_val(ctypes_complex_double, ctypes_complex_double);
 DLL_EXTERN ctypes_complex_double mul_complexd_val(ctypes_complex_double, ctypes_complex_double);
+DLL_EXTERN ctypes_complex_double inv_complexd_val(ctypes_complex_double);
 DLL_EXTERN double rotdist_complexd_val(ctypes_complex_double, double);
 DLL_EXTERN ctypes_complex_long_double add_complexld_val(ctypes_complex_long_double, ctypes_complex_long_double);
 DLL_EXTERN ctypes_complex_long_double mul_complexld_val(ctypes_complex_long_double, ctypes_complex_long_double);
+DLL_EXTERN ctypes_complex_long_double inv_complexld_val(ctypes_complex_long_double);
 DLL_EXTERN long double rotdist_complexld_val(ctypes_complex_long_double, long double);
 DLL_EXTERN ctypes_complex_float add_complexf_val(ctypes_complex_float, ctypes_complex_float);
 DLL_EXTERN ctypes_complex_float mul_complexf_val(ctypes_complex_float, ctypes_complex_float);
+DLL_EXTERN ctypes_complex_float inv_complexf_val(ctypes_complex_float);
 DLL_EXTERN float rotdist_complexf_val(ctypes_complex_float, float);
 DLL_EXTERN void store_callback(int (*callback)(int));
 DLL_EXTERN int invoke_stored_callback(int);

tests/test-complex/stubs/functions.ml

@@ -17,15 +17,21 @@ struct
     F.(foreign name
          (ptr typ1 @-> ptr typ2 @-> ptr typ2 @-> returning void))
   let bind typ name = bind' typ typ name
+  let bind1 typ1 name =
+    F.(foreign name
+         (ptr typ1 @-> ptr typ1 @-> returning void))
 
   let add_complexd = bind complex64 "add_complexd"
   let mul_complexd = bind complex64 "mul_complexd"
+  let inv_complexd = bind1 complex64 "inv_complexd"
   let rotdist_complexd = bind' complex64 double "rotdist_complexd"
   let add_complexld = bind complexld "add_complexld"
   let mul_complexld = bind complexld "mul_complexld"
+  let inv_complexld = bind1 complexld "inv_complexld"
   let rotdist_complexld = bind' complexld ldouble "rotdist_complexld"
   let add_complexf = bind complex32 "add_complexf"
   let mul_complexf = bind complex32 "mul_complexf"
+  let inv_complexf = bind1 complex32 "inv_complexf"
   let rotdist_complexf = bind' complex32 float "rotdist_complexf"
 end
 
@@ -36,15 +42,21 @@ struct
   let bind' typ1 typ2 name =
     F.(foreign name (typ1 @-> typ2 @-> returning typ2))
   let bind typ name = bind' typ typ name
+  let bind1' typ1 name =
+    F.(foreign name (typ1 @-> returning typ1))
+  let bind1 typ name = bind1' typ name
 
   let add_complexd_val = bind complex64 "add_complexd_val"
   let mul_complexd_val = bind complex64 "mul_complexd_val"
+  let inv_complexd_val = bind1 complex64 "inv_complexd_val"
   let rotdist_complexd_val = bind' complex64 double "rotdist_complexd_val"
   let add_complexld_val = bind complexld "add_complexld_val"
   let mul_complexld_val = bind complexld "mul_complexld_val"
+  let inv_complexld_val = bind1 complexld "inv_complexld_val"
   let rotdist_complexld_val = bind' complexld ldouble "rotdist_complexld_val"
   let add_complexf_val = bind complex32 "add_complexf_val"
   let mul_complexf_val = bind complex32 "mul_complexf_val"
+  let inv_complexf_val = bind1 complex32 "inv_complexf_val"
   let rotdist_complexf_val = bind' complex32 float "rotdist_complexf_val"
 end
 

tests/test-complex/test_complex.ml

@@ -31,15 +31,23 @@ struct
       !@rv
     in
     let wrap typ f l r = wrap' typ typ f l r in
+    let wrap1 typ1 f a =
+      let rv = allocate_n ~count:1 typ1 in
+      f (allocate typ1 a) rv;
+      !@rv
+    in
 
     let addz64 = wrap complex64 add_complexd
     and mulz64 = wrap complex64 mul_complexd
+    and invz64 = wrap1 complex64 inv_complexd
     and rotz64 = wrap' complex64 double rotdist_complexd
     and addz32 = wrap complex32 add_complexf
     and mulz32 = wrap complex32 mul_complexf
+    and invz32 = wrap1 complex32 inv_complexf
     and rotz32 = wrap' complex32 float rotdist_complexf
     and addzld = wrap complexld add_complexld
     and mulzld = wrap complexld mul_complexld
+    and invzld = wrap1 complexld inv_complexld
     and rotzld = wrap' complexld ldouble rotdist_complexld
     in
 
@@ -58,9 +66,11 @@ struct
 
       assert_equal ~cmp:complex64_eq (Complex.add l r) (addz64 l r);
       assert_equal ~cmp:complex64_eq (Complex.mul l r) (mulz64 l r);
+      assert_equal ~cmp:complex64_eq (Complex.inv l)   (invz64 l);
 
       assert_equal ~cmp:complex32_eq (Complex.add l r) (addz32 l r);
       assert_equal ~cmp:complex32_eq (Complex.mul l r) (mulz32 l r);
+      assert_equal ~cmp:complex32_eq (Complex.inv l)   (invz32 l);
 
       (* test long double complex *)
       let re x = LDouble.(to_float (ComplexL.re x)) in
@@ -71,6 +81,7 @@ struct
       let l', r' = to_complexld l, to_complexld r in
       assert_equal ~cmp:complex64_eq (Complex.add l r) (of_complexld @@ addzld l' r');
       assert_equal ~cmp:complex64_eq (Complex.mul l r) (of_complexld @@ mulzld l' r');
+      assert_equal ~cmp:complex64_eq (Complex.inv l)   (of_complexld @@ invzld l');
 
       (* The rotdist test is designed to check passing and returning long doubles.
          The function rotates a complex number by the given angle in radians,
@@ -125,9 +136,11 @@ struct
 
       assert_equal ~cmp:complex64_eq (Complex.add l r) (add_complexd_val l r);
       assert_equal ~cmp:complex64_eq (Complex.mul l r) (mul_complexd_val l r);
+      assert_equal ~cmp:complex64_eq (Complex.inv l) (inv_complexd_val l);
 
       assert_equal ~cmp:complex32_eq (Complex.add l r) (add_complexf_val l r);
       assert_equal ~cmp:complex32_eq (Complex.mul l r) (mul_complexf_val l r);
+      assert_equal ~cmp:complex32_eq (Complex.inv l) (inv_complexf_val l);
 
       let zinf = { re = 0.; im = infinity } in
       let res = add_complexd_val zinf zinf in
@@ -147,6 +160,7 @@ struct
       let l', r' = to_complexld l, to_complexld r in
       assert_equal ~cmp:complex64_eq (Complex.add l r) (of_complexld @@ add_complexld_val l' r');
       assert_equal ~cmp:complex64_eq (Complex.mul l r) (of_complexld @@ mul_complexld_val l' r');
+      assert_equal ~cmp:complex64_eq (Complex.inv l) (of_complexld @@ inv_complexld_val l');
 
       assert_equal 0. (re (to_complexld zinf));