From: Augustin Degomme Date: Thu, 6 Nov 2014 15:08:28 +0000 (+0100) Subject: add mpi_info_* support to fortran, and activate relevant tests X-Git-Tag: v3_12~732^2~222 X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/commitdiff_plain/8bd488d2f6b7042f4a7dd2879ce490f127b16ec2 add mpi_info_* support to fortran, and activate relevant tests --- diff --git a/buildtools/Cmake/DefinePackages.cmake b/buildtools/Cmake/DefinePackages.cmake index e83f2c3266..092dbc20e2 100644 --- a/buildtools/Cmake/DefinePackages.cmake +++ b/buildtools/Cmake/DefinePackages.cmake @@ -1066,6 +1066,7 @@ set(TESHSUITE_CMAKEFILES_TXT 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 @@ -1076,6 +1077,7 @@ set(TESHSUITE_CMAKEFILES_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 diff --git a/buildtools/Cmake/MakeExe.cmake b/buildtools/Cmake/MakeExe.cmake index f15d5e5429..59ac10f121 100644 --- a/buildtools/Cmake/MakeExe.cmake +++ b/buildtools/Cmake/MakeExe.cmake @@ -155,6 +155,7 @@ add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f77/comm) 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) @@ -162,6 +163,7 @@ add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/f90/util) 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) diff --git a/include/smpi/mpif.h.in b/include/smpi/mpif.h.in index 1849bab88c..0c07bbb188 100644 --- a/include/smpi/mpif.h.in +++ b/include/smpi/mpif.h.in @@ -91,7 +91,7 @@ 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 diff --git a/src/smpi/private.h b/src/smpi/private.h index c9b7b8da8f..63b8694120 100644 --- a/src/smpi/private.h +++ b/src/smpi/private.h @@ -297,6 +297,8 @@ int smpi_op_c2f(MPI_Op op); 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); @@ -556,7 +558,7 @@ void mpi_win_create_( int *base, MPI_Aint* size, int* disp_unit, int* info, int* 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); @@ -692,17 +694,17 @@ void mpi_comm_dup_with_info_ (int* comm, int* info, int* newcomm, 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); diff --git a/src/smpi/smpi_f77.c b/src/smpi/smpi_f77.c index 854249ff44..a832f33a37 100644 --- a/src/smpi/smpi_f77.c +++ b/src/smpi/smpi_f77.c @@ -16,6 +16,8 @@ static xbt_dict_t request_lookup = NULL; 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__) @@ -190,6 +192,27 @@ static void free_win(int win) { 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); @@ -198,6 +221,7 @@ static void smpi_init_fortran_types(){ 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__) @@ -718,13 +742,19 @@ void mpi_win_free_( int* win, int* ierr){ 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'; @@ -738,15 +768,58 @@ void mpi_win_get_name_ (int* win, char * name, int* len, int* ierr){ } 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, @@ -1463,7 +1536,7 @@ void mpi_comm_set_name_ (int* comm, char* name, int* ierr, int size){ 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); } @@ -1471,23 +1544,24 @@ void mpi_comm_dup_with_info_ (int* comm, int* info, int* newcomm, int* ierr){ 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); @@ -1510,23 +1584,48 @@ void mpi_comm_call_errhandler_ (int* comm,int* errorcode, int* ierr){ } 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); iinfo_dict,cursor,keyn,data){ if(num==n){ - memcpy(key,keyn, strlen(keyn)); + strcpy(key,keyn); return MPI_SUCCESS; } num++; @@ -3255,15 +3263,6 @@ int PMPI_Pack_size(int incount, MPI_Datatype datatype, MPI_Comm comm, int* size) 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 } diff --git a/teshsuite/smpi/mpich3-test/f77/info/CMakeLists.txt b/teshsuite/smpi/mpich3-test/f77/info/CMakeLists.txt new file mode 100644 index 0000000000..a7aa476388 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/f77/info/CMakeLists.txt @@ -0,0 +1,46 @@ +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 + ) diff --git a/teshsuite/smpi/mpich3-test/f77/info/infotest2f.f b/teshsuite/smpi/mpich3-test/f77/info/infotest2f.f new file mode 100644 index 0000000000..204897c357 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/f77/info/infotest2f.f @@ -0,0 +1,141 @@ +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 diff --git a/teshsuite/smpi/mpich3-test/f77/info/infotestf.f b/teshsuite/smpi/mpich3-test/f77/info/infotestf.f new file mode 100644 index 0000000000..a2ec83bc2c --- /dev/null +++ b/teshsuite/smpi/mpich3-test/f77/info/infotestf.f @@ -0,0 +1,57 @@ +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 diff --git a/teshsuite/smpi/mpich3-test/f77/info/testlist b/teshsuite/smpi/mpich3-test/f77/info/testlist new file mode 100644 index 0000000000..e7512e6d0d --- /dev/null +++ b/teshsuite/smpi/mpich3-test/f77/info/testlist @@ -0,0 +1,2 @@ +infotestf 1 +infotest2f 1 diff --git a/teshsuite/smpi/mpich3-test/f77/testlist b/teshsuite/smpi/mpich3-test/f77/testlist index e275a57ead..faa6ac4337 100644 --- a/teshsuite/smpi/mpich3-test/f77/testlist +++ b/teshsuite/smpi/mpich3-test/f77/testlist @@ -2,7 +2,7 @@ coll datatype pt2pt -#info +info #spawn #io rma diff --git a/teshsuite/smpi/mpich3-test/f90/info/CMakeLists.txt b/teshsuite/smpi/mpich3-test/f90/info/CMakeLists.txt new file mode 100644 index 0000000000..a1a319c191 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/f90/info/CMakeLists.txt @@ -0,0 +1,43 @@ +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 + ) diff --git a/teshsuite/smpi/mpich3-test/f90/info/infotest2f90.f90 b/teshsuite/smpi/mpich3-test/f90/info/infotest2f90.f90 new file mode 100644 index 0000000000..d3f6091e74 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/f90/info/infotest2f90.f90 @@ -0,0 +1,141 @@ +! 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 diff --git a/teshsuite/smpi/mpich3-test/f90/info/infotestf90.f90 b/teshsuite/smpi/mpich3-test/f90/info/infotestf90.f90 new file mode 100644 index 0000000000..05419ab748 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/f90/info/infotestf90.f90 @@ -0,0 +1,57 @@ +! 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 diff --git a/teshsuite/smpi/mpich3-test/f90/info/testlist b/teshsuite/smpi/mpich3-test/f90/info/testlist new file mode 100644 index 0000000000..9c664b1c11 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/f90/info/testlist @@ -0,0 +1,3 @@ +# This file generated by f77tof90 +infotestf90 1 +infotest2f90 1 diff --git a/teshsuite/smpi/mpich3-test/f90/testlist b/teshsuite/smpi/mpich3-test/f90/testlist index 5e3e7d8841..ccba896965 100644 --- a/teshsuite/smpi/mpich3-test/f90/testlist +++ b/teshsuite/smpi/mpich3-test/f90/testlist @@ -2,7 +2,7 @@ coll #comm #ext -#info +info init #io #misc