1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
! -*- Mode: Fortran; -*-
!
! (C) 2003 by Argonne National Laboratory.
! See COPYRIGHT in top-level directory.
!
program main
use mpi_f08
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
|
