/*
 * Copyright (C) by Argonne National Laboratory
 *     See COPYRIGHT in top-level directory
 */

#include <stdio.h>
#include "mpi.h"
#include <stdlib.h>
#include <string.h>
#include "../../include/mpitestconf.h"

/* Used to convert Fortran strings (which may not be null terminated) to
   C strings */
#define MAX_ATTRTEST_MSG 256

/*
 * FIXME: This code assumes that character strings are passed from Fortran
 * by placing the string length, as an int, at the end of the argument list
 * This is common but not universal.
 */

/*
   Name mapping.  All routines are created with names that are lower case
   with a single trailing underscore.  This matches many compilers.
   We use #define to change the name for Fortran compilers that do
   not use the lowercase/underscore pattern
*/

#ifdef F77_NAME_UPPER
#define cattrinit_   CATTRINIT
#define cgetenvbool_ CGETENVBOOL
#define cgetsizes_   CGETSIZES
#define ccreatekeys_ CCREATEKEYS
#define cfreekeys_   CFREEKEYS
#define ctoctest_    CTOCTEST
#define cmpif1read_  CMPIF1READ
#define cmpif2read_  CMPIF2READ
#define cmpif2readtype_  CMPIF2READTYPE
#define cmpif2readwin_   CMPIF2READWIN
#define csetmpi_     CSETMPI
#define csetmpi2_    CSETMPI2
#define csetmpitype_ CSETMPITYPE
#define csetmpiwin_  CSETMPIWIN

#elif defined(F77_NAME_LOWER) || defined(F77_NAME_MIXED)
/* Mixed is ok because we use lowercase in all uses */
#define cattrinit_   cattrinit
#define cgetenvbool_ cgetenvbool
#define cgetsizes_   cgetsizes
#define ccreatekeys_ ccreatekeys
#define cfreekeys_   cfreekeys
#define ctoctest_    ctoctest
#define cmpif1read_  cmpif1read
#define cmpif2read_  cmpif2read
#define cmpif2readtype_  cmpif2readtype
#define cmpif2readwin_   cmpif2readwin
#define csetmpi_     csetmpi
#define csetmpi2_    csetmpi2
#define csetmpitype_ csetmpitype
#define csetmpiwin_  csetmpiwin

#elif defined(F77_NAME_LOWER_2USCORE) || defined(F77_NAME_LOWER_USCORE) || \
      defined(F77_NAME_MIXED_USCORE)
/* Else leave name alone (routines have no underscore, so both
   of these map to a lowercase, single underscore) */
#else
#error 'Unrecognized Fortran name mapping'
#endif

/* */
static int ccomm1Key, ccomm2Key, ctype2Key, cwin2Key;
static int ccomm1Extra, ccomm2Extra, ctype2Extra, cwin2Extra;
static int verbose = 0;

/* Forward references */
int cmpi1read(MPI_Comm comm, int key, void *expected, const char *msg);
int cmpi2read(MPI_Comm comm, int key, void *expected, const char *msg);
int cmpi2readtype(MPI_Datatype dtype, int key, void *expected, const char *msg);

void ccompareint2aint_(MPI_Fint * in1, MPI_Aint * in2, MPI_Fint * result);
void ccompareint2void_(MPI_Fint * in1, void *in2, MPI_Fint * result);
void ccompareaint2void_(MPI_Aint * in1, void *in2, MPI_Fint * result);

void cgetenvbool_(const char str[], MPI_Fint * val, int d);
void cattrinit_(MPI_Fint * fverbose);
void cgetsizes_(MPI_Fint * ptrSize, MPI_Fint * intSize, MPI_Fint * aintSize);
void ccreatekeys_(MPI_Fint * ccomm1_key, MPI_Fint * ccomm2_key,
                  MPI_Fint * ctype2_key, MPI_Fint * cwin2_key);
