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 errs character*(MPI_MAX_PORT_NAME) port_name character*(MPI_MAX_PORT_NAME) port_name_out character*(256) serv_name integer merr, mclass character*(MPI_MAX_ERROR_STRING) errmsg integer msglen, rank integer ierr errs = 0 call MTest_Init( ierr ) call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierr ) C Note that according to the MPI standard, port_name must C have been created by MPI_Open_port. For current testing C purposes, we'll use a fake name. This test should eventually use C a valid name from Open_port port_name = 'otherhost:122' serv_name = 'MyTest' call MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN, $ ierr ) if (rank .eq. 0) then merr = -1 call MPI_Publish_name( serv_name, MPI_INFO_NULL, port_name, $ merr ) if (merr .ne. MPI_SUCCESS) then errs = errs + 1 call MPI_Error_string( merr, errmsg, msglen, ierr ) print *, "Error in Publish_name ", errmsg(1:msglen) endif call MPI_Barrier(MPI_COMM_WORLD, ierr ) call MPI_Barrier(MPI_COMM_WORLD, ierr ) merr = -1 call MPI_Unpublish_name( serv_name, MPI_INFO_NULL, port_name, $ merr) if (merr .ne. MPI_SUCCESS) then errs = errs + 1 call MPI_Error_string( merr, errmsg, msglen, ierr ) print *, "Error in Unpublish name ", errmsg(1:msglen) endif else call MPI_Barrier(MPI_COMM_WORLD, ierr ) merr = -1 call MPI_Lookup_name( serv_name, MPI_INFO_NULL, port_name_out, $ merr) if (merr .ne. MPI_SUCCESS) then errs = errs + 1 call MPI_Error_string( merr, errmsg, msglen, ierr ) print *, "Error in Lookup name", errmsg(1:msglen) else if (port_name .ne. port_name_out) then errs = errs + 1 print *, "Lookup name returned the wrong value (", $ port_name_out, "), expected (", port_name, ")" endif endif call MPI_Barrier(MPI_COMM_WORLD, ierr ) endif call MPI_Barrier(MPI_COMM_WORLD, ierr ) merr = -1 call MPI_Lookup_name( serv_name, MPI_INFO_NULL, port_name_out, $ merr ) if (merr .eq. MPI_SUCCESS) then errs = errs + 1 print *, "Lookup name returned name after it was unpublished" else C Must be class MPI_ERR_NAME call MPI_Error_class( merr, mclass, ierr ) if (mclass .ne. MPI_ERR_NAME) then errs = errs + 1 call MPI_Error_string( merr, errmsg, msglen, ierr ) print *, "Lookup name returned the wrong error class $ (",mclass,"), msg ", errmsg endif endif call MTest_Finalize( errs ) call MPI_Finalize( ierr ) end