teshsuite/smpi/mpich3-test/f77/ext/c2f2c.c

   1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
   2 /*
   3  *
   4  *  (C) 2001 by Argonne National Laboratory.
   5  *      See COPYRIGHT in top-level directory.
   6  */
   7 /*
   8  * This file contains the C routines used in testing the c2f and f2c
   9  * handle conversion functions, except for MPI_File and MPI_Win (to
  10  * allow working with MPI implementations that do not include those
  11  * features).
  12  *
  13  * The tests follow this pattern:
  14  *
  15  *  Fortran main program
  16  *     calls c routine with each handle type, with a prepared
  17  *     and valid handle (often requires constructing an object)
  18  *
  19  *     C routine uses xxx_f2c routine to get C handle, checks some
  20  *     properties (i.e., size and rank of communicator, contents of datatype)
  21  *
  22  *     Then the Fortran main program calls a C routine that provides
  23  *     a handle, and the Fortran program performs similar checks.
  24  *
  25  * We also assume that a C int is a Fortran integer.  If this is not the
  26  * case, these tests must be modified.
  27  */
  28
  29 /* style: allow:fprintf:10 sig:0 */
  30 #include <stdio.h>
  31 #include "mpi.h"
  32 #include "../../include/mpitestconf.h"
  33 #include <string.h>
  34
  35 /*
  36    Name mapping.  All routines are created with names that are lower case
  37    with a single trailing underscore.  This matches many compilers.
  38    We use #define to change the name for Fortran compilers that do
  39    not use the lowercase/underscore pattern
  40 */
  41
  42 #ifdef F77_NAME_UPPER
  43 #define c2fcomm_ C2FCOMM
  44 #define c2fgroup_ C2FGROUP
  45 #define c2ftype_ C2FTYPE
  46 #define c2finfo_ C2FINFO
  47 #define c2frequest_ C2FREQUEST
  48 #define c2fop_ C2FOP
  49 #define c2ferrhandler_ C2FERRHANDLER
  50
  51 #define f2ccomm_ F2CCOMM
  52 #define f2cgroup_ F2CGROUP
  53 #define f2ctype_ F2CTYPE
  54 #define f2cinfo_ F2CINFO
  55 #define f2crequest_ F2CREQUEST
  56 #define f2cop_ F2COP
  57 #define f2cerrhandler_ F2CERRHANDLER
  58
  59 #elif defined(F77_NAME_LOWER) || defined(F77_NAME_MIXED)
  60 /* Mixed is ok because we use lowercase in all uses */
  61 #define c2fcomm_ c2fcomm
  62 #define c2fgroup_ c2fgroup
  63 #define c2ftype_ c2ftype
  64 #define c2finfo_ c2finfo
  65 #define c2frequest_ c2frequest
  66 #define c2fop_ c2fop
  67 #define c2ferrhandler_ c2ferrhandler
  68
  69 #define f2ccomm_ f2ccomm
  70 #define f2cgroup_ f2cgroup
  71 #define f2ctype_ f2ctype
  72 #define f2cinfo_ f2cinfo
  73 #define f2crequest_ f2crequest
  74 #define f2cop_ f2cop
  75 #define f2cerrhandler_ f2cerrhandler
  76
  77 #elif defined(F77_NAME_LOWER_2USCORE) || defined(F77_NAME_LOWER_USCORE) || \
  78       defined(F77_NAME_MIXED_USCORE)
  79 /* Else leave name alone (routines have no underscore, so both
  80    of these map to a lowercase, single underscore) */
  81 #else
  82 #error 'Unrecognized Fortran name mapping'
  83 #endif
  84
  85 /* Prototypes to keep compilers happy */
  86 MPI_Fint c2fcomm_( MPI_Fint * );
  87 MPI_Fint c2fgroup_( MPI_Fint * );
  88 MPI_Fint c2finfo_( MPI_Fint * );
  89 MPI_Fint c2frequest_( MPI_Fint * );
  90 MPI_Fint c2ftype_( MPI_Fint * );
  91 MPI_Fint c2fop_( MPI_Fint * );
  92 MPI_Fint c2ferrhandler_( MPI_Fint * );
  93
  94 void f2ccomm_( MPI_Fint * );
  95 void f2cgroup_( MPI_Fint * );
  96 void f2cinfo_( MPI_Fint * );
  97 void f2crequest_( MPI_Fint * );
  98 void f2ctype_( MPI_Fint * );
  99 void f2cop_( MPI_Fint * );
 100 void f2cerrhandler_( MPI_Fint * );
 101
 102
 103 MPI_Fint c2fcomm_ (MPI_Fint *comm)
 104 {
 105     MPI_Comm cComm = MPI_Comm_f2c(*comm);
 106     int cSize, wSize, cRank, wRank;
 107
 108     MPI_Comm_size( MPI_COMM_WORLD, &wSize );
 109     MPI_Comm_rank( MPI_COMM_WORLD, &wRank );
 110     MPI_Comm_size( cComm, &cSize );
 111     MPI_Comm_rank( cComm, &cRank );
 112
 113     if (wSize != cSize || wRank != cRank) {
 114         fprintf( stderr, "Comm: Did not get expected size,rank (got %d,%d)",
 115                  cSize, cRank );
 116         return 1;
 117     }
 118     return 0;
 119 }
 120
 121 MPI_Fint c2fgroup_ (MPI_Fint *group)
 122 {
 123     MPI_Group cGroup = MPI_Group_f2c(*group);
 124     int cSize, wSize, cRank, wRank;
 125
 126     /* We pass in the group of comm world */
 127     MPI_Comm_size( MPI_COMM_WORLD, &wSize );
 128     MPI_Comm_rank( MPI_COMM_WORLD, &wRank );
 129     MPI_Group_size( cGroup, &cSize );
 130     MPI_Group_rank( cGroup, &cRank );
 131
 132     if (wSize != cSize || wRank != cRank) {
 133         fprintf( stderr, "Group: Did not get expected size,rank (got %d,%d)",
 134                  cSize, cRank );
 135         return 1;
 136     }
 137     return 0;
 138 }
 139
 140 MPI_Fint c2ftype_ ( MPI_Fint *type )
 141 {
 142     MPI_Datatype dtype = MPI_Type_f2c( *type );
 143
 144     if (dtype != MPI_INTEGER) {
 145         fprintf( stderr, "Type: Did not get expected type\n" );
 146         return 1;
 147     }
 148     return 0;
 149 }
 150
 151 MPI_Fint c2finfo_ ( MPI_Fint *info )
 152 {
 153     MPI_Info cInfo = MPI_Info_f2c( *info );
 154     int flag;
 155     char value[100];
 156     MPI_Fint errs = 0;
 157
 158     MPI_Info_get( cInfo, (char*)"host", sizeof(value), value, &flag );
 159     if (!flag || strcmp(value,"myname") != 0) {
 160         fprintf( stderr, "Info: Wrong value or no value for host\n" );
 161         errs++;
 162     }
 163     MPI_Info_get( cInfo, (char*)"wdir", sizeof(value), value, &flag );
 164     if (!flag || strcmp( value, "/rdir/foo" ) != 0) {
 165         fprintf( stderr, "Info: Wrong value of no value for wdir\n" );
 166         errs++;
 167     }
 168
 169     return errs;
 170 }
 171
 172 MPI_Fint c2frequest_ ( MPI_Fint *request )
 173 {
 174     MPI_Request req = MPI_Request_f2c( *request );
 175     MPI_Status status;
 176     int flag;
 177     MPI_Test( &req, &flag, &status );
 178     MPI_Test_cancelled( &status, &flag );
 179     if (!flag) {
 180         fprintf( stderr, "Request: Wrong value for flag\n" );
 181         return 1;
 182     }
 183     else {
 184         *request = MPI_Request_c2f( req );
 185     }
 186     return 0;
 187 }
 188
 189 MPI_Fint c2fop_ ( MPI_Fint *op )
 190 {
 191     MPI_Op cOp = MPI_Op_f2c( *op );
 192
 193     if (cOp != MPI_SUM) {
 194         fprintf( stderr, "Op: did not get sum\n" );
 195         return 1;
 196     }
 197     return 0;
 198 }
 199
 200 MPI_Fint c2ferrhandler_ ( MPI_Fint *errh )
 201 {
 202     MPI_Errhandler errhand = MPI_Errhandler_f2c( *errh );
 203
 204     if (errhand != MPI_ERRORS_RETURN) {
 205         fprintf( stderr, "Errhandler: did not get errors return\n" );
 206         return 1;
 207     }
 208
 209     return 0;
 210 }
 211
 212 /*
 213  * The following routines provide handles to the calling Fortran program
 214  */
 215 void f2ccomm_( MPI_Fint * comm )
 216 {
 217     *comm = MPI_Comm_c2f( MPI_COMM_WORLD );
 218 }
 219
 220 void f2cgroup_( MPI_Fint * group )
 221 {
 222     MPI_Group wgroup;
 223     MPI_Comm_group( MPI_COMM_WORLD, &wgroup );
 224     *group = MPI_Group_c2f( wgroup );
 225 }
 226
 227 void f2ctype_( MPI_Fint * type )
 228 {
 229     *type = MPI_Type_c2f( MPI_INTEGER );
 230 }
 231
 232 void f2cinfo_( MPI_Fint * info )
 233 {
 234     MPI_Info cinfo;
 235
 236     MPI_Info_create( &cinfo );
 237     MPI_Info_set( cinfo, (char*)"host", (char*)"myname" );
 238     MPI_Info_set( cinfo, (char*)"wdir", (char*)"/rdir/foo" );
 239
 240     *info = MPI_Info_c2f( cinfo );
 241 }
 242
 243 void f2crequest_( MPI_Fint * req )
 244 {
 245     MPI_Request cReq;
 246
 247     MPI_Irecv( NULL, 0, MPI_INT, MPI_ANY_SOURCE, MPI_ANY_TAG,
 248                MPI_COMM_WORLD, &cReq );
 249     MPI_Cancel( &cReq );
 250     *req = MPI_Request_c2f( cReq );
 251
 252 }
 253
 254 void f2cop_( MPI_Fint * op )
 255 {
 256     *op = MPI_Op_c2f( MPI_SUM );
 257 }
 258
 259 void f2cerrhandler_( MPI_Fint *errh )
 260 {
 261     *errh = MPI_Errhandler_c2f( MPI_ERRORS_RETURN );
 262 }
 263