/* fortest.c zilla 24apr - test the foreign function interface
 * This file is separate from forfunc.c so it can be compiled separately,
 * e.g. with -xansi on sgis.
 */

#undef TESTIT
#ifdef TESTIT   /*%%%%%%%%%%%%%%%% TESTSECTION %%%%%%%%%%%%%%%%*/

#include <theusual.h>
#include <scheme.h>

static FILE *ftst = stdout;

void Define_Foreign Zproto((char *,vfunction *,char *));

#define ZTESTLOG    Define_Foreign("Ztestlog",(vfunction *)testlog,"RP");
static FILE *testlog() 
{
  char hostname[256];
  gethostname(hostname,256);
  ftst = fopen("FOREIGNTST.LOG","w");
  fprintf(ftst,";test of foreign function on %s on %s\n",
          hostname,Ztimestring(Zcurtime()));
  return ftst;
}

#define ZNOARGS   Define_Foreign("Znoargs",(vfunction *)noargs,"");
static void noargs() { int i = 3; fprintf(ftst,"Znoargs\n"); }

#define ZGETBOOL        Define_Foreign("Zgetbool",(vfunction *)getbool,"B");
static void getbool(i) int i; { fprintf(ftst,"Zgetbool: %d\n",i); }

#define ZRTNBOOL  Define_Foreign("Zrtnbool",(vfunction *)rtnbool,"BRB");
static bool rtnbool(i) int i; { fprintf(ftst,"Zrtnbool: %d\n",i); return i; }

#define ZGETINT  Define_Foreign("Zgetint",(vfunction *)getint,"I"); 
static void getint(i) int i; {  fprintf(ftst,"Zgetint: %d\n",i); }

#define ZGETDBL  Define_Foreign("Zgetdbl",(vfunction *)getdbl,"F");
static void getdbl(f) double f; {  fprintf(ftst,"Zgetdbl: %f\n",f); }

#define ZGETFLT  Define_Foreign("Zgetflt",(vfunction *)getflt,"f");
static void ZDECLARE1(getflt,float,f) {  fprintf(ftst,"Zgetflt: %f\n",f); }

#define ZF2F  Define_Foreign("Zf2f",(vfunction *)f2f,"ffRf");
static float ZDECLARE2(f2f,float,f1,float,f2)
{  fprintf(ftst,"Zf2f: %f %f\n",f1,f2); return f1+f2; }

#define ZD2D  Define_Foreign("Zd2d",(vfunction *)d2d,"FFRF");
static double d2d(f1,f2) double f1; double f2;
{  fprintf(ftst,"Zd2d: %f %f\n",f1,f2); return f1+f2; }

#define ZGETARR
#ifdef NOTYET
static void getarr(a,len) float a[]; int len;
{  int i;
   fprintf(ftst,"GETARR\n");
   for( i=0; i < len; i++ ) fprintf(ftst,"%f ",a[i]);
   fprintf(ftst,"\n(obtained len=%d, type=%d)\n",
          farray_clength(a),farray_ctype(a));
}
#endif

#define ZRTNINT  Define_Foreign("Zrtnint",(vfunction *)rtnint,"RI");
static int rtnint() { static int i = 133;  return ++i; }

#define ZSTRLEN Define_Foreign("Zstrlen",(vfunction *)zstrlen,"SRI");
static int zstrlen(str) char *str;
{ fprintf(ftst,"Zstrlen: [%s]=%d\n",str,strlen(str));
  return(strlen(str));
}

#define ZIRS  Define_Foreign("Zirs",(vfunction *)zirs,"IRS");
static char *zirs(i) int i;
{ static char s[32];
  fprintf(ftst,"Zirs: %d\n",i);
  str_cpy(s,"A string...");  return s; }

#define ZTWOI     Define_Foreign("Ztwoi",(vfunction *)twoi,"II");
static void twoi(i1,i2)  int i1,i2;
{  fprintf(ftst,"Ztwoi: %d %d \n",i1,i2); }

#define ZFIVEI    Define_Foreign("Zfivei",(vfunction *)fivei,"IIIII");
static void fivei(i1,i2,i3,i4,i5)  int i1,i2,i3,i4,i5;
{  fprintf(ftst,"Zfivei: %d %d %d %d %d\n",i1,i2,i3,i4,i5); }

#define ZIDIID Define_Foreign("Zidiid",(vfunction *)idiid,"IFIIFRF");
static double idiid(i1,d,i4,i5,d2)  int i1,i4,i5; double d,d2;
{ fprintf(ftst,"Zidiid: %d %f %d %d %f\n",i1,d,i4,i5,d2);
  return (13.131313); 
}

#define ZIFFIF Define_Foreign("Ziffif",(vfunction *)iffif,"IffIfRf");
static float ZDECLARE5(iffif,int,i1,float,d,float,d2,int,i5,float,d3)
{ fprintf(ftst,"Ziffif: %d %f %f %d %f\n",i1,d,d2,i5,d3);
  return ((float)33333.131313); 
}

/* see what happens when routine expects float and is passed double */
#define ZIXXIX Define_Foreign("Zixxix",(vfunction *)ixxix,"IFFIFRF");
static float ZDECLARE5(ixxix,int,i1,float,d,float,d2,int,i5,float,d3)
{ fprintf(ftst,"Zixxix: %d %f %f %d %f\n",i1,d,d2,i5,d3);
  return ((float)33333.131313); 
}

#define ZIDDID Define_Foreign("Ziddid",(vfunction *)iddid,"IFFIFRF");
static double iddid(i1,d,d2,i5,d3)  int i1,i5; double d,d2,d3;
{ fprintf(ftst,"Ziddid: %d %f %f %d %f\n",i1,d,d2,i5,d3);
  return ((double)33333.131313); 
}

#define ZIIFF Define_Foreign("Ziiff",(vfunction *)iiff,"IIff");
static void ZDECLARE4(iiff,int,i1,int,i2,float,d,float,d2)
{ fprintf(ftst,"Ziiff: %d %d %f %f\n",i1,i2,d,d2); }     

#define ZIIDD Define_Foreign("Ziidd",(vfunction *)iidd,"IIFF");
static void iidd(i1,i2,d,d2) int i1,i2; double d,d2;
{ fprintf(ftst,"Ziidd: %d %d %lf %lf\n",i1,i2,d,d2); }     


#define ZISIRI  Define_Foreign("Zisiri",(vfunction *)isiri,"ISIRI");
static int isiri(i1,str,i2)
  int i1,i2;
  char *str;
{
  static int ii = 33;
  fprintf(ftst,"Zisiri: %d %s %d\n",i1,str,i2);
  return ++ii;
}
#endif /*TESTIT*/

void Init_forfunctest() {

#ifdef TESTIT
  /* prelinked functions to test */
  ZTESTLOG

  ZNOARGS
  ZGETBOOL
  ZRTNBOOL
  ZSTRLEN
  ZGETINT
  ZGETDBL
  ZGETFLT
  ZF2F
  ZD2D
  ZGETARR
  ZRTNINT
  ZIRS
  ZIDIID
  ZIFFIF
  ZIDDID
  ZIXXIX
  ZIIFF
  ZIIDD
  ZISIRI
  ZFIVEI
  ZTWOI
#endif  /*TESTIT*/
} /*Init_forfunctest*/