void cfreekeys_(void);
void ctoctest_(MPI_Fint * errs);
int cmpi1read(MPI_Comm comm, int key, void *expected, const char *msg);
int cmpi2read(MPI_Comm comm, int key, void *expected, const char *msg);
int cmpi2readtype(MPI_Datatype dtype, int key, void *expected, const char *msg);
int cmpi2readwin(MPI_Win win, int key, void *expected, const char *msg);
void cmpif1read_(MPI_Fint * fcomm, MPI_Fint * fkey, MPI_Fint * expected,
                 MPI_Fint * errs, const char *msg, int msglen);
void cmpif2read_(MPI_Fint * fcomm, MPI_Fint * fkey, MPI_Aint * expected,
                 MPI_Fint * errs, const char *msg, int msglen);
void cmpif2readtype_(MPI_Fint * ftype, MPI_Fint * fkey, MPI_Aint * expected,
                     MPI_Fint * errs, const char *msg, int msglen);
void cmpif2readwin_(MPI_Fint * fwin, MPI_Fint * fkey, MPI_Aint * expected,
                    MPI_Fint * errs, const char *msg, int msglen);
void csetmpi_(MPI_Fint * fcomm, MPI_Fint * fkey, MPI_Fint * val, MPI_Fint * errs);
void csetmpi2_(MPI_Fint * fcomm, MPI_Fint * fkey, MPI_Aint * val, MPI_Fint * errs);
void csetmpitype_(MPI_Fint * ftype, MPI_Fint * fkey, MPI_Aint * val, MPI_Fint * errs);
void csetmpiwin_(MPI_Fint * fwin, MPI_Fint * fkey, MPI_Aint * val, MPI_Fint * errs);
void ccompareint2aint_(MPI_Fint * in1, MPI_Aint * in2, MPI_Fint * result);
void ccompareint2void_(MPI_Fint * in1, void *in2, MPI_Fint * result);
void ccompareaint2void_(MPI_Aint * in1, void *in2, MPI_Fint * result);

/* ----------------------------------------------------------------------- */
/* Initialization functions                                                */
/* ----------------------------------------------------------------------- */
void cgetenvbool_(const char str[], MPI_Fint * val, int d)
{
    const char *envval;
    char envname[1024];
    /* Note that the Fortran string may not be null terminated; thus
     * we copy d characters and add a null just in case */
    if (d > sizeof(envname) - 1) {
        fprintf(stderr, "Environment variable name too long (%d)\n", d);
        MPI_Abort(MPI_COMM_WORLD, 1);
    }
    strncpy(envname, str, d);
    envname[d] = 0;

    envval = getenv(envname);
    *val = 0;
    if (envval) {
        printf(" envval = %s\n", envval);
        if (strcmp(envval, "yes") == 0 || strcmp(envval, "YES") == 0 ||
            strcmp(envval, "true") == 0 || strcmp(envval, "TRUE") == 0)
            *val = 1;
    }
}

/* Keep our own copy of the "is verbose" state */
void cattrinit_(MPI_Fint * fverbose)
{
    verbose = (int) *fverbose;
}

/* Provide attribute sizes (C, Fortran 1, Fortran 2) */
void cgetsizes_(MPI_Fint * ptrSize, MPI_Fint * intSize, MPI_Fint * aintSize)
{
    *ptrSize = (MPI_Fint) sizeof(void *);
    *intSize = (MPI_Fint) sizeof(MPI_Fint);
    *aintSize = (MPI_Fint) sizeof(MPI_Aint);
}

/* ----------------------------------------------------------------------- */
/* Copy and delete functions attached to keyvals                           */
/* ----------------------------------------------------------------------- */
static int CMPI1_COPY_FN(MPI_Comm comm, int keyval, void *extra,
                         void *inval, void *outval, int *flag)
{
    int inValue = *(int *) inval;

    if (verbose)
        printf(" In C MPI-1 copy function: inval = %p, extra = %p\n", inval, extra);
    *flag = 1;
    /* We don't change the attribute */
    *(void **) outval = inval;
    /* But we do change what it points at */
    *(int *) inval = inValue + 1;
    return MPI_SUCCESS;
}

