teshsuite/smpi/mpich3-test/datatype/CMakeLists.txt
# teshsuite/smpi/mpich3-test/f77/attr/CMakeLists.txt
teshsuite/smpi/mpich3-test/f77/coll/CMakeLists.txt
+ teshsuite/smpi/mpich3-test/f77/info/CMakeLists.txt
teshsuite/smpi/mpich3-test/f77/comm/CMakeLists.txt
teshsuite/smpi/mpich3-test/f77/datatype/CMakeLists.txt
teshsuite/smpi/mpich3-test/f77/ext/CMakeLists.txt
teshsuite/smpi/mpich3-test/f77/rma/CMakeLists.txt
teshsuite/smpi/mpich3-test/f90/coll/CMakeLists.txt
teshsuite/smpi/mpich3-test/f90/datatype/CMakeLists.txt
+ teshsuite/smpi/mpich3-test/f90/info/CMakeLists.txt
teshsuite/smpi/mpich3-test/f90/init/CMakeLists.txt
teshsuite/smpi/mpich3-test/f90/pt2pt/CMakeLists.txt
teshsuite/smpi/mpich3-test/f90/util/CMakeLists.txt
add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f77/datatype)
add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f77/ext)
add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f77/init)
+add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f77/info)
add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f77/pt2pt)
add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f77/topo)
add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f77/rma)
add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f90/rma)
add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f90/coll)
add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f90/datatype)
+add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f90/info)
add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f90/init)
add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f90/pt2pt)
parameter(MPI_IO=0)
integer MPI_ROOT, MPI_INFO_NULL,MPI_COMM_TYPE_SHARED
parameter(MPI_ROOT=0)
- parameter(MPI_INFO_NULL=-1)
+ parameter(MPI_INFO_NULL=0)
parameter(MPI_COMM_TYPE_SHARED=1)
! These should be ordered as in smpi_f77.c
MPI_Op smpi_op_f2c(int op);
int smpi_win_c2f(MPI_Win win);
MPI_Win smpi_win_f2c(int win);
+int smpi_info_c2f(MPI_Info info);
+MPI_Info smpi_info_f2c(int info);
MPI_Request smpi_mpi_send_init(void *buf, int count, MPI_Datatype datatype,
int dst, int tag, MPI_Comm comm);
void mpi_win_set_name_ (int* win, char * name, int* ierr, int size);
void mpi_win_get_name_ (int* win, char * name, int* len, int* ierr);
void mpi_info_create_( int *info, int* ierr);
-void mpi_info_set_( int *info, char *key, char *value, int* ierr);
+void mpi_info_set_( int *info, char *key, char *value, int* ierr, unsigned int keylen, unsigned int valuelen);
void mpi_info_free_(int* info, int* ierr);
void mpi_get_( int *origin_addr, int* origin_count, int* origin_datatype, int* target_rank,
MPI_Aint* target_disp, int* target_count, int* target_datatype, int* win, int* ierr);
void mpi_comm_split_type_ (int* comm, int* split_type, int* key, int* info, int*newcomm, int* ierr);
void mpi_comm_set_info_ (int* comm, int* info, int* ierr);
void mpi_comm_get_info_ (int* comm, int* info, int* ierr);
-void mpi_info_get_ (int* info,char *key,int* valuelen, char *value, int *flag, int* ierr);
+void mpi_info_get_ (int* info,char *key,int* valuelen, char *value, int *flag, int* ierr, unsigned int keylen);
void mpi_comm_create_errhandler_ ( void *function, void *errhandler, int* ierr);
void mpi_add_error_class_ ( int *errorclass, int* ierr);
void mpi_add_error_code_ ( int* errorclass, int *errorcode, int* ierr);
void mpi_add_error_string_ ( int* errorcode, char *string, int* ierr);
void mpi_comm_call_errhandler_ (int* comm,int* errorcode, int* ierr);
void mpi_info_dup_ (int* info, int* newinfo, int* ierr);
-void mpi_info_get_valuelen_ ( int* info, char *key, int *valuelen, int *flag, int* ierr);
-void mpi_info_delete_ (int* info, char *key, int* ierr);
+void mpi_info_get_valuelen_ ( int* info, char *key, int *valuelen, int *flag, int* ierr, unsigned int keylen);
+void mpi_info_delete_ (int* info, char *key, int* ierr, unsigned int keylen);
void mpi_info_get_nkeys_ ( int* info, int *nkeys, int* ierr);
-void mpi_info_get_nthkey_ ( int* info, int* n, char *key, int* ierr);
+void mpi_info_get_nthkey_ ( int* info, int* n, char *key, int* ierr, unsigned int keylen);
void mpi_get_version_ (int *version,int *subversion, int* ierr);
void mpi_get_library_version_ (char *version,int *len, int* ierr);
void mpi_request_get_status_ ( int* request, int *flag, MPI_Status* status, int* ierr);
static xbt_dict_t datatype_lookup = NULL;
static xbt_dict_t op_lookup = NULL;
static xbt_dict_t win_lookup = NULL;
+static xbt_dict_t info_lookup = NULL;
+
static int running_processes = 0;
#if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__)
xbt_dict_remove(win_lookup, get_key(key, win));
}
+
+int smpi_info_c2f(MPI_Info info) {
+ static int info_id = 0;
+ char key[KEY_SIZE];
+ xbt_dict_set(info_lookup, get_key(key, info_id), info, NULL);
+ info_id++;
+ return info_id-1;
+}
+
+MPI_Info smpi_info_f2c(int info) {
+ char key[KEY_SIZE];
+ return info >= 0
+ ? (MPI_Info)xbt_dict_get_or_null(info_lookup, get_key(key, info))
+ : MPI_INFO_NULL;
+}
+
+static void free_info(int info) {
+ char key[KEY_SIZE];
+ xbt_dict_remove(info_lookup, get_key(key, info));
+}
+
static void smpi_init_fortran_types(){
if(!comm_lookup){
comm_lookup = xbt_dict_new_homogeneous(NULL);
request_lookup = xbt_dict_new_homogeneous(NULL);
datatype_lookup = xbt_dict_new_homogeneous(NULL);
win_lookup = xbt_dict_new_homogeneous(NULL);
+ info_lookup = xbt_dict_new_homogeneous(NULL);
smpi_type_c2f(MPI_BYTE);
smpi_type_c2f(MPI_CHAR);
#if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__)
void mpi_win_create_( int *base, MPI_Aint* size, int* disp_unit, int* info, int* comm, int *win, int* ierr){
MPI_Win tmp;
- *ierr = MPI_Win_create( (void*)base, *size, *disp_unit, *(MPI_Info*)info, smpi_comm_f2c(*comm),&tmp);
+ *ierr = MPI_Win_create( (void*)base, *size, *disp_unit, smpi_info_f2c(*info), smpi_comm_f2c(*comm),&tmp);
if(*ierr == MPI_SUCCESS) {
*win = smpi_win_c2f(tmp);
}
}
void mpi_win_set_name_ (int* win, char * name, int* ierr, int size){
+ //handle trailing blanks
+ while(name[size-1]==' ')size--;
+ while(*name==' '){//handle leading blanks
+ size --;
+ name++;
+ }
char* tname = xbt_malloc((size+1)*sizeof(char));
strncpy(tname, name, size);
tname[size]='\0';
}
void mpi_info_create_( int *info, int* ierr){
- *ierr = MPI_Info_create( (MPI_Info *)info);
+ MPI_Info tmp;
+ *ierr = MPI_Info_create(&tmp);
+ if(*ierr == MPI_SUCCESS) {
+ *info = smpi_info_c2f(tmp);
+ }
}
-void mpi_info_set_( int *info, char *key, char *value, int* ierr){
- *ierr = MPI_Info_set( *(MPI_Info *)info, key, value);
+void mpi_info_set_( int *info, char *key, char *value, int* ierr, unsigned int keylen, unsigned int valuelen){
+ //handle trailing blanks
+ while(key[keylen-1]==' ')keylen--;
+ while(*key==' '){//handle leading blanks
+ keylen --;
+ key++;
+ }
+ char* tkey = xbt_malloc((keylen+1)*sizeof(char));
+ strncpy(tkey, key, keylen);
+ tkey[keylen]='\0';
+
+ while(value[valuelen-1]==' ')valuelen--;
+ while(*value==' '){//handle leading blanks
+ valuelen --;
+ value++;
+ }
+ char* tvalue = xbt_malloc((valuelen+1)*sizeof(char));
+ strncpy(tvalue, value, valuelen);
+
+ tvalue[valuelen]='\0';
+ *ierr = MPI_Info_set( smpi_info_f2c(*info), tkey, tvalue);
+ xbt_free(tkey);
+}
+
+void mpi_info_get_ (int* info,char *key,int* valuelen, char *value, int *flag, int* ierr, unsigned int keylen ){
+ while(key[keylen-1]==' ')keylen--;
+ while(*key==' '){//handle leading blanks
+ keylen --;
+ key++;
+ } char* tkey = xbt_malloc((keylen+1)*sizeof(char));
+ strncpy(tkey, key, keylen);
+ tkey[keylen]='\0';
+ *ierr = MPI_Info_get(smpi_info_f2c(*info),tkey,*valuelen, value, flag);
+ xbt_free(tkey);
+ int i = 0;
+ for (i=strlen(value); i<*valuelen; i++)
+ value[i]=' ';
}
void mpi_info_free_(int* info, int* ierr){
- *ierr = MPI_Info_free((MPI_Info *) info);
+ MPI_Info tmp = smpi_info_f2c(*info);
+ *ierr = MPI_Info_free(&tmp);
+ if(*ierr == MPI_SUCCESS) {
+ free_info(*info);
+ }
}
void mpi_get_( int *origin_addr, int* origin_count, int* origin_datatype, int *target_rank,
void mpi_comm_dup_with_info_ (int* comm, int* info, int* newcomm, int* ierr){
MPI_Comm tmp;
- *ierr = MPI_Comm_dup_with_info(smpi_comm_f2c(*comm),*(MPI_Info*)info,&tmp);
+ *ierr = MPI_Comm_dup_with_info(smpi_comm_f2c(*comm),smpi_info_f2c(*info),&tmp);
if(*ierr == MPI_SUCCESS) {
*newcomm = smpi_comm_c2f(tmp);
}
void mpi_comm_split_type_ (int* comm, int* split_type, int* key, int* info, int* newcomm, int* ierr){
MPI_Comm tmp;
- *ierr = MPI_Comm_split_type(smpi_comm_f2c(*comm), *split_type, *key, *(MPI_Info*)info, &tmp);
+ *ierr = MPI_Comm_split_type(smpi_comm_f2c(*comm), *split_type, *key, smpi_info_f2c(*info), &tmp);
if(*ierr == MPI_SUCCESS) {
*newcomm = smpi_comm_c2f(tmp);
}
}
void mpi_comm_set_info_ (int* comm, int* info, int* ierr){
- *ierr = MPI_Comm_set_info (smpi_comm_f2c(*comm), *(MPI_Info*)info);
+ *ierr = MPI_Comm_set_info (smpi_comm_f2c(*comm), smpi_info_f2c(*info));
}
void mpi_comm_get_info_ (int* comm, int* info, int* ierr){
- *ierr = MPI_Comm_get_info (smpi_comm_f2c(*comm), (MPI_Info*)info);
+ MPI_Info tmp;
+ *ierr = MPI_Comm_get_info (smpi_comm_f2c(*comm), &tmp);
+ if(*ierr==MPI_SUCCESS){
+ *info = smpi_info_c2f(tmp);
+ }
}
-void mpi_info_get_ (int* info,char *key,int* valuelen, char *value, int *flag, int* ierr){
- *ierr = MPI_Info_get(*(MPI_Info*)info,key,*valuelen, value, flag);
-}
void mpi_comm_create_errhandler_ ( void *function, void *errhandler, int* ierr){
*ierr = MPI_Comm_create_errhandler( (MPI_Comm_errhandler_fn*) function, (MPI_Errhandler*)errhandler);
}
void mpi_info_dup_ (int* info, int* newinfo, int* ierr){
- *ierr = MPI_Info_dup(*(MPI_Info*)info, (MPI_Info*)newinfo);
-}
-
-void mpi_info_get_valuelen_ ( int* info, char *key, int *valuelen, int *flag, int* ierr){
- *ierr = MPI_Info_get_valuelen( *(MPI_Info*)info, key, valuelen, flag);
+ MPI_Info tmp;
+ *ierr = MPI_Info_dup(smpi_info_f2c(*info), &tmp);
+ if(*ierr==MPI_SUCCESS){
+ *newinfo= smpi_info_c2f(tmp);
+ }
}
-void mpi_info_delete_ (int* info, char *key, int* ierr){
- *ierr = MPI_Info_delete(*(MPI_Info*)info, key);
+void mpi_info_get_valuelen_ ( int* info, char *key, int *valuelen, int *flag, int* ierr, unsigned int keylen){
+ while(key[keylen-1]==' ')keylen--;
+ while(*key==' '){//handle leading blanks
+ keylen --;
+ key++;
+ }
+ char* tkey = xbt_malloc((keylen+1)*sizeof(char));
+ strncpy(tkey, key, keylen);
+ tkey[keylen]='\0';
+ *ierr = MPI_Info_get_valuelen( smpi_info_f2c(*info), tkey, valuelen, flag);
+ xbt_free(tkey);
+}
+
+void mpi_info_delete_ (int* info, char *key, int* ierr, unsigned int keylen){
+ while(key[keylen-1]==' ')keylen--;
+ while(*key==' '){//handle leading blanks
+ keylen --;
+ key++;
+ }
+ char* tkey = xbt_malloc((keylen+1)*sizeof(char));
+ strncpy(tkey, key, keylen);
+ tkey[keylen]='\0';
+ *ierr = MPI_Info_delete(smpi_info_f2c(*info), tkey);
+ xbt_free(tkey);
}
void mpi_info_get_nkeys_ ( int* info, int *nkeys, int* ierr){
- *ierr = MPI_Info_get_nkeys( *(MPI_Info*)info, nkeys);
+ *ierr = MPI_Info_get_nkeys( smpi_info_f2c(*info), nkeys);
}
-void mpi_info_get_nthkey_ ( int* info, int* n, char *key, int* ierr){
- *ierr = MPI_Info_get_nthkey( *(MPI_Info*)info, *n, key);
+void mpi_info_get_nthkey_ ( int* info, int* n, char *key, int* ierr, unsigned int keylen){
+ *ierr = MPI_Info_get_nthkey( smpi_info_f2c(*info), *n, key);
+ int i = 0;
+ for (i=strlen(key); i<keylen; i++)
+ key[i]=' ';
}
void mpi_get_version_ (int *version,int *subversion, int* ierr){
return smpi_comm_c2f(comm);
}
+MPI_Info PMPI_Info_f2c(MPI_Fint info){
+ return smpi_info_f2c(info);
+}
+
+MPI_Fint PMPI_Info_c2f(MPI_Info info){
+ return smpi_info_c2f(info);
+}
+
int PMPI_Keyval_create(MPI_Copy_function* copy_fn, MPI_Delete_function* delete_fn, int* keyval, void* extra_state) {
return smpi_comm_keyval_create(copy_fn, delete_fn, keyval, extra_state);
}
int num=0;
xbt_dict_foreach(info->info_dict,cursor,keyn,data){
if(num==n){
- memcpy(key,keyn, strlen(keyn));
+ strcpy(key,keyn);
return MPI_SUCCESS;
}
num++;
return MPI_SUCCESS; \
}
-
-MPI_Info PMPI_Info_f2c(MPI_Fint info){
- NOT_YET_IMPLEMENTED
-}
-
-MPI_Fint PMPI_Info_c2f(MPI_Info info){
- NOT_YET_IMPLEMENTED
-}
-
MPI_Errhandler PMPI_Errhandler_f2c(MPI_Fint errhandler){
NOT_YET_IMPLEMENTED
}
--- /dev/null
+cmake_minimum_required(VERSION 2.6)
+
+if(enable_smpi AND enable_smpi_MPICH3_testsuite AND SMPI_FORTRAN)
+ if(WIN32)
+ set(CMAKE_C_FLAGS "-include ${CMAKE_HOME_DIRECTORY}/include/smpi/smpi_main.h")
+ else()
+ set(CMAKE_C_COMPILER "${CMAKE_BINARY_DIR}/smpi_script/bin/smpicc")
+ set(CMAKE_Fortran_COMPILER "${CMAKE_BINARY_DIR}/smpi_script/bin/smpiff")
+ endif()
+
+ set(CMAKE_INCLUDE_CURRENT_DIR ON)
+ set(EXECUTABLE_OUTPUT_PATH "${CMAKE_CURRENT_BINARY_DIR}")
+ include_directories("${CMAKE_HOME_DIRECTORY}/include/smpi")
+ include_directories("${CMAKE_CURRENT_SOURCE_DIR}/../include/")
+
+
+ add_executable(infotest2f infotest2f.f ../util/mtestf.f)
+ add_executable(infotestf infotestf.f ../util/mtestf.f)
+ target_link_libraries(infotest2f simgrid mtest_f77)
+ target_link_libraries(infotestf simgrid mtest_f77)
+
+endif()
+
+set(tesh_files
+ ${tesh_files}
+ PARENT_SCOPE
+ )
+set(xml_files
+ ${xml_files}
+ PARENT_SCOPE
+ )
+set(examples_src
+ ${examples_src}
+ ${CMAKE_CURRENT_SOURCE_DIR}/infotest2f.f
+ ${CMAKE_CURRENT_SOURCE_DIR}/infotestf.f
+ PARENT_SCOPE
+ )
+set(bin_files
+ ${bin_files}
+ PARENT_SCOPE
+ )
+set(txt_files
+ ${txt_files}
+ ${CMAKE_CURRENT_SOURCE_DIR}/testlist
+ PARENT_SCOPE
+ )
--- /dev/null
+C -*- Mode: Fortran; -*-
+C
+C (C) 2003 by Argonne National Laboratory.
+C See COPYRIGHT in top-level directory.
+C
+ program main
+ implicit none
+ include 'mpif.h'
+ integer ierr, errs
+ integer i1, i2
+ integer nkeys, i, j, sumindex, vlen, ln, valuelen
+ logical found, flag
+ character*(MPI_MAX_INFO_KEY) keys(6)
+ character*(MPI_MAX_INFO_VAL) values(6)
+ character*(MPI_MAX_INFO_KEY) mykey
+ character*(MPI_MAX_INFO_VAL) myvalue
+C
+ data keys/"Key1", "key2", "KeY3", "A Key With Blanks","See Below",
+ & "last"/
+ data values/"value 1", "value 2", "VaLue 3", "key=valu:3","false",
+ & "no test"/
+C
+ errs = 0
+
+ call mtest_init( ierr )
+
+C Note that the MPI standard requires that leading an trailing blanks
+C are stripped from keys and values (Section 4.10, The Info Object)
+C
+C First, create and initialize an info
+ call mpi_info_create( i1, ierr )
+ call mpi_info_set( i1, keys(1), values(1), ierr )
+ call mpi_info_set( i1, keys(2), values(2), ierr )
+ call mpi_info_set( i1, keys(3), values(3), ierr )
+ call mpi_info_set( i1, keys(4), values(4), ierr )
+ call mpi_info_set( i1, " See Below", values(5), ierr )
+ call mpi_info_set( i1, keys(6), " no test ", ierr )
+C
+ call mpi_info_get_nkeys( i1, nkeys, ierr )
+ if (nkeys .ne. 6) then
+ print *, ' Number of keys should be 6, is ', nkeys
+ endif
+ sumindex = 0
+ do i=1, nkeys
+C keys are number from 0 to n-1, even in Fortran (Section 4.10)
+ call mpi_info_get_nthkey( i1, i-1, mykey, ierr )
+ found = .false.
+ do j=1, 6
+ if (mykey .eq. keys(j)) then
+ found = .true.
+ sumindex = sumindex + j
+ call mpi_info_get_valuelen( i1, mykey, vlen, flag, ierr )
+ if (.not.flag) then
+ errs = errs + 1
+ print *, ' no value for key', mykey
+ else
+ call mpi_info_get( i1, mykey, MPI_MAX_INFO_VAL,
+ & myvalue, flag, ierr )
+ if (myvalue .ne. values(j)) then
+ errs = errs + 1
+ print *, ' Value for ', mykey, ' not expected'
+ else
+ do ln=MPI_MAX_INFO_VAL,1,-1
+ if (myvalue(ln:ln) .ne. ' ') then
+ if (vlen .ne. ln) then
+ errs = errs + 1
+ print *, ' length is ', ln,
+ & ' but valuelen gave ', vlen,
+ & ' for key ', mykey
+ endif
+ goto 100
+ endif
+ enddo
+ 100 continue
+ endif
+ endif
+ endif
+ enddo
+ if (.not.found) then
+ print *, i, 'th key ', mykey, ' not in list'
+ endif
+ enddo
+ if (sumindex .ne. 21) then
+ errs = errs + 1
+ print *, ' Not all keys found'
+ endif
+C
+C delete 2, then dup, then delete 2 more
+ call mpi_info_delete( i1, keys(1), ierr )
+ call mpi_info_delete( i1, keys(2), ierr )
+ call mpi_info_dup( i1, i2, ierr )
+ call mpi_info_delete( i1, keys(3), ierr )
+C
+C check the contents of i2
+C valuelen does not signal an error for unknown keys; instead, sets
+C flag to false
+ do i=1,2
+ flag = .true.
+ call mpi_info_get_valuelen( i2, keys(i), valuelen, flag, ierr )
+ if (flag) then
+ errs = errs + 1
+ print *, ' Found unexpected key ', keys(i)
+ endif
+ myvalue = 'A test'
+ call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL,
+ & myvalue, flag, ierr )
+ if (flag) then
+ errs = errs + 1
+ print *, ' Found unexpected key in MPI_Info_get ', keys(i)
+ else
+ if (myvalue .ne. 'A test') then
+ errs = errs + 1
+ print *, ' Returned value overwritten, is now ', myvalue
+ endif
+ endif
+
+ enddo
+ do i=3,6
+ myvalue = ' '
+ call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL,
+ & myvalue, flag, ierr )
+ if (.not. flag) then
+ errs = errs + 1
+ print *, ' Did not find key ', keys(i)
+ else
+ if (myvalue .ne. values(i)) then
+ errs = errs + 1
+ print *, ' Found wrong value (', myvalue, ') for key ',
+ & keys(i)
+ endif
+ endif
+ enddo
+C
+C Free info
+ call mpi_info_free( i1, ierr )
+ call mpi_info_free( i2, ierr )
+
+ call mtest_finalize( errs )
+ call mpi_finalize( ierr )
+
+ end
--- /dev/null
+C -*- Mode: Fortran; -*-
+C
+C (C) 2003 by Argonne National Laboratory.
+C See COPYRIGHT in top-level directory.
+C
+C Simple info test
+ program main
+ implicit none
+ include 'mpif.h'
+ integer i1, i2
+ integer i, errs, ierr
+ integer valuelen
+ parameter (valuelen=64)
+ character*(valuelen) value
+ logical flag
+C
+ errs = 0
+
+ call MTest_Init( ierr )
+
+ call mpi_info_create( i1, ierr )
+ call mpi_info_create( i2, ierr )
+
+ call mpi_info_set( i1, "key1", "value1", ierr )
+ call mpi_info_set( i2, "key2", "value2", ierr )
+
+ call mpi_info_get( i1, "key2", valuelen, value, flag, ierr )
+ if (flag) then
+ print *, "Found key2 in info1"
+ errs = errs + 1
+ endif
+
+ call MPI_Info_get( i1, "key1", 64, value, flag, ierr )
+ if (.not. flag ) then
+ print *, "Did not find key1 in info1"
+ errs = errs + 1
+ else
+ if (value .ne. "value1") then
+ print *, "Found wrong value (", value, "), expected value1"
+ errs = errs + 1
+ else
+C check for trailing blanks
+ do i=7,valuelen
+ if (value(i:i) .ne. " ") then
+ print *, "Found non blank in info value"
+ errs = errs + 1
+ endif
+ enddo
+ endif
+ endif
+
+ call mpi_info_free( i1, ierr )
+ call mpi_info_free( i2, ierr )
+
+ call MTest_Finalize( errs )
+ call MPI_Finalize( ierr )
+ end
--- /dev/null
+infotestf 1
+infotest2f 1
coll
datatype
pt2pt
-#info
+info
#spawn
#io
rma
--- /dev/null
+cmake_minimum_required(VERSION 2.6)
+
+if(enable_smpi AND enable_smpi_MPICH3_testsuite AND SMPI_FORTRAN)
+ if(WIN32)
+ set(CMAKE_C_FLAGS "-include ${CMAKE_HOME_DIRECTORY}/include/smpi/smpi_main.h")
+ else()
+ set(CMAKE_C_COMPILER "${CMAKE_BINARY_DIR}/smpi_script/bin/smpicc")
+ set(CMAKE_Fortran_COMPILER "${CMAKE_BINARY_DIR}/smpi_script/bin/smpif90")
+ endif()
+
+ set(EXECUTABLE_OUTPUT_PATH "${CMAKE_CURRENT_BINARY_DIR}")
+ include_directories("${CMAKE_HOME_DIRECTORY}/include/smpi")
+
+ add_executable(infotest2f90 infotest2f90.f90 ../util/mtestf90.f90)
+ add_executable(infotestf90 infotestf90.f90 ../util/mtestf90.f90)
+ target_link_libraries(infotest2f90 simgrid mtest_f90)
+ target_link_libraries(infotestf90 simgrid mtest_f90)
+
+endif()
+
+set(tesh_files
+ ${tesh_files}
+ PARENT_SCOPE
+ )
+set(xml_files
+ ${xml_files}
+ PARENT_SCOPE
+ )
+set(examples_src
+ ${examples_src}
+ ${CMAKE_CURRENT_SOURCE_DIR}/infotest2f90.f90
+ ${CMAKE_CURRENT_SOURCE_DIR}/infotestf90.f90
+ PARENT_SCOPE
+ )
+set(bin_files
+ ${bin_files}
+ PARENT_SCOPE
+ )
+set(txt_files
+ ${txt_files}
+ ${CMAKE_CURRENT_SOURCE_DIR}/testlist
+ PARENT_SCOPE
+ )
--- /dev/null
+! This file created from test/mpi/f77/info/infotest2f.f with f77tof90
+! -*- Mode: Fortran; -*-
+!
+! (C) 2003 by Argonne National Laboratory.
+! See COPYRIGHT in top-level directory.
+!
+ program main
+ use mpi
+ integer ierr, errs
+ integer i1, i2
+ integer nkeys, i, j, sumindex, vlen, ln, valuelen
+ logical found, flag
+ character*(MPI_MAX_INFO_KEY) keys(6)
+ character*(MPI_MAX_INFO_VAL) values(6)
+ character*(MPI_MAX_INFO_KEY) mykey
+ character*(MPI_MAX_INFO_VAL) myvalue
+!
+ data keys/"Key1", "key2", "KeY3", "A Key With Blanks","See Below", &
+ & "last"/
+ data values/"value 1", "value 2", "VaLue 3", "key=valu:3","false", &
+ & "no test"/
+!
+ errs = 0
+
+ call mtest_init( ierr )
+
+! Note that the MPI standard requires that leading an trailing blanks
+! are stripped from keys and values (Section 4.10, The Info Object)
+!
+! First, create and initialize an info
+ call mpi_info_create( i1, ierr )
+ call mpi_info_set( i1, keys(1), values(1), ierr )
+ call mpi_info_set( i1, keys(2), values(2), ierr )
+ call mpi_info_set( i1, keys(3), values(3), ierr )
+ call mpi_info_set( i1, keys(4), values(4), ierr )
+ call mpi_info_set( i1, " See Below", values(5), ierr )
+ call mpi_info_set( i1, keys(6), " no test ", ierr )
+!
+ call mpi_info_get_nkeys( i1, nkeys, ierr )
+ if (nkeys .ne. 6) then
+ print *, ' Number of keys should be 6, is ', nkeys
+ endif
+ sumindex = 0
+ do i=1, nkeys
+! keys are number from 0 to n-1, even in Fortran (Section 4.10)
+ call mpi_info_get_nthkey( i1, i-1, mykey, ierr )
+ found = .false.
+ do j=1, 6
+ if (mykey .eq. keys(j)) then
+ found = .true.
+ sumindex = sumindex + j
+ call mpi_info_get_valuelen( i1, mykey, vlen, flag, ierr )
+ if (.not.flag) then
+ errs = errs + 1
+ print *, ' no value for key', mykey
+ else
+ call mpi_info_get( i1, mykey, MPI_MAX_INFO_VAL, &
+ & myvalue, flag, ierr )
+ if (myvalue .ne. values(j)) then
+ errs = errs + 1
+ print *, ' Value for ', mykey, ' not expected'
+ else
+ do ln=MPI_MAX_INFO_VAL,1,-1
+ if (myvalue(ln:ln) .ne. ' ') then
+ if (vlen .ne. ln) then
+ errs = errs + 1
+ print *, ' length is ', ln, &
+ & ' but valuelen gave ', vlen, &
+ & ' for key ', mykey
+ endif
+ goto 100
+ endif
+ enddo
+ 100 continue
+ endif
+ endif
+ endif
+ enddo
+ if (.not.found) then
+ print *, i, 'th key ', mykey, ' not in list'
+ endif
+ enddo
+ if (sumindex .ne. 21) then
+ errs = errs + 1
+ print *, ' Not all keys found'
+ endif
+!
+! delete 2, then dup, then delete 2 more
+ call mpi_info_delete( i1, keys(1), ierr )
+ call mpi_info_delete( i1, keys(2), ierr )
+ call mpi_info_dup( i1, i2, ierr )
+ call mpi_info_delete( i1, keys(3), ierr )
+!
+! check the contents of i2
+! valuelen does not signal an error for unknown keys; instead, sets
+! flag to false
+ do i=1,2
+ flag = .true.
+ call mpi_info_get_valuelen( i2, keys(i), valuelen, flag, ierr )
+ if (flag) then
+ errs = errs + 1
+ print *, ' Found unexpected key ', keys(i)
+ endif
+ myvalue = 'A test'
+ call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL, &
+ & myvalue, flag, ierr )
+ if (flag) then
+ errs = errs + 1
+ print *, ' Found unexpected key in MPI_Info_get ', keys(i)
+ else
+ if (myvalue .ne. 'A test') then
+ errs = errs + 1
+ print *, ' Returned value overwritten, is now ', myvalue
+ endif
+ endif
+
+ enddo
+ do i=3,6
+ myvalue = ' '
+ call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL, &
+ & myvalue, flag, ierr )
+ if (.not. flag) then
+ errs = errs + 1
+ print *, ' Did not find key ', keys(i)
+ else
+ if (myvalue .ne. values(i)) then
+ errs = errs + 1
+ print *, ' Found wrong value (', myvalue, ') for key ', &
+ & keys(i)
+ endif
+ endif
+ enddo
+!
+! Free info
+ call mpi_info_free( i1, ierr )
+ call mpi_info_free( i2, ierr )
+
+ call mtest_finalize( errs )
+ call mpi_finalize( ierr )
+
+ end
--- /dev/null
+! This file created from test/mpi/f77/info/infotestf.f with f77tof90
+! -*- Mode: Fortran; -*-
+!
+! (C) 2003 by Argonne National Laboratory.
+! See COPYRIGHT in top-level directory.
+!
+! Simple info test
+ program main
+ use mpi
+ integer i1, i2
+ integer i, errs, ierr
+ integer valuelen
+ parameter (valuelen=64)
+ character*(valuelen) value
+ logical flag
+!
+ errs = 0
+
+ call MTest_Init( ierr )
+
+ call mpi_info_create( i1, ierr )
+ call mpi_info_create( i2, ierr )
+
+ call mpi_info_set( i1, "key1", "value1", ierr )
+ call mpi_info_set( i2, "key2", "value2", ierr )
+
+ call mpi_info_get( i1, "key2", valuelen, value, flag, ierr )
+ if (flag) then
+ print *, "Found key2 in info1"
+ errs = errs + 1
+ endif
+
+ call MPI_Info_get( i1, "key1", 64, value, flag, ierr )
+ if (.not. flag ) then
+ print *, "Did not find key1 in info1"
+ errs = errs + 1
+ else
+ if (value .ne. "value1") then
+ print *, "Found wrong value (", value, "), expected value1"
+ errs = errs + 1
+ else
+! check for trailing blanks
+ do i=7,valuelen
+ if (value(i:i) .ne. " ") then
+ print *, "Found non blank in info value"
+ errs = errs + 1
+ endif
+ enddo
+ endif
+ endif
+
+ call mpi_info_free( i1, ierr )
+ call mpi_info_free( i2, ierr )
+
+ call MTest_Finalize( errs )
+ call MPI_Finalize( ierr )
+ end
--- /dev/null
+# This file generated by f77tof90
+infotestf90 1
+infotest2f90 1
coll
#comm
#ext
-#info
+info
init
#io
#misc
