|
| 1 | +/* |
| 2 | + * Copyright (c) 2020 The University of Tennessee and The University |
| 3 | + * of Tennessee Research Foundation. All rights |
| 4 | + * reserved. |
| 5 | + * $COPYRIGHT$ |
| 6 | + * |
| 7 | + * Additional copyrights may follow |
| 8 | + * |
| 9 | + * $HEADER$ |
| 10 | + */ |
| 11 | + |
| 12 | +#include <stdio.h> |
| 13 | +#include <string.h> |
| 14 | +#include <unistd.h> |
| 15 | +#include "mpi.h" |
| 16 | + |
| 17 | +#define print1(format...) if(0 == rank) printf(format) |
| 18 | + |
| 19 | +int main_child(int argc, char *argv[]); |
| 20 | + |
| 21 | +int main(int argc, char *argv[]) |
| 22 | +{ |
| 23 | + int rank=MPI_PROC_NULL, rc; |
| 24 | + /* info_env and error handlers */ |
| 25 | + char init_errh_info[MPI_MAX_INFO_VAL+1]; int flag; |
| 26 | + MPI_Errhandler errh; |
| 27 | + /* error ops */ |
| 28 | + int eclass=MPI_SUCCESS; |
| 29 | + char estr[MPI_MAX_ERROR_STRING]="NOT UPDATED"; int slen; |
| 30 | + /* spawn params */ |
| 31 | + char* spawn_argv[3]; |
| 32 | + MPI_Info spawn_info; |
| 33 | + int spawn_err[2] = {MPI_SUCCESS}; |
| 34 | + MPI_Comm icomm = MPI_COMM_NULL; |
| 35 | + |
| 36 | + /* We will verify pre-init behavior in a spawnee to avoid aborting early in |
| 37 | + * implementations with only partial support. |
| 38 | + */ |
| 39 | + if(argc > 1 && 0 == strcmp(argv[1], "preinit-error")) { |
| 40 | + return main_child(argc, argv); |
| 41 | + } |
| 42 | + |
| 43 | + /* Lets assume everything goes fine until we inject our own errors, no |
| 44 | + * error checking */ |
| 45 | + MPI_Init(&argc, &argv); |
| 46 | + MPI_Comm_rank(MPI_COMM_WORLD, &rank); |
| 47 | + |
| 48 | + print1( |
| 49 | +"# This test checks compliance with MPI-4 initial error handler.\n" |
| 50 | +"# This test assumes that the command line parameter '-initial-errhandler mpi_errors_return'\n" |
| 51 | +"# is passed to 'mpiexec', in which case, a compliant implementation will:\n" |
| 52 | +"# * Set the MPI_INFO_ENV key to the requested error handler.\n" |
| 53 | +"# * The requested handler is set on the predefined communicators MPI_COMM_SELF, MPI_COMM_WORLD,\n" |
| 54 | +"# and the communicator returned from MPI_COMM_GET_PARENT.\n" |
| 55 | +"# In a high quality implementation:\n" |
| 56 | +"# * Errors reported from calls during, before, and after MPI_INIT and MPI_FINALIZE also invoke the\n" |
| 57 | +"# initial error handler.\n" |
| 58 | +"# * MPI_ERROR_STRING and MPI_ERROR_CLASS provide useful information before/after MPI_INIT and\n" |
| 59 | +"# MPI_FINALIZE respectively.\n\n"); |
| 60 | + |
| 61 | + print1("MPI_INFO_ENV for key 'mpi_initial_errhandler'\n"); |
| 62 | + MPI_Info_get(MPI_INFO_ENV, "mpi_initial_errhandler", MPI_MAX_INFO_VAL, init_errh_info, &flag); |
| 63 | + if(flag) { |
| 64 | + print1(" MPI-4 COMPLIANT:\tMPI_INFO_ENV value set for key 'mpi_initial_errhandler' = %s\n\n", init_errh_info); |
| 65 | + } |
| 66 | + else { |
| 67 | + print1(" NOT MPI-4 COMPLIANT:\tMPI_INFO_ENV has no value set for key 'mpi_initial_errhandler'\n\n"); |
| 68 | + } |
| 69 | + |
| 70 | + print1("MPI_COMM_GET_ERRHANDLER:\n"); |
| 71 | + MPI_Comm_get_errhandler(MPI_COMM_SELF, &errh); |
| 72 | + if(MPI_ERRORS_RETURN == errh) { |
| 73 | + print1(" MPI-4 COMPLIANT:\tMPI_COMM_SELF error handler set to MPI_ERRORS_RETURN.\n\n"); |
| 74 | + } |
| 75 | + else |
| 76 | + if(MPI_ERRORS_ABORT == errh) { |
| 77 | + print1(" UNEXPECTED:\tMPI_COMM_SELF error handler set to MPI_ERRORS_ABORT.\n\n"); |
| 78 | + } |
| 79 | + else |
| 80 | + if(MPI_ERRORS_ARE_FATAL == errh) { |
| 81 | + print1(" NOT MPI-4 COMPLIANT:\tMPI_COMM_SELF error handler set to MPI_ERRORS_ARE_FATAL.\n\n"); |
| 82 | + } |
| 83 | + else { |
| 84 | + print1(" UNEXPECTED:\tMPI_COMM_SELF error handler is not one of the predefined ones.\n\n"); |
| 85 | + } |
| 86 | + |
| 87 | + sleep(1); |
| 88 | + |
| 89 | + MPI_Info_create(&spawn_info); |
| 90 | + MPI_Info_set(spawn_info, "mpi_initial_errhandler", "mpi_errors_return"); |
| 91 | + spawn_argv[0] = argv[0]; |
| 92 | + spawn_argv[1] = "preinit-error"; |
| 93 | + spawn_argv[2] = NULL; |
| 94 | + MPI_Comm_spawn(argv[0], &spawn_argv[1], 1, spawn_info, 0, MPI_COMM_WORLD, &icomm, spawn_err); |
| 95 | + |
| 96 | + /* wait for the spawnee completion before testing post-finalize error |
| 97 | + * handling */ |
| 98 | + MPI_Barrier(icomm); |
| 99 | + MPI_Comm_disconnect(&icomm); |
| 100 | + sleep(2); |
| 101 | + |
| 102 | + /* set error handler to fatal before FINALIZE */ |
| 103 | + rc = MPI_Comm_set_errhandler(MPI_COMM_SELF, MPI_ERRORS_ARE_FATAL); |
| 104 | + if(MPI_SUCCESS != rc) { |
| 105 | + MPI_Error_string(rc, estr, &slen); |
| 106 | + fprintf(stderr, " UNEXPECTED: An error occured during MPI_COMM_SETERRHANDLER(SELF) rc=%d: %s\n", rc, estr); |
| 107 | + return rc; |
| 108 | + } |
| 109 | + /* FINALIZE should force reversion to the initial errhandler, so we need to |
| 110 | + * check again (though we did not insert errors so all should go smooth). */ |
| 111 | + rc = MPI_Finalize(); |
| 112 | + if(MPI_SUCCESS != rc) { |
| 113 | + MPI_Error_string(rc, estr, &slen); |
| 114 | + fprintf(stderr, " UNEXPECTED: An error occured during MPI_FINALIZE rc=%d: %s\n", rc, estr); |
| 115 | + return rc; |
| 116 | + } |
| 117 | + |
| 118 | + printf("Post-finalize MPI_ERROR_STRING call:\n"); |
| 119 | + rc = MPI_Error_string(MPI_ERR_WIN, estr, &slen); |
| 120 | + if(MPI_SUCCESS != rc) { |
| 121 | + fprintf(stderr, " NOT MPI-4 COMPLIANT:\tpost-finalize MPI_ERROR_STRING returned %d (expected MPI_SUCCESS)\n", rc); |
| 122 | + } |
| 123 | + else if(0 == strcmp(estr, "NOT UPDATED")) { |
| 124 | + fprintf(stderr, " NOT MPI-4 COMPLIANT:\tpost-finalize MPI_ERROR_STRING did not set a valid string.\n"); |
| 125 | + } |
| 126 | + else { |
| 127 | + /* We can't further check if the error string makes sense; In any |
| 128 | + * case, any string is compliant, even low-quality non-informative |
| 129 | + * generic strings. So we just print it. */ |
| 130 | + printf(" MPI-4 COMPLIANT:\tpost-finalize MPI_ERROR_STRING for MPI_ERR_WIN: %s\n", estr); |
| 131 | + } |
| 132 | + return 0; |
| 133 | +} |
| 134 | + |
| 135 | +int main_child(int argc, char *argv[]) { |
| 136 | + int rank=0, rc; |
| 137 | + MPI_Comm icomm=MPI_COMM_NULL; |
| 138 | + int eclass=MPI_SUCCESS; |
| 139 | + char estr[MPI_MAX_ERROR_STRING]="NOT UPDATED"; int slen; |
| 140 | + |
| 141 | + /* ERROR_CLASS and ERROR_STRING are callable before MPI_INIT */ |
| 142 | + |
| 143 | + printf("Pre-init MPI_ERROR_CLASS call:\n"); |
| 144 | + rc = MPI_Error_class(MPI_ERR_WIN, &eclass); |
| 145 | + if(MPI_SUCCESS != rc) { |
| 146 | + fprintf(stderr, " NOT MPI-4 COMPLIANT:\tpre-init MPI_ERROR_CLASS returned %d (expected MPI_SUCCESS)\n", rc); |
| 147 | + } |
| 148 | + else if(MPI_ERR_WIN != eclass) { |
| 149 | + fprintf(stderr, " NOT MPI-4 COMPLIANT:\tpre-init MPI_ERROR_CLASS set eclass=%d (expected %d)\n", eclass, MPI_ERR_WIN); |
| 150 | + } |
| 151 | + else { |
| 152 | + printf(" MPI-4 COMPLIANT:\tPre-init MPI_ERROR_CLASS\n"); |
| 153 | + } |
| 154 | + |
| 155 | + print1("Pre-init MPI_ERROR_STRING call:\n"); |
| 156 | + rc = MPI_Error_string(MPI_ERR_WIN, estr, &slen); |
| 157 | + if(MPI_SUCCESS != rc) { |
| 158 | + fprintf(stderr, " NOT MPI-4 COMPLIANT:\tpre-init MPI_ERROR_STRING returned %d (expected MPI_SUCCESS)\n", rc); |
| 159 | + } |
| 160 | + else if(0 == strcmp(estr, "NOT UPDATED")) { |
| 161 | + fprintf(stderr, " NOT MPI-4 COMPLIANT:\tpre-init MPI_ERROR_STRING did not set a valid string.\n"); |
| 162 | + } |
| 163 | + else { |
| 164 | + /* We can't further check if the error string makes sense; In any |
| 165 | + * case, any string is compliant, even low-quality non-informative |
| 166 | + * generic strings. So we just print it. */ |
| 167 | + printf(" MPI-4 COMPLIANT:\tPre-init MPI_ERROR_STRING for MPI_ERR_WIN: %s\n", estr); |
| 168 | + } |
| 169 | + |
| 170 | + printf("Pre-init error in a call: compliant if it does not abort\n"); |
| 171 | + rc = MPI_Error_class(MPI_ERR_LASTCODE+1, &eclass); |
| 172 | + eclass = rc; |
| 173 | + rc = MPI_Error_string(eclass, estr, &slen); |
| 174 | + if(MPI_SUCCESS != rc) { |
| 175 | + printf(" MPI-4 COMPLIANT:\tPre-init MPI_ERROR_CLASS with erroneous arguments returned (LOW QUALITY: error code=%d caused error %d in MPI_ERROR_STRING).\n", eclass, rc); |
| 176 | + } |
| 177 | + else { |
| 178 | + printf(" MPI-4 COMPLIANT:\tPre-init MPI_ERROR_STRING for non-existing code returned %d: %s\n", eclass, estr); |
| 179 | + } |
| 180 | + |
| 181 | + printf("Initializing MPI and setting error handlers on predefined communicators.\n"); |
| 182 | + rc = MPI_Init(&argc, &argv); |
| 183 | + if(MPI_SUCCESS != rc) { |
| 184 | + MPI_Error_string(rc, estr, &slen); |
| 185 | + fprintf(stderr, " UNEXPECTED: An error occured during MPI_INIT rc=%d: %s\n", rc, estr); |
| 186 | + return rc; |
| 187 | + } |
| 188 | + |
| 189 | + /* sync-up with parent */ |
| 190 | + MPI_Comm_get_parent(&icomm); |
| 191 | + rc = MPI_Comm_set_errhandler(icomm, MPI_ERRORS_ARE_FATAL); |
| 192 | + if(MPI_SUCCESS != rc) { |
| 193 | + MPI_Error_string(rc, estr, &slen); |
| 194 | + fprintf(stderr, " UNEXPECTED: An error occured during MPI_COMM_SETERRHANDLER(PARENT) rc=%d: %s\n", rc, estr); |
| 195 | + return rc; |
| 196 | + } |
| 197 | + MPI_Barrier(icomm); |
| 198 | + MPI_Comm_disconnect(&icomm); |
| 199 | + |
| 200 | + MPI_Finalize(); |
| 201 | + return 0; |
| 202 | +} |
0 commit comments