static int CMPI1_DELETE_FN(MPI_Comm comm, int keyval, void *outval, void *extra)
{
    if (verbose)
        printf(" In C MPI-1 delete function, extra = %p\n", extra);
    *(int *) outval = *(int *) outval - 1;
    return MPI_SUCCESS;
}

static int TYPE_COPY_FN(MPI_Datatype dtype, int keyval, void *extra,
                        void *inval, void *outval, int *flag)
{
    int inValue = *(int *) inval;

    if (verbose)
        printf(" In C MPI type copy function, inval = %p, extra = %p\n", inval, extra);
    *flag = 1;
    /* We don't change the attribute */
    *(void **) outval = inval;
    /* But we do change what it points at */
    *(int *) inval = inValue + 1;
    return MPI_SUCCESS;
}

static int TYPE_DELETE_FN(MPI_Datatype dtype, int keyval, void *outval, void *extra)
{
    if (verbose)
        printf(" In C MPI type delete function, extra = %p\n", extra);
    /* We reverse the increment used in copy (checked after free of the type) */
    *(int *) outval = *(int *) outval - 1;
    return MPI_SUCCESS;
}

/* Note that this function cannot be called in MPI since there is no
   win_dup function */
static int WIN_COPY_FN(MPI_Win win, int keyval, void *extra, void *inval, void *outval, int *flag)
{
    if (verbose)
        printf("PANIC: In C MPI win copy function (should never happen)\n");
    *flag = 1;
    return MPI_SUCCESS;
}

static int WIN_DELETE_FN(MPI_Win win, int keyval, void *outval, void *extra)
{
    if (verbose)
        printf(" In C MPI win delete function, extra = %p\n", extra);
    *(int *) outval = *(int *) outval - 1;
    return MPI_SUCCESS;
}

/* ----------------------------------------------------------------------- */
/* Routines to create keyvals in C (with C copy and delete functions       */
/* ----------------------------------------------------------------------- */

void ccreatekeys_(MPI_Fint * ccomm1_key, MPI_Fint * ccomm2_key,
                  MPI_Fint * ctype2_key, MPI_Fint * cwin2_key)
{
    MPI_Keyval_create(CMPI1_COPY_FN, CMPI1_DELETE_FN, &ccomm1Key, &ccomm1Extra);
    *ccomm1_key = (MPI_Fint) ccomm1Key;

    MPI_Comm_create_keyval(CMPI1_COPY_FN, CMPI1_DELETE_FN, &ccomm2Key, &ccomm2Extra);
    *ccomm2_key = (MPI_Fint) ccomm2Key;

    MPI_Type_create_keyval(TYPE_COPY_FN, TYPE_DELETE_FN, &ctype2Key, &ctype2Extra);
    *ctype2_key = (MPI_Fint) ctype2Key;

    MPI_Win_create_keyval(WIN_COPY_FN, WIN_DELETE_FN, &cwin2Key, &cwin2Extra);
    *cwin2_key = (MPI_Fint) cwin2Key;
}

void cfreekeys_(void)
{
    MPI_Keyval_free(&ccomm1Key);
    MPI_Comm_free_keyval(&ccomm2Key);
    MPI_Type_free_keyval(&ctype2Key);
    MPI_Win_free_keyval(&cwin2Key);
}

/* ----------------------------------------------------------------------- */
/* ----------------------------------------------------------------------- */

/* Test c-to-c attributes */
static int ccomm1Attr, ccomm2Attr, ctype2Attr, cwin2Attr;

