Blob Blame History Raw
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 )
      end