From 523128100e9fd34cd58a7a466425701be29c6bd1 Mon Sep 17 00:00:00 2001 From: Jeff Squyres Date: Wed, 23 Aug 2006 13:10:44 +0000 Subject: [PATCH] A bunch of fixes for Fortran string issues. In general, ensure to convert between fortran and C string representations properly. In doing so, we properly adhere to the MPI spec stating that MPI_Info keys and values must be whitespace-trimmed when coming in from Fortran. Hence, this fixes bug #241. This commit was SVN r11356. --- ompi/mpi/f77/add_error_string_f.c | 2 + ompi/mpi/f77/error_string_f.c | 48 ++++++++++++++++------- ompi/mpi/f77/get_processor_name_f.c | 51 +++++++++++++++++------- ompi/mpi/f77/info_delete_f.c | 51 ++++++++++++++++-------- ompi/mpi/f77/info_get_f.c | 61 ++++++++++++++++++++++------- ompi/mpi/f77/info_get_nthkey_f.c | 53 +++++++++++++++++-------- ompi/mpi/f77/info_get_valuelen_f.c | 48 ++++++++++++++++------- ompi/mpi/f77/info_set_f.c | 59 ++++++++++++++++++++-------- ompi/mpi/f77/prototypes_mpi.h | 14 +++---- 9 files changed, 274 insertions(+), 113 deletions(-) diff --git a/ompi/mpi/f77/add_error_string_f.c b/ompi/mpi/f77/add_error_string_f.c index 37ac0394e4..d2aa566688 100644 --- a/ompi/mpi/f77/add_error_string_f.c +++ b/ompi/mpi/f77/add_error_string_f.c @@ -9,6 +9,7 @@ * University of Stuttgart. All rights reserved. * Copyright (c) 2004-2005 The Regents of the University of California. * All rights reserved. + * Copyright (c) 2006 Cisco Systems, Inc. All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow @@ -76,4 +77,5 @@ void mpi_add_error_string_f(MPI_Fint *errorcode, char *string, ompi_fortran_string_f2c(string, len, &c_string); *ierr = OMPI_INT_2_FINT(MPI_Add_error_string(OMPI_FINT_2_INT(*errorcode), c_string)); + free(c_string); } diff --git a/ompi/mpi/f77/error_string_f.c b/ompi/mpi/f77/error_string_f.c index a4876519bd..a180e84755 100644 --- a/ompi/mpi/f77/error_string_f.c +++ b/ompi/mpi/f77/error_string_f.c @@ -9,6 +9,7 @@ * University of Stuttgart. All rights reserved. * Copyright (c) 2004-2005 The Regents of the University of California. * All rights reserved. + * Copyright (c) 2006 Cisco Systems, Inc. All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow @@ -19,6 +20,9 @@ #include "ompi_config.h" #include "ompi/mpi/f77/bindings.h" +#include "ompi/mpi/f77/strings.h" +#include "ompi/constants.h" +#include "ompi/communicator/communicator.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_ERROR_STRING = mpi_error_string_f @@ -27,12 +31,12 @@ #pragma weak pmpi_error_string__ = mpi_error_string_f #elif OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (PMPI_ERROR_STRING, - pmpi_error_string, - pmpi_error_string_, - pmpi_error_string__, - pmpi_error_string_f, - (MPI_Fint *errorcode, char *string, MPI_Fint *resultlen, MPI_Fint *ierr), - (errorcode, string, resultlen, ierr) ) + pmpi_error_string, + pmpi_error_string_, + pmpi_error_string__, + pmpi_error_string_f, + (MPI_Fint *errorcode, char *string, MPI_Fint *resultlen, MPI_Fint *ierr, int string_len), + (errorcode, string, resultlen, ierr, string_len) ) #endif #if OMPI_HAVE_WEAK_SYMBOLS @@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_ERROR_STRING, #if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (MPI_ERROR_STRING, - mpi_error_string, - mpi_error_string_, - mpi_error_string__, - mpi_error_string_f, - (MPI_Fint *errorcode, char *string, MPI_Fint *resultlen, MPI_Fint *ierr), - (errorcode, string, resultlen, ierr) ) + mpi_error_string, + mpi_error_string_, + mpi_error_string__, + mpi_error_string_f, + (MPI_Fint *errorcode, char *string, MPI_Fint *resultlen, MPI_Fint *ierr, int string_len), + (errorcode, string, resultlen, ierr, string_len) ) #endif @@ -57,17 +61,33 @@ OMPI_GENERATE_F77_BINDINGS (MPI_ERROR_STRING, #include "ompi/mpi/f77/profile/defines.h" #endif +static const char FUNC_NAME[] = "MPI_ERROR_STRING"; + +/* Note that the string_len parameter is silently added by the Fortran + compiler, and will be filled in with the actual length of the + character array from the caller. Hence, it's the max length of the + string that we can use. */ + void mpi_error_string_f(MPI_Fint *errorcode, char *string, - MPI_Fint *resultlen, MPI_Fint *ierr) + MPI_Fint *resultlen, MPI_Fint *ierr, int string_len) { + int c_err, ret; + char c_string[MPI_MAX_ERROR_STRING + 1]; OMPI_SINGLE_NAME_DECL(resultlen); *ierr = OMPI_INT_2_FINT(MPI_Error_string(OMPI_FINT_2_INT(*errorcode), - string, + c_string, OMPI_SINGLE_NAME_CONVERT(resultlen) )); if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) { OMPI_SINGLE_INT_2_FINT(resultlen); + string_len = (string_len < MPI_MAX_ERROR_STRING) ? + string_len : MPI_MAX_ERROR_STRING; + if (OMPI_SUCCESS != (ret = ompi_fortran_string_c2f(c_string, string, + string_len))) { + c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME); + *ierr = OMPI_INT_2_FINT(c_err); + } } } diff --git a/ompi/mpi/f77/get_processor_name_f.c b/ompi/mpi/f77/get_processor_name_f.c index 768643b44c..5972829f5c 100644 --- a/ompi/mpi/f77/get_processor_name_f.c +++ b/ompi/mpi/f77/get_processor_name_f.c @@ -9,6 +9,7 @@ * University of Stuttgart. All rights reserved. * Copyright (c) 2004-2005 The Regents of the University of California. * All rights reserved. + * Copyright (c) 2006 Cisco Systems, Inc. All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow @@ -19,6 +20,9 @@ #include "ompi_config.h" #include "ompi/mpi/f77/bindings.h" +#include "ompi/constants.h" +#include "ompi/communicator/communicator.h" +#include "ompi/mpi/f77/strings.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_GET_PROCESSOR_NAME = mpi_get_processor_name_f @@ -27,12 +31,12 @@ #pragma weak pmpi_get_processor_name__ = mpi_get_processor_name_f #elif OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (PMPI_GET_PROCESSOR_NAME, - pmpi_get_processor_name, - pmpi_get_processor_name_, - pmpi_get_processor_name__, - pmpi_get_processor_name_f, - (char *name, MPI_Fint *resultlen, MPI_Fint *ierr), - (name, resultlen, ierr) ) + pmpi_get_processor_name, + pmpi_get_processor_name_, + pmpi_get_processor_name__, + pmpi_get_processor_name_f, + (char *name, MPI_Fint *resultlen, MPI_Fint *ierr, int name_len), + (name, resultlen, ierr, name_len) ) #endif #if OMPI_HAVE_WEAK_SYMBOLS @@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_GET_PROCESSOR_NAME, #if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (MPI_GET_PROCESSOR_NAME, - mpi_get_processor_name, - mpi_get_processor_name_, - mpi_get_processor_name__, - mpi_get_processor_name_f, - (char *name, MPI_Fint *resultlen, MPI_Fint *ierr), - (name, resultlen, ierr) ) + mpi_get_processor_name, + mpi_get_processor_name_, + mpi_get_processor_name__, + mpi_get_processor_name_f, + (char *name, MPI_Fint *resultlen, MPI_Fint *ierr, int name_len), + (name, resultlen, ierr, name_len) ) #endif @@ -57,13 +61,32 @@ OMPI_GENERATE_F77_BINDINGS (MPI_GET_PROCESSOR_NAME, #include "ompi/mpi/f77/profile/defines.h" #endif -void mpi_get_processor_name_f(char *name, MPI_Fint *resultlen, MPI_Fint *ierr) +static const char FUNC_NAME[] = "MPI_GET_PROCESSOR_NAME"; + +/* Note that the name_len parameter is silently added by the Fortran + compiler, and will be filled in with the actual length of the + character array from the caller. Hence, it's the max length of the + string that we can use. */ + +void mpi_get_processor_name_f(char *name, MPI_Fint *resultlen, MPI_Fint *ierr, + int name_len) { + int c_err, ret; + char c_name[MPI_MAX_PROCESSOR_NAME + 1]; OMPI_SINGLE_NAME_DECL(resultlen); - *ierr = OMPI_INT_2_FINT(MPI_Get_processor_name(name, + *ierr = OMPI_INT_2_FINT(MPI_Get_processor_name(c_name, OMPI_SINGLE_NAME_CONVERT(resultlen))); if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) { OMPI_SINGLE_INT_2_FINT(resultlen); + + name_len = (name_len < OMPI_FINT_2_INT(*resultlen)) ? + name_len : OMPI_FINT_2_INT(*resultlen); + if (OMPI_SUCCESS != (ret = ompi_fortran_string_c2f(c_name, name, + name_len))) { + c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME); + *ierr = OMPI_INT_2_FINT(c_err); + return; + } } } diff --git a/ompi/mpi/f77/info_delete_f.c b/ompi/mpi/f77/info_delete_f.c index 7a209ebeba..24299329e9 100644 --- a/ompi/mpi/f77/info_delete_f.c +++ b/ompi/mpi/f77/info_delete_f.c @@ -9,6 +9,7 @@ * University of Stuttgart. All rights reserved. * Copyright (c) 2004-2005 The Regents of the University of California. * All rights reserved. + * Copyright (c) 2006 Cisco Systems, Inc. All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow @@ -19,6 +20,9 @@ #include "ompi_config.h" #include "ompi/mpi/f77/bindings.h" +#include "ompi/constants.h" +#include "ompi/communicator/communicator.h" +#include "ompi/mpi/f77/strings.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_INFO_DELETE = mpi_info_delete_f @@ -27,12 +31,12 @@ #pragma weak pmpi_info_delete__ = mpi_info_delete_f #elif OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_DELETE, - pmpi_info_delete, - pmpi_info_delete_, - pmpi_info_delete__, - pmpi_info_delete_f, - (MPI_Fint *info, char *key, MPI_Fint *ierr), - (info, key, ierr) ) + pmpi_info_delete, + pmpi_info_delete_, + pmpi_info_delete__, + pmpi_info_delete_f, + (MPI_Fint *info, char *key, MPI_Fint *ierr, int key_len), + (info, key, ierr, key_len) ) #endif #if OMPI_HAVE_WEAK_SYMBOLS @@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_DELETE, #if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (MPI_INFO_DELETE, - mpi_info_delete, - mpi_info_delete_, - mpi_info_delete__, - mpi_info_delete_f, - (MPI_Fint *info, char *key, MPI_Fint *ierr), - (info, key, ierr) ) + mpi_info_delete, + mpi_info_delete_, + mpi_info_delete__, + mpi_info_delete_f, + (MPI_Fint *info, char *key, MPI_Fint *ierr, int key_len), + (info, key, ierr, key_len) ) #endif @@ -57,11 +61,26 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_DELETE, #include "ompi/mpi/f77/profile/defines.h" #endif -void mpi_info_delete_f(MPI_Fint *info, char *key, MPI_Fint *ierr) -{ - MPI_Info c_info; +static const char FUNC_NAME[] = "MPI_INFO_DELETE"; +/* Note that the key_len parameter is silently added by the Fortran + compiler, and will be filled in with the actual length of the + character array from the caller. Hence, it's the max length of the + string that we can use. */ + +void mpi_info_delete_f(MPI_Fint *info, char *key, MPI_Fint *ierr, int key_len) +{ + int c_err, ret; + MPI_Info c_info; + char *c_key; + + if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(key, key_len, &c_key))) { + c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME); + *ierr = OMPI_INT_2_FINT(c_err); + return; + } c_info = MPI_Info_f2c(*info); - *ierr = OMPI_INT_2_FINT(MPI_Info_delete(c_info, key)); + *ierr = OMPI_INT_2_FINT(MPI_Info_delete(c_info, c_key)); + free(c_key); } diff --git a/ompi/mpi/f77/info_get_f.c b/ompi/mpi/f77/info_get_f.c index e73a291dc8..958cacd889 100644 --- a/ompi/mpi/f77/info_get_f.c +++ b/ompi/mpi/f77/info_get_f.c @@ -9,6 +9,7 @@ * University of Stuttgart. All rights reserved. * Copyright (c) 2004-2005 The Regents of the University of California. * All rights reserved. + * Copyright (c) 2006 Cisco Systems, Inc. All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow @@ -19,6 +20,9 @@ #include "ompi_config.h" #include "ompi/mpi/f77/bindings.h" +#include "ompi/constants.h" +#include "ompi/communicator/communicator.h" +#include "ompi/mpi/f77/strings.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_INFO_GET = mpi_info_get_f @@ -27,12 +31,12 @@ #pragma weak pmpi_info_get__ = mpi_info_get_f #elif OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET, - pmpi_info_get, - pmpi_info_get_, - pmpi_info_get__, - pmpi_info_get_f, - (MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr), - (info, key, valuelen, value, flag, ierr) ) + pmpi_info_get, + pmpi_info_get_, + pmpi_info_get__, + pmpi_info_get_f, + (MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr, int key_len, int value_len), + (info, key, valuelen, value, flag, ierr, key_len, value_len) ) #endif #if OMPI_HAVE_WEAK_SYMBOLS @@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET, #if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET, - mpi_info_get, - mpi_info_get_, - mpi_info_get__, - mpi_info_get_f, - (MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr), - (info, key, valuelen, value, flag, ierr) ) + mpi_info_get, + mpi_info_get_, + mpi_info_get__, + mpi_info_get_f, + (MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr, int key_len, int value_len), + (info, key, valuelen, value, flag, ierr, key_len, value_len) ) #endif @@ -57,19 +61,46 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET, #include "ompi/mpi/f77/profile/defines.h" #endif +static const char FUNC_NAME[] = "MPI_INFO_GET"; + +/* Note that the key_len and value_len parameters are silently added + by the Fortran compiler, and will be filled in with the actual + length of the character array from the caller. Hence, it's the max + length of the string that we can use. */ + void mpi_info_get_f(MPI_Fint *info, char *key, MPI_Fint *valuelen, - char *value, MPI_Flogical *flag, MPI_Fint *ierr) + char *value, MPI_Flogical *flag, MPI_Fint *ierr, + int key_len, int value_len) { + int c_err, ret; MPI_Info c_info; + char *c_key = NULL, c_value[MPI_MAX_INFO_VAL + 1]; OMPI_LOGICAL_NAME_DECL(flag); + if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(key, key_len, &c_key))) { + c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME); + *ierr = OMPI_INT_2_FINT(c_err); + return; + } c_info = MPI_Info_f2c(*info); - *ierr = OMPI_INT_2_FINT(MPI_Info_get(c_info, key, + *ierr = OMPI_INT_2_FINT(MPI_Info_get(c_info, c_key, OMPI_FINT_2_INT(*valuelen), - value, + c_value, OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag))); if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) { OMPI_SINGLE_INT_2_LOGICAL(flag); + + value_len = (value_len < OMPI_FINT_2_INT(*valuelen)) ? + value_len : OMPI_FINT_2_INT(*valuelen); + if (OMPI_SUCCESS != (ret = ompi_fortran_string_c2f(c_value, value, + value_len))) { + c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME); + *ierr = OMPI_INT_2_FINT(c_err); + free(c_key); + return; + } } + + free(c_key); } diff --git a/ompi/mpi/f77/info_get_nthkey_f.c b/ompi/mpi/f77/info_get_nthkey_f.c index 0513a00d40..435dcb2966 100644 --- a/ompi/mpi/f77/info_get_nthkey_f.c +++ b/ompi/mpi/f77/info_get_nthkey_f.c @@ -9,6 +9,7 @@ * University of Stuttgart. All rights reserved. * Copyright (c) 2004-2005 The Regents of the University of California. * All rights reserved. + * Copyright (c) 2006 Cisco Systems, Inc. All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow @@ -19,6 +20,9 @@ #include "ompi_config.h" #include "ompi/mpi/f77/bindings.h" +#include "ompi/constants.h" +#include "ompi/communicator/communicator.h" +#include "ompi/mpi/f77/strings.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_INFO_GET_NTHKEY = mpi_info_get_nthkey_f @@ -27,12 +31,12 @@ #pragma weak pmpi_info_get_nthkey__ = mpi_info_get_nthkey_f #elif OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET_NTHKEY, - pmpi_info_get_nthkey, - pmpi_info_get_nthkey_, - pmpi_info_get_nthkey__, - pmpi_info_get_nthkey_f, - (MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr), - (info, n, key, ierr) ) + pmpi_info_get_nthkey, + pmpi_info_get_nthkey_, + pmpi_info_get_nthkey__, + pmpi_info_get_nthkey_f, + (MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr, int key_len), + (info, n, key, ierr, key_len) ) #endif #if OMPI_HAVE_WEAK_SYMBOLS @@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET_NTHKEY, #if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET_NTHKEY, - mpi_info_get_nthkey, - mpi_info_get_nthkey_, - mpi_info_get_nthkey__, - mpi_info_get_nthkey_f, - (MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr), - (info, n, key, ierr) ) + mpi_info_get_nthkey, + mpi_info_get_nthkey_, + mpi_info_get_nthkey__, + mpi_info_get_nthkey_f, + (MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr, int key_len), + (info, n, key, ierr, key_len) ) #endif @@ -57,14 +61,29 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET_NTHKEY, #include "ompi/mpi/f77/profile/defines.h" #endif -void mpi_info_get_nthkey_f(MPI_Fint *info, MPI_Fint *n, char *key, - MPI_Fint *ierr) -{ - MPI_Info c_info; +static const char FUNC_NAME[] = "MPI_INFO_GET_NTHKEY"; +/* Note that the key_len parameter is silently added by the Fortran + compiler, and will be filled in with the actual length of the + character array from the caller. Hence, it's the max length of the + string that we can use. */ + +void mpi_info_get_nthkey_f(MPI_Fint *info, MPI_Fint *n, char *key, + MPI_Fint *ierr, int key_len) +{ + int c_err, ret; + MPI_Info c_info; + char *c_key; + + if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(key, key_len, &c_key))) { + c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME); + *ierr = OMPI_INT_2_FINT(c_err); + return; + } c_info = MPI_Info_f2c(*info); *ierr = OMPI_INT_2_FINT(MPI_Info_get_nthkey(c_info, OMPI_FINT_2_INT(*n), - key)); + c_key)); + free(c_key); } diff --git a/ompi/mpi/f77/info_get_valuelen_f.c b/ompi/mpi/f77/info_get_valuelen_f.c index 5d0c3be1c3..410ffa5e10 100644 --- a/ompi/mpi/f77/info_get_valuelen_f.c +++ b/ompi/mpi/f77/info_get_valuelen_f.c @@ -9,6 +9,7 @@ * University of Stuttgart. All rights reserved. * Copyright (c) 2004-2005 The Regents of the University of California. * All rights reserved. + * Copyright (c) 2006 Cisco Systems, Inc. All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow @@ -19,6 +20,9 @@ #include "ompi_config.h" #include "ompi/mpi/f77/bindings.h" +#include "ompi/constants.h" +#include "ompi/communicator/communicator.h" +#include "ompi/mpi/f77/strings.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_INFO_GET_VALUELEN = mpi_info_get_valuelen_f @@ -27,12 +31,12 @@ #pragma weak pmpi_info_get_valuelen__ = mpi_info_get_valuelen_f #elif OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET_VALUELEN, - pmpi_info_get_valuelen, - pmpi_info_get_valuelen_, - pmpi_info_get_valuelen__, - pmpi_info_get_valuelen_f, - (MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr), - (info, key, valuelen, flag, ierr) ) + pmpi_info_get_valuelen, + pmpi_info_get_valuelen_, + pmpi_info_get_valuelen__, + pmpi_info_get_valuelen_f, + (MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr, int key_len), + (info, key, valuelen, flag, ierr, key_len) ) #endif #if OMPI_HAVE_WEAK_SYMBOLS @@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET_VALUELEN, #if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET_VALUELEN, - mpi_info_get_valuelen, - mpi_info_get_valuelen_, - mpi_info_get_valuelen__, - mpi_info_get_valuelen_f, - (MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr), - (info, key, valuelen, flag, ierr) ) + mpi_info_get_valuelen, + mpi_info_get_valuelen_, + mpi_info_get_valuelen__, + mpi_info_get_valuelen_f, + (MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr, int key_len), + (info, key, valuelen, flag, ierr, key_len) ) #endif @@ -57,20 +61,36 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET_VALUELEN, #include "ompi/mpi/f77/profile/defines.h" #endif +static const char FUNC_NAME[] = "MPI_INFO_GET_VALUELEN"; + +/* Note that the key_len parameter is silently added by the Fortran + compiler, and will be filled in with the actual length of the + character array from the caller. Hence, it's the max length of the + string that we can use. */ + void mpi_info_get_valuelen_f(MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, - MPI_Fint *ierr) + MPI_Fint *ierr, int key_len) { + int c_err, ret; MPI_Info c_info; + char *c_key; OMPI_SINGLE_NAME_DECL(valuelen); OMPI_LOGICAL_NAME_DECL(flag); + if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(key, key_len, &c_key))) { + c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME); + *ierr = OMPI_INT_2_FINT(c_err); + return; + } c_info = MPI_Info_f2c(*info); - *ierr = OMPI_INT_2_FINT(MPI_Info_get_valuelen(c_info, key, + *ierr = OMPI_INT_2_FINT(MPI_Info_get_valuelen(c_info, c_key, OMPI_SINGLE_NAME_CONVERT(valuelen), OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag))); if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) { OMPI_SINGLE_INT_2_FINT(valuelen); OMPI_SINGLE_INT_2_LOGICAL(flag); } + + free(c_key); } diff --git a/ompi/mpi/f77/info_set_f.c b/ompi/mpi/f77/info_set_f.c index 6845a68b7b..60a83e9add 100644 --- a/ompi/mpi/f77/info_set_f.c +++ b/ompi/mpi/f77/info_set_f.c @@ -9,6 +9,7 @@ * University of Stuttgart. All rights reserved. * Copyright (c) 2004-2005 The Regents of the University of California. * All rights reserved. + * Copyright (c) 2006 Cisco Systems, Inc. All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow @@ -19,6 +20,9 @@ #include "ompi_config.h" #include "ompi/mpi/f77/bindings.h" +#include "ompi/constants.h" +#include "ompi/communicator/communicator.h" +#include "ompi/mpi/f77/strings.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_INFO_SET = mpi_info_set_f @@ -27,12 +31,12 @@ #pragma weak pmpi_info_set__ = mpi_info_set_f #elif OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_SET, - pmpi_info_set, - pmpi_info_set_, - pmpi_info_set__, - pmpi_info_set_f, - (MPI_Fint *info, char *key, char *value, MPI_Fint *ierr), - (info, key, value, ierr) ) + pmpi_info_set, + pmpi_info_set_, + pmpi_info_set__, + pmpi_info_set_f, + (MPI_Fint *info, char *key, char *value, MPI_Fint *ierr, int key_len, int value_len), + (info, key, value, ierr, key_len, value_len) ) #endif #if OMPI_HAVE_WEAK_SYMBOLS @@ -44,12 +48,12 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_SET, #if ! OMPI_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER OMPI_GENERATE_F77_BINDINGS (MPI_INFO_SET, - mpi_info_set, - mpi_info_set_, - mpi_info_set__, - mpi_info_set_f, - (MPI_Fint *info, char *key, char *value, MPI_Fint *ierr), - (info, key, value, ierr) ) + mpi_info_set, + mpi_info_set_, + mpi_info_set__, + mpi_info_set_f, + (MPI_Fint *info, char *key, char *value, MPI_Fint *ierr, int key_len, int value_len), + (info, key, value, ierr, key_len, value_len) ) #endif @@ -57,11 +61,34 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_SET, #include "ompi/mpi/f77/profile/defines.h" #endif -void mpi_info_set_f(MPI_Fint *info, char *key, char *value, MPI_Fint *ierr) -{ - MPI_Info c_info; +static const char FUNC_NAME[] = "MPI_INFO_SET"; +/* Note that the key_len and value_len parameters are silently added + by the Fortran compiler, and will be filled in with the actual + length of the character array from the caller. Hence, it's the max + length of the string that we can use. */ + +void mpi_info_set_f(MPI_Fint *info, char *key, char *value, MPI_Fint *ierr, + int key_len, int value_len) +{ + int ret, c_err; + MPI_Info c_info; + char *c_key = NULL, *c_value = NULL; + + if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(key, key_len, &c_key)) || + OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(value, value_len, + &c_value))) { + c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME); + *ierr = OMPI_INT_2_FINT(c_err); + if (NULL != c_key) { + free(c_key); + } + return; + } c_info = MPI_Info_f2c(*info); - *ierr = OMPI_INT_2_FINT(MPI_Info_set(c_info, key, value)); + *ierr = OMPI_INT_2_FINT(MPI_Info_set(c_info, c_key, c_value)); + + free(c_key); + free(c_value); } diff --git a/ompi/mpi/f77/prototypes_mpi.h b/ompi/mpi/f77/prototypes_mpi.h index 8dbf91d850..c351e3a136 100644 --- a/ompi/mpi/f77/prototypes_mpi.h +++ b/ompi/mpi/f77/prototypes_mpi.h @@ -122,7 +122,7 @@ PN(void, mpi_errhandler_free, MPI_ERRHANDLER_FREE, (MPI_Fint *errhandler, MPI_Fi PN(void, mpi_errhandler_get, MPI_ERRHANDLER_GET, (MPI_Fint *comm, MPI_Fint *errhandler, MPI_Fint *ierr)); PN(void, mpi_errhandler_set, MPI_ERRHANDLER_SET, (MPI_Fint *comm, MPI_Fint *errhandler, MPI_Fint *ierr)); PN(void, mpi_error_class, MPI_ERROR_CLASS, (MPI_Fint *errorcode, MPI_Fint *errorclass, MPI_Fint *ierr)); -PN(void, mpi_error_string, MPI_ERROR_STRING, (MPI_Fint *errorcode, char *string, MPI_Fint *resultlen, MPI_Fint *ierr)); +PN(void, mpi_error_string, MPI_ERROR_STRING, (MPI_Fint *errorcode, char *string, MPI_Fint *resultlen, MPI_Fint *ierr, int string_len)); PN(void, mpi_exscan, MPI_EXSCAN, (char *sendbuf, char *recvbuf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, MPI_Fint *ierr)); PN(void, mpi_file_call_errhandler, MPI_FILE_CALL_ERRHANDLER, (MPI_Fint *fh, MPI_Fint *errorcode, MPI_Fint *ierr)); PN(void, mpi_file_create_errhandler, MPI_FILE_CREATE_ERRHANDLER, (ompi_errhandler_fortran_handler_fn_t* function, MPI_Fint *errhandler, MPI_Fint *ierr)); @@ -188,7 +188,7 @@ PN(void, mpi_get_address, MPI_GET_ADDRESS, (char *location, MPI_Aint *address, M PN(void, mpi_get_count, MPI_GET_COUNT, (MPI_Fint *status, MPI_Fint *datatype, MPI_Fint *count, MPI_Fint *ierr)); PN(void, mpi_get_elements, MPI_GET_ELEMENTS, (MPI_Fint *status, MPI_Fint *datatype, MPI_Fint *count, MPI_Fint *ierr)); PN(void, mpi_get, MPI_GET, (char *origin_addr, MPI_Fint *origin_count, MPI_Fint *origin_datatype, MPI_Fint *target_rank, MPI_Fint *target_disp, MPI_Fint *target_count, MPI_Fint *target_datatype, MPI_Fint *win, MPI_Fint *ierr)); -PN(void, mpi_get_processor_name, MPI_GET_PROCESSOR_NAME, (char *name, MPI_Fint *resultlen, MPI_Fint *ierr)); +PN(void, mpi_get_processor_name, MPI_GET_PROCESSOR_NAME, (char *name, MPI_Fint *resultlen, MPI_Fint *ierr, int name_len)); PN(void, mpi_get_version, MPI_GET_VERSION, (MPI_Fint *version, MPI_Fint *subversion, MPI_Fint *ierr)); PN(void, mpi_graph_create, MPI_GRAPH_CREATE, (MPI_Fint *comm_old, MPI_Fint *nnodes, MPI_Fint *index, MPI_Fint *edges, MPI_Flogical *reorder, MPI_Fint *comm_graph, MPI_Fint *ierr)); PN(void, mpi_graph_get, MPI_GRAPH_GET, (MPI_Fint *comm, MPI_Fint *maxindex, MPI_Fint *maxedges, MPI_Fint *index, MPI_Fint *edges, MPI_Fint *ierr)); @@ -212,14 +212,14 @@ PN(void, mpi_group_translate_ranks, MPI_GROUP_TRANSLATE_RANKS, (MPI_Fint *group1 PN(void, mpi_group_union, MPI_GROUP_UNION, (MPI_Fint *group1, MPI_Fint *group2, MPI_Fint *newgroup, MPI_Fint *ierr)); PN(void, mpi_ibsend, MPI_IBSEND, (char *buf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr)); PN(void, mpi_info_create, MPI_INFO_CREATE, (MPI_Fint *info, MPI_Fint *ierr)); -PN(void, mpi_info_delete, MPI_INFO_DELETE, (MPI_Fint *info, char *key, MPI_Fint *ierr)); +PN(void, mpi_info_delete, MPI_INFO_DELETE, (MPI_Fint *info, char *key, MPI_Fint *ierr, int key_len)); PN(void, mpi_info_dup, MPI_INFO_DUP, (MPI_Fint *info, MPI_Fint *newinfo, MPI_Fint *ierr)); PN(void, mpi_info_free, MPI_INFO_FREE, (MPI_Fint *info, MPI_Fint *ierr)); -PN(void, mpi_info_get, MPI_INFO_GET, (MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr)); +PN(void, mpi_info_get, MPI_INFO_GET, (MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr, int key_len, int value_len)); PN(void, mpi_info_get_nkeys, MPI_INFO_GET_NKEYS, (MPI_Fint *info, MPI_Fint *nkeys, MPI_Fint *ierr)); -PN(void, mpi_info_get_nthkey, MPI_INFO_GET_NTHKEY, (MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr)); -PN(void, mpi_info_get_valuelen, MPI_INFO_GET_VALUELEN, (MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr)); -PN(void, mpi_info_set, MPI_INFO_SET, (MPI_Fint *info, char *key, char *value, MPI_Fint *ierr)); +PN(void, mpi_info_get_nthkey, MPI_INFO_GET_NTHKEY, (MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr, int key_len)); +PN(void, mpi_info_get_valuelen, MPI_INFO_GET_VALUELEN, (MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr, int key_len)); +PN(void, mpi_info_set, MPI_INFO_SET, (MPI_Fint *info, char *key, char *value, MPI_Fint *ierr, int key_len, int value_len)); PN(void, mpi_init, MPI_INIT, (MPI_Fint *ierr)); PN(void, mpi_initialized, MPI_INITIALIZED, (MPI_Flogical *flag, MPI_Fint *ierr)); PN(void, mpi_init_thread, MPI_INIT_THREAD, (MPI_Fint *required, MPI_Fint *provided, MPI_Fint *ierr));