void ctoctest_(MPI_Fint * errs)
{
    int errcnt = *errs;
    int baseattrval = (1 << (sizeof(int) * 8 - 2)) - 3;
    MPI_Datatype cduptype;
    MPI_Comm cdup;

    /* MPI-1 function */
    ccomm1Attr = baseattrval;
    MPI_Attr_put(MPI_COMM_SELF, ccomm1Key, &ccomm1Attr);
    /* Test that we have the same value */
    errcnt += cmpi1read(MPI_COMM_SELF, ccomm1Key, &ccomm1Attr, "C to C");

    /* Dup, check that the copy routine does what is expected */
    MPI_Comm_dup(MPI_COMM_SELF, &cdup);
    errcnt += cmpi1read(cdup, ccomm1Key, &ccomm1Attr, "C to C dup");
    if (ccomm1Attr != baseattrval + 1) {
        printf(" Did not increment int in C to C dup: %d %d\n", ccomm1Attr, baseattrval + 1);
        errcnt++;
    }

    MPI_Comm_free(&cdup);
    if (ccomm1Attr != baseattrval) {
        printf(" Did not increment int in C to C delete: %d %d\n", ccomm1Attr, baseattrval);
        errcnt++;
    }

    /* MPI-2 functions */
    ccomm1Attr = 0;
    ccomm2Attr = baseattrval;
    MPI_Comm_set_attr(MPI_COMM_SELF, ccomm2Key, &ccomm2Attr);
    /* Test that we have the same value */
    errcnt += cmpi2read(MPI_COMM_SELF, ccomm2Key, &ccomm2Attr, "C to C (2)");

    /* Dup, check that the copy routine does what is expected */
    MPI_Comm_dup(MPI_COMM_SELF, &cdup);
    errcnt += cmpi2read(cdup, ccomm2Key, &ccomm2Attr, "C to C dup (2)");
    if (ccomm2Attr != baseattrval + 1) {
        printf(" Did not increment int in C to C dup: %d %d\n", ccomm2Attr, baseattrval + 1);
        errcnt++;
    }

    MPI_Comm_free(&cdup);
    if (ccomm2Attr != baseattrval) {
        printf(" Did not increment int in C to C delete (2): %d %d\n", ccomm2Attr, baseattrval);
        errcnt++;
    }

    /* MPI-2 functions */
    ctype2Attr = baseattrval;
    MPI_Type_set_attr(MPI_INTEGER, ctype2Key, &ctype2Attr);
    /* Test that we have the same value */
    errcnt += cmpi2readtype(MPI_INTEGER, ctype2Key, &ctype2Attr, "C to C type (2)");

    /* Dup, check that the copy routine does what is expected */
    MPI_Type_dup(MPI_INTEGER, &cduptype);
    errcnt += cmpi2readtype(cduptype, ctype2Key, &ctype2Attr, "C to C typedup (2)");
    if (ctype2Attr != baseattrval + 1) {
        printf(" Did not increment int in C to C typedup: %d %d\n", ctype2Attr, baseattrval + 1);
        errcnt++;
    }
    ccomm1Attr = 0;

    MPI_Type_free(&cduptype);
    if (ctype2Attr != baseattrval) {
        printf(" Did not increment int in C to C typedelete (2): %d %d\n", ctype2Attr, baseattrval);
        errcnt++;
    }


    *errs = errcnt;
}

/* ----------------------------------------------------------------------- */
/* Routines to get and check an attribute value.  Returns the number       */
/*   of errors found                                                       */
/* ----------------------------------------------------------------------- */

int cmpi1read(MPI_Comm comm, int key, void *expected, const char *msg)
{
    void *attrval;
    int flag;
    MPI_Attr_get(comm, key, &attrval, &flag);
    if (!flag) {
        printf(" Error: flag false for Attr_get: %s\n", msg);
        return 1;
    }
    if (attrval != expected) {
        printf(" Error: expected %p but saw %p: %s\n", expected, attrval, msg);
        return 1;
    }
    return 0;
}

int cmpi2read(MPI_Comm comm, int key, void *expected, const char *msg)
{
    void *attrval;
    int flag;
    MPI_Comm_get_attr(comm, key, &attrval, &flag);
    if (!flag) {
        printf(" Error: flag false for Comm_get_attr: %s\n", msg);
        return 1;
    }
    if (attrval != expected) {
        printf(" Error: expected %p but saw %p: %s\n", expected, attrval, msg);
        return 1;
    }
    return 0;
}

