! This file created from f77/spawn/namepubf.f with f77tof90
! -*- Mode: Fortran; -*-
!
! (C) 2003 by Argonne National Laboratory.
! See COPYRIGHT in top-level directory.
!
program main
use mpi
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 )
! Note that according to the MPI standard, port_name must
! have been created by MPI_Open_port. For current testing
! purposes, we'll use a fake name. This test should eventually use
! 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
! 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 )
end