support gs_float in Fortran interface and fix gs_test

Author: stgeke

src/gs.c

@@ -1555,7 +1555,7 @@ static void fgs_check_handle(sint handle, const char *func, unsigned line)
     fail(1,__FILE__,line,"%s: invalid handle", func);
 }
 
-static const gs_dom fgs_dom[4] = { 0, gs_double, gs_sint, gs_slong };
+static const gs_dom fgs_dom[4] = { gs_float, gs_double, gs_sint, gs_slong };
 
 static void fgs_check_parms(sint handle, sint dom, sint op,
                             const char *func, unsigned line)

tests/gs_test.c

@@ -1,9 +1,19 @@
 #include <assert.h>
 #include <math.h>
+#include <float.h>
 #include "gslib.h"
 
 typedef double T;
 const gs_dom dom = gs_double;
+#define EPS (3*DBL_EPSILON)
+
+/*
+typedef float T;
+const gs_dom dom = gs_float;
+#define EPS (3*FLT_EPSILON)
+*/
+
+#define PI 3.14159265358979323846
 
 static void test(const struct comm *comm, gs_method method)
 {
@@ -49,48 +59,46 @@ static void test(const struct comm *comm, gs_method method)
 
   /* non-blocking gs, gs_many and gs_vec */
   uint neighbors = 3; //max neighbors, counting ownself
-  slong id1[neighbors];
-  slong me = (slong)comm->id;
+  slong *id1 = tmalloc(slong,neighbors);
+  const slong me = (slong)comm->id;
   uint count=0;
   if(me>0) id1[count++]=me;
   id1[count++]=me+1;
   if(me<np-1) id1[count++]=me+2;
   neighbors=count;
 
-  struct gs_data *gsh1;
-  gsh1 = gs_setup(id1,neighbors,comm,0,method,0);
-
-  T answer[np];
-  if   (np==1) answer[0]=1.0;
+  double *answer = tmalloc(double,np);
+  if (np==1) {
+    answer[0]=1.0*PI;
+  }
   else {
-    answer[0]=answer[np-1]=2.0;
-    for(i=1;i<np-1;i++) answer[i]=3.0;
+    answer[0]=answer[np-1]=2.0*PI;
+    for(i=1;i<np-1;i++) answer[i]=3.0*PI;
   }
 
-  T u[neighbors];
-  for(i=0;i<neighbors;i++) u[i]=1.0;
+  gsh = gs_setup(id1,neighbors,comm,0,method,0);
 
+  T *u = tmalloc(T,neighbors);
+  for(i=0;i<neighbors;i++) u[i]=1.0*PI;
   igs(u,dom,gs_add,0,gsh,0,&handle);
   gs_wait(handle);
+  for(i=0;i<neighbors;i++) assert(fabs(u[i]-answer[id1[i]-1])<EPS);
+  free(u);
 
-  for(i=0;i<neighbors;i++) assert(fabs(u[i]-answer[id1[i]-1])<1e-16);
-
-  T w[neighbors][2];
-  for(i=0;i<neighbors;i++) w[i][0]=1.0,w[i][1]=2.0;
-  igs_vec(w,2,dom,gs_add,0,gsh,0,&handle);
-  gs_wait(handle);
-
-  for(i=0;i<neighbors;i++) assert(fabs(w[i][0]-answer[id1[i]-1])<1e-16);
-  for(i=0;i<neighbors;i++) assert(fabs(w[i][1]-2*answer[id1[i]-1])<1e-16);
-
-  T x1[neighbors], x2[neighbors];
-  for(i=0;i<neighbors;i++) x1[i]=1.0,x2[i]=2.0;
+  T *x1 = tmalloc(T,neighbors);
+  T *x2 = tmalloc(T,neighbors);
+  for(i=0;i<neighbors;i++) x1[i]=1.0*PI,x2[i]=2.0*PI;
   T *x[2] = {x1, x2};
   igs_many((void*)x,2,dom,gs_add,0,gsh,0,&handle);
   gs_wait(handle);
+  for(i=0;i<neighbors;i++) assert(fabs(x1[i]-answer[id1[i]-1])<EPS);
+  for(i=0;i<neighbors;i++) assert(fabs(x2[i]-2*answer[id1[i]-1])<EPS);
+  free(x1);
+  free(x2);
 
-  for(i=0;i<neighbors;i++) assert(fabs(x1[i]-answer[id1[i]-1])<1e-16);
-  for(i=0;i<neighbors;i++) assert(fabs(x2[i]-2*answer[id1[i]-1])<1e-16);
+  gs_free(gsh);
+  free(id1);
+  free(answer);
 }
 
 int main(int narg, char *arg[])