int cmpi2readtype(MPI_Datatype dtype, int key, void *expected, const char *msg)
{
    void *attrval;
    int flag;
    MPI_Type_get_attr(dtype, key, &attrval, &flag);
    if (!flag) {
        printf(" Error: flag false for Type_get_attr: %s\n", msg);
        return 1;
    }
    if (attrval != expected) {
        printf(" Error: expected %p but saw %p: %s\n", expected, attrval, msg);
        return 1;
    }
    return 0;
}

int cmpi2readwin(MPI_Win win, int key, void *expected, const char *msg)
{
    void *attrval;
    int flag;
    MPI_Win_get_attr(win, key, &attrval, &flag);
    if (!flag) {
        printf(" Error: flag false for Win_get_attr: %s\n", msg);
        return 1;
    }
    if (attrval != expected) {
        printf(" Error: expected %p but saw %p: %s\n", expected, attrval, msg);
        return 1;
    }
    return 0;
}

/* Set in Fortran (MPI-1), read in C */
void cmpif1read_(MPI_Fint * fcomm, MPI_Fint * fkey, MPI_Fint * expected,
                 MPI_Fint * errs, const char *msg, int msglen)
{
    void *attrval;
    int flag, result;
    MPI_Comm comm = MPI_Comm_f2c(*fcomm);
    char lmsg[MAX_ATTRTEST_MSG];

    if (msglen > sizeof(lmsg) - 1) {
        fprintf(stderr, "Message too long for buffer (%d)\n", msglen);
        MPI_Abort(MPI_COMM_WORLD, 1);
    }

    MPI_Attr_get(comm, *fkey, &attrval, &flag);
    if (!flag) {
        *errs = *errs + 1;
        strncpy(lmsg, msg, msglen);
        lmsg[msglen] = 0;
        printf(" Error: flag false for Attr_get (set in F1): %s\n", lmsg);
        return;
    }
    /* Must be careful to compare as required in the MPI specification */
    ccompareint2void_(expected, attrval, &result);
    if (!result) {
        *errs = *errs + 1;
        strncpy(lmsg, msg, msglen);
        lmsg[msglen] = 0;
        printf(" Error: (set in F1) expected %d but saw %d: %s\n",
               *expected, *(MPI_Fint *) attrval, lmsg);
        return;
    }
    return;
}

/* Set in Fortran (MPI-2), read in C */
void cmpif2read_(MPI_Fint * fcomm, MPI_Fint * fkey, MPI_Aint * expected,
                 MPI_Fint * errs, const char *msg, int msglen)
{
    void *attrval;
    int flag, result;
    MPI_Comm comm = MPI_Comm_f2c(*fcomm);
    char lmsg[MAX_ATTRTEST_MSG];

    if (msglen > sizeof(lmsg) - 1) {
        fprintf(stderr, "Message too long for buffer (%d)\n", msglen);
        MPI_Abort(MPI_COMM_WORLD, 1);
    }

    MPI_Comm_get_attr(comm, *fkey, &attrval, &flag);
    if (!flag) {
        *errs = *errs + 1;
        strncpy(lmsg, msg, msglen);
        lmsg[msglen] = 0;
        printf(" Error: flag false for Comm_get_attr (set in F2): %s\n", lmsg);
        return;
    }
    ccompareaint2void_(expected, attrval, &result);
    if (!result) {
        *errs = *errs + 1;
        strncpy(lmsg, msg, msglen);
        lmsg[msglen] = 0;
        printf(" Error: (set in F2) expected %ld but saw %ld: %s\n",
               (long) *expected, (long) *(MPI_Aint *) attrval, lmsg);
        return;
    }
    return;
}

