/* This file created from f77/ext/c2f2c.c with f77tof90 */
/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
/*
*
* (C) 2001 by Argonne National Laboratory.
* See COPYRIGHT in top-level directory.
*/
/*
* This file contains the C routines used in testing the c2f and f2c
* handle conversion functions, except for MPI_File and MPI_Win (to
* allow working with MPI implementations that do not include those
* features).
*
* The tests follow this pattern:
*
* Fortran main program
* calls c routine with each handle type, with a prepared
* and valid handle (often requires constructing an object)
*
* C routine uses xxx_f2c routine to get C handle, checks some
* properties (i.e., size and rank of communicator, contents of datatype)
*
* Then the Fortran main program calls a C routine that provides
* a handle, and the Fortran program performs similar checks.
*
* We also assume that a C int is a Fortran integer. If this is not the
* case, these tests must be modified.
*/
/* style: allow:fprintf:10 sig:0 */
#include <stdio.h>
#include "mpi.h"
#include "../../include/mpitestconf.h"
#include <string.h>
/*
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 c2fcomm_ C2FCOMM
#define c2fgroup_ C2FGROUP
#define c2ftype_ C2FTYPE
#define c2finfo_ C2FINFO
#define c2frequest_ C2FREQUEST
#define c2fop_ C2FOP
#define c2ferrhandler_ C2FERRHANDLER
#define f2ccomm_ F2CCOMM
#define f2cgroup_ F2CGROUP
#define f2ctype_ F2CTYPE
#define f2cinfo_ F2CINFO
#define f2crequest_ F2CREQUEST
#define f2cop_ F2COP
#define f2cerrhandler_ F2CERRHANDLER
#elif defined(F77_NAME_LOWER) || defined(F77_NAME_MIXED)
/* Mixed is ok because we use lowercase in all uses */
#define c2fcomm_ c2fcomm
#define c2fgroup_ c2fgroup
#define c2ftype_ c2ftype
#define c2finfo_ c2finfo
#define c2frequest_ c2frequest
#define c2fop_ c2fop
#define c2ferrhandler_ c2ferrhandler
#define f2ccomm_ f2ccomm
#define f2cgroup_ f2cgroup
#define f2ctype_ f2ctype
#define f2cinfo_ f2cinfo
#define f2crequest_ f2crequest
#define f2cop_ f2cop
#define f2cerrhandler_ f2cerrhandler
#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
/* Prototypes to keep compilers happy */
MPI_Fint c2fcomm_(MPI_Fint *);
MPI_Fint c2fgroup_(MPI_Fint *);
MPI_Fint c2finfo_(MPI_Fint *);
MPI_Fint c2frequest_(MPI_Fint *);
MPI_Fint c2ftype_(MPI_Fint *);
MPI_Fint c2fop_(MPI_Fint *);
MPI_Fint c2ferrhandler_(MPI_Fint *);
void f2ccomm_(MPI_Fint *);
void f2cgroup_(MPI_Fint *);
void f2cinfo_(MPI_Fint *);
void f2crequest_(MPI_Fint *);
void f2ctype_(MPI_Fint *);
void f2cop_(MPI_Fint *);
void f2cerrhandler_(MPI_Fint *);
MPI_Fint c2fcomm_(MPI_Fint * comm)
{
MPI_Comm cComm = MPI_Comm_f2c(*comm);
int cSize, wSize, cRank, wRank;
MPI_Comm_size(MPI_COMM_WORLD, &wSize);
MPI_Comm_rank(MPI_COMM_WORLD, &wRank);
MPI_Comm_size(cComm, &cSize);
MPI_Comm_rank(cComm, &cRank);
if (wSize != cSize || wRank != cRank) {
fprintf(stderr, "Comm: Did not get expected size,rank (got %d,%d)", cSize, cRank);
return 1;
}
return 0;
}
MPI_Fint c2fgroup_(MPI_Fint * group)
{
MPI_Group cGroup = MPI_Group_f2c(*group);
int cSize, wSize, cRank, wRank;
/* We pass in the group of comm world */
MPI_Comm_size(MPI_COMM_WORLD, &wSize);
MPI_Comm_rank(MPI_COMM_WORLD, &wRank);
MPI_Group_size(cGroup, &cSize);
MPI_Group_rank(cGroup, &cRank);
if (wSize != cSize || wRank != cRank) {
fprintf(stderr, "Group: Did not get expected size,rank (got %d,%d)", cSize, cRank);
return 1;
}
return 0;
}
MPI_Fint c2ftype_(MPI_Fint * type)
{
MPI_Datatype dtype = MPI_Type_f2c(*type);
if (dtype != MPI_INTEGER) {
fprintf(stderr, "Type: Did not get expected type\n");
return 1;
}
return 0;
}
MPI_Fint c2finfo_(MPI_Fint * info)
{
MPI_Info cInfo = MPI_Info_f2c(*info);
int flag;
char value[100];
MPI_Fint errs = 0;
MPI_Info_get(cInfo, (char *) "host", sizeof(value), value, &flag);
if (!flag || strcmp(value, "myname") != 0) {
fprintf(stderr, "Info: Wrong value or no value for host\n");
errs++;
}
MPI_Info_get(cInfo, (char *) "wdir", sizeof(value), value, &flag);
if (!flag || strcmp(value, "/rdir/foo") != 0) {
fprintf(stderr, "Info: Wrong value of no value for wdir\n");
errs++;
}
return errs;
}
MPI_Fint c2frequest_(MPI_Fint * request)
{
MPI_Request req = MPI_Request_f2c(*request);
MPI_Status status;
int flag;
MPI_Test(&req, &flag, &status);
MPI_Test_cancelled(&status, &flag);
if (!flag) {
fprintf(stderr, "Request: Wrong value for flag\n");
return 1;
} else {
*request = MPI_Request_c2f(req);
}
return 0;
}
MPI_Fint c2fop_(MPI_Fint * op)
{
MPI_Op cOp = MPI_Op_f2c(*op);
if (cOp != MPI_SUM) {
fprintf(stderr, "Op: did not get sum\n");
return 1;
}
return 0;
}
MPI_Fint c2ferrhandler_(MPI_Fint * errh)
{
MPI_Errhandler errhand = MPI_Errhandler_f2c(*errh);
if (errhand != MPI_ERRORS_RETURN) {
fprintf(stderr, "Errhandler: did not get errors return\n");
return 1;
}
return 0;
}
/*
* The following routines provide handles to the calling Fortran program
*/
void f2ccomm_(MPI_Fint * comm)
{
*comm = MPI_Comm_c2f(MPI_COMM_WORLD);
}
void f2cgroup_(MPI_Fint * group)
{
MPI_Group wgroup;
MPI_Comm_group(MPI_COMM_WORLD, &wgroup);
*group = MPI_Group_c2f(wgroup);
}
void f2ctype_(MPI_Fint * type)
{
*type = MPI_Type_c2f(MPI_INTEGER);
}
void f2cinfo_(MPI_Fint * info)
{
MPI_Info cinfo;
MPI_Info_create(&cinfo);
MPI_Info_set(cinfo, (char *) "host", (char *) "myname");
MPI_Info_set(cinfo, (char *) "wdir", (char *) "/rdir/foo");
*info = MPI_Info_c2f(cinfo);
}
void f2crequest_(MPI_Fint * req)
{
MPI_Request cReq;
MPI_Irecv(NULL, 0, MPI_INT, MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD, &cReq);
MPI_Cancel(&cReq);
*req = MPI_Request_c2f(cReq);
}
void f2cop_(MPI_Fint * op)
{
*op = MPI_Op_c2f(MPI_SUM);
}
void f2cerrhandler_(MPI_Fint * errh)
{
*errh = MPI_Errhandler_c2f(MPI_ERRORS_RETURN);
}