module Test_DirectoryService use pfunit use pFIO_AbstractDirectoryServiceMod use pFIO_DirectoryServiceMod use pFIO_AbstractSocketMod use pFIO_AbstractSocketVectorMod use pFIO_MpiSocketMod use MockServerMod use MockClientMod implicit none contains @test(npes=[1]) subroutine test_put_directory(this) class (MpiTestMethod), intent(inout) :: this type (DirectoryService) :: ds integer :: comm integer :: win type (Directory) :: dir, dir2 comm = this%getMpiCommunicator() ds = DirectoryService(comm) dir%num_entries = 1 dir%entries(1) = DirectoryEntry('foo', 1) win = ds%get_win('server_directory') call ds%put_directory(dir, win) dir2 = ds%get_directory(win) @assertEqual(dir%num_entries, dir2%num_entries) @assertEqual(dir%entries(1)%port_name, dir%entries(1)%port_name) @assertEqual(dir%entries(1)%partner_root_rank, dir%entries(1)%partner_root_rank) call ds%free_directory_resources() end subroutine test_put_directory @test(npes=[1]) subroutine test_publish(this) class (MpiTestMethod), intent(inout) :: this type (DirectoryService) :: ds integer :: comm type (MockServer) :: mock_server comm = this%getMpiCommunicator() ds = DirectoryService(comm) mock_server = MockServer(comm) call ds%publish(PortInfo('service', mock_server), mock_server) call ds%free_directory_resources() end subroutine test_publish @test(npes=[2]) subroutine test_connect(this) class (MpiTestMethod), intent(inout) :: this type (DirectoryService) :: ds integer :: comm integer :: color, key, ierror type (MockServer), target :: mock_server type (MockClient) :: mock_client ds = DirectoryService(this%getMpiCommunicator()) color = this%getProcessRank() key = 0 call MPI_Comm_split(this%getMpiCommunicator(), color, key, comm, ierror) @assertEqual(0, ierror) select case (this%getProcessRank()) case (0) ! server mock_server = MockServer(comm) call ds%publish(PortInfo('input', mock_server), mock_server) call ds%connect_to_client('input', mock_server) case (1) ! client mock_client = MockClient() call ds%connect_to_server('input', mock_client, comm) end select !C$ select type (s) !C$ type is (MpiSocket) !C$ class default !C$ @assertTrue(.false.) !C$ end select call ds%free_directory_resources() end subroutine test_connect @test(npes=[2]) subroutine test_connect_swap_role(this) class (MpiTestMethod), intent(inout) :: this type (DirectoryService) :: ds integer :: comm integer :: color, key, ierror type (MockServer) :: mock_server type (MockClient) :: mock_client ds = DirectoryService(this%getMpiCommunicator()) color = this%getProcessRank() key = 0 call MPI_Comm_split(this%getMpiCommunicator(), color, key, comm, ierror) @assertEqual(0, ierror) select case (this%getProcessRank()) case (1) ! server mock_server = MockServer(comm) call ds%publish(PortInfo('input', mock_server), mock_server) call ds%connect_to_client('input', mock_server) case (0) ! client mock_client = MockClient() call ds%connect_to_server('input', mock_client, comm) end select !C$ select type (s) !C$ type is (MpiSocket) !C$ class default !C$ @assertTrue(.false.) !C$ end select !C$ call ds%free_directory_resources() end subroutine test_connect_swap_role ! 3 clients, 2 servers @test(npes=[5]) subroutine test_connect_multi(this) class (MpiTestMethod), intent(inout) :: this type (DirectoryService) :: ds integer :: comm integer :: ierror integer :: color, key type (MockServer) :: mock_server type (MockClient) :: mock_client ds = DirectoryService(this%getMpiCommunicator()) color = this%getProcessRank()/3 key = 0 call MPI_Comm_split(this%getMpiCommunicator(), color, key, comm, ierror) @assertEqual(0, ierror) select case (color) case (1) ! server mock_server = MockServer(comm) call ds%publish(PortInfo('input', mock_server), mock_server) select case (this%getProcessRank()) case (3) ! have one call ds%connect_to_client('input', mock_server) case (4) call ds%connect_to_client('input', mock_server) end select case (0) ! client mock_client = MockClient() call ds%connect_to_server('input', mock_client, comm) end select call ds%free_directory_resources() end subroutine test_connect_multi ! 3 clients, 2 servers, 1 unused ! Just making sure that there is no implicit assumption that a process ! is always involved in either a client or a server. @test(npes=[6]) subroutine test_connect_with_unused_process(this) class (MpiTestMethod), intent(inout) :: this type (DirectoryService) :: ds integer :: comm integer :: color, key integer :: ierror type (MockServer) :: mock_server type (MockClient) :: mock_client ds = DirectoryService(this%getMpiCommunicator()) if (this%getProcessRank() == 3) then color = 5 else color = this%getProcessRank()/3 key = 0 end if call MPI_Comm_split(this%getMpiCommunicator(), color, key, comm, ierror) @assertEqual(0, ierror) select case (color) case (1) ! server mock_server = MockServer(comm) call ds%publish(PortInfo('input', mock_server), mock_server) select case (this%getProcessRank()) case (4) ! have one call ds%connect_to_client('input', mock_server) case (5) call ds%connect_to_client('input', mock_server) end select case (0) ! client mock_client = MockClient() call ds%connect_to_server('input', mock_client, comm) end select call ds%free_directory_resources() end subroutine test_connect_with_unused_process ! 4 clients, 2 servers @test(npes=[8]) subroutine test_stress(this) class (MpiTestMethod), intent(inout) :: this type (DirectoryService) :: ds integer :: comm integer :: color, key type (MockServer) :: mock_server type (MockClient) :: mock_client integer :: ierror ds = DirectoryService(this%getMpiCommunicator()) select case (this%getProcessRank()) case (0:3) color = 0 ! client case (4:5) ! none color = 2 case (6:7) color = 1 ! server end select key = 0 call MPI_Comm_split(this%getMpiCommunicator(), color, key, comm, ierror) @assertEqual(0, ierror) select case (color) case (1) ! server mock_server = MockServer(comm) call ds%publish(portInfo('input', mock_server), mock_server) call ds%connect_to_client('input', mock_server) case (0) ! client mock_client = MockClient() call ds%connect_to_server('input', mock_client, comm) end select call ds%free_directory_resources() end subroutine test_stress end module Test_DirectoryService