void cmpif2readtype_(MPI_Fint * ftype, MPI_Fint * fkey, MPI_Aint * expected,
                     MPI_Fint * errs, const char *msg, int msglen)
{
    void *attrval;
    int flag, result;
    MPI_Datatype dtype = MPI_Type_f2c(*ftype);
    char lmsg[MAX_ATTRTEST_MSG];

    if (msglen > sizeof(lmsg) - 1) {
        fprintf(stderr, "Message too long for buffer (%d)\n", msglen);
        MPI_Abort(MPI_COMM_WORLD, 1);
    }

    MPI_Type_get_attr(dtype, *fkey, &attrval, &flag);
    if (!flag) {
        *errs = *errs + 1;
        strncpy(lmsg, msg, msglen);
        lmsg[msglen] = 0;
        printf(" Error: flag false for Type_get_attr (set in F2): %s\n", lmsg);
        return;
    }
    ccompareaint2void_(expected, attrval, &result);
    if (!result) {
        *errs = *errs + 1;
        strncpy(lmsg, msg, msglen);
        lmsg[msglen] = 0;
        printf(" Error: (set in F2/Type) expected %ld but saw %ld: %s\n",
               (long) *expected, (long) *(MPI_Aint *) attrval, lmsg);
        return;
    }
    return;
}

void cmpif2readwin_(MPI_Fint * fwin, MPI_Fint * fkey, MPI_Aint * expected,
                    MPI_Fint * errs, const char *msg, int msglen)
{
    void *attrval;
    int flag, result;
    MPI_Win win = MPI_Win_f2c(*fwin);
    char lmsg[MAX_ATTRTEST_MSG];

    if (msglen > sizeof(lmsg) - 1) {
        fprintf(stderr, "Message too long for buffer (%d)\n", msglen);
        MPI_Abort(MPI_COMM_WORLD, 1);
    }

    MPI_Win_get_attr(win, *fkey, &attrval, &flag);
    if (!flag) {
        *errs = *errs + 1;
        strncpy(lmsg, msg, msglen);
        lmsg[msglen] = 0;
        printf(" Error: flag false for Win_get_attr (set in F2): %s\n", lmsg);
        return;
    }
    ccompareaint2void_(expected, attrval, &result);
    if (!result) {
        *errs = *errs + 1;
        strncpy(lmsg, msg, msglen);
        lmsg[msglen] = 0;
        printf(" Error: (set in F2/Win) expected %ld but saw %ld: %s\n",
               (long) *expected, (long) *(MPI_Aint *) attrval, lmsg);
        return;
    }
    return;
}

/* ----------------------------------------------------------------------- */
/* Given a Fortran attribute (pointer to the value to store), set it using */
/* the C attribute functions                                               */
/* ----------------------------------------------------------------------- */

void csetmpi_(MPI_Fint * fcomm, MPI_Fint * fkey, MPI_Fint * val, MPI_Fint * errs)
{
    MPI_Comm comm = MPI_Comm_f2c(*fcomm);

    MPI_Comm_set_attr(comm, *fkey, (void *) (MPI_Aint) * val);
}

void csetmpi2_(MPI_Fint * fcomm, MPI_Fint * fkey, MPI_Aint * val, MPI_Fint * errs)
{
    MPI_Comm comm = MPI_Comm_f2c(*fcomm);

    MPI_Comm_set_attr(comm, *fkey, (void *) *val);
}

void csetmpitype_(MPI_Fint * ftype, MPI_Fint * fkey, MPI_Aint * val, MPI_Fint * errs)
{
    MPI_Datatype dtype = MPI_Type_f2c(*ftype);

    MPI_Type_set_attr(dtype, *fkey, (void *) *val);
}

void csetmpiwin_(MPI_Fint * fwin, MPI_Fint * fkey, MPI_Aint * val, MPI_Fint * errs)
{
    MPI_Win win = MPI_Win_f2c(*fwin);

    MPI_Win_set_attr(win, *fkey, (void *) *val);
}

/* ----------------------------------------------------------------------- */
/* Comparisons                                                             */
/*    int with aint                                                        */
/*    int with void*                                                       */
/*    aint with void*                                                      */
/* All routines use similar interfaces, though the routines that involve   */
/* void * must be called from C                                            */
/* Defined to be callable from either C or Fortran                         */
/* Here is the rule, defined in the MPI standard:                          */
/*    If one item is shorter than the other, take the low bytes.           */
/*    If one item is longer than the other, sign extend                    */
/* ----------------------------------------------------------------------- */
void ccompareint2aint_(MPI_Fint * in1, MPI_Aint * in2, MPI_Fint * result)
{
    static int idx = -1;
    if (sizeof(MPI_Fint) == sizeof(MPI_Aint)) {
        *result = *in1 == *in2;
    } else if (sizeof(MPI_Fint) < sizeof(MPI_Aint)) {
        /* Assume Aint no smaller than Fint, and that size of aint
         * is a multiple of the size of fint) */
        MPI_Fint *v2 = (MPI_Fint *) in2;
        if (idx < 0) {
            MPI_Aint av = 1;
            MPI_Fint *fa = (MPI_Fint *) & av;
            if ((sizeof(MPI_Aint) % sizeof(MPI_Fint)) != 0) {
                fprintf(stderr,
                        "PANIC: size of MPI_Aint = %d not a multiple of MPI_Fint = %d\n",
                        (int) sizeof(MPI_Aint), (int) sizeof(MPI_Fint));
                MPI_Abort(MPI_COMM_WORLD, 1);
            }
            for (idx = sizeof(MPI_Aint) / sizeof(MPI_Fint); idx >= 0; idx--)
                if (fa[idx])
                    break;
            if (idx < 0) {
                fprintf(stderr, "Unable to determine low word of Fint in Aint\n");
                MPI_Abort(MPI_COMM_WORLD, 1);
            }
            *result = *in1 == v2[idx];
        }
    } else {
        fprintf(stderr, "PANIC: sizeof(MPI_Fint) = %d > sizeof(MPI_Aint) %d\n",
                (int) sizeof(MPI_Fint), (int) sizeof(MPI_Aint));
        MPI_Abort(MPI_COMM_WORLD, 1);
    }
}

void ccompareint2void_(MPI_Fint * in1, void *in2, MPI_Fint * result)
{
    static int idx = -1;
    if (sizeof(MPI_Fint) == sizeof(void *)) {
        *result = *in1 == *(MPI_Fint *) in2;
    } else if (sizeof(MPI_Fint) < sizeof(void *)) {
        /* Assume void* no smaller than Fint, and that size of aint
         * is a multiple of the size of fint) */
        MPI_Fint *v2 = (MPI_Fint *) in2;
        if (idx < 0) {
            void *av = (void *) 1;
            MPI_Fint *fa = (MPI_Fint *) & av;
            if ((sizeof(void *) % sizeof(MPI_Fint)) != 0) {
                fprintf(stderr,
                        "PANIC: size of void * = %d not a multiple of MPI_Fint = %d\n",
                        (int) sizeof(void *), (int) sizeof(MPI_Fint));
                MPI_Abort(MPI_COMM_WORLD, 1);
            }
            for (idx = sizeof(void *) / sizeof(MPI_Fint); idx >= 0; idx--)
                if (fa[idx])
                    break;
            if (idx < 0) {
                fprintf(stderr, "Unable to determine low word of Fint in void*\n");
                MPI_Abort(MPI_COMM_WORLD, 1);
            }
            *result = *in1 == v2[idx];
        }
    } else {
        fprintf(stderr, "PANIC: sizeof(MPI_Fint) = %d > sizeof(void*) %d\n",
                (int) sizeof(MPI_Fint), (int) sizeof(void *));
        MPI_Abort(MPI_COMM_WORLD, 1);
    }
}

void ccompareaint2void_(MPI_Aint * in1, void *in2, MPI_Fint * result)
{
    /* Note that an aint must be >= void * by definition */
    *result = *in1 == *(MPI_Aint *) in2;
}