Merge pull request #426 from sourceryinstitute/issue-411-really-fix

Really fix #411 on all mpi-installations reliably.

Author: zbeekman

CMakeLists.txt

@@ -595,8 +595,9 @@ if(opencoarrays_aware_compiler)
     add_mpi_test(get-put-alloc-comp 3 ${tests_root}/regression/reported/issue-422-send-get)
   endif()
 
+  add_mpi_test(allocatable_p2p_event_post 4 ${tests_root}/unit/events/allocatable_p2p_event_post)
   # Fixed GCC 7 regressions, should run on GCC 6 and 7
-  add_mpi_test(event-post 3 ${tests_root}/regression/reported/event-post)
+  add_mpi_test(static_event_post_issue_293 3 ${tests_root}/unit/events/static_event_post_issue_293)
 
   # These co_reduce (#172, fixed by PR #332, addl discussion in PR
   # #331) tests are for bugs not regressions. Should be fixed in all

src/mpi/mpi_caf.c

@@ -4454,39 +4454,36 @@ PREFIX (event_wait) (caf_token_t token, size_t index,
 		     int until_count, int *stat,
 		     char *errmsg, int errmsg_len)
 {
-  int ierr=0,count=0,i,image=caf_this_image-1;
-  int *var=NULL,flag,old=0;
-  int newval=0;
+  int ierr = 0, count = 0, i, image = caf_this_image - 1;
+  int *var = NULL, flag, old = 0;
+  int newval = 0;
   const int spin_loop_max = 20000;
   MPI_Win *p = TOKEN(token);
   const char msg[] = "Error on event wait";
 
   if(stat != NULL)
     *stat = 0;
 
-  MPI_Win_get_attr(*p,MPI_WIN_BASE,&var,&flag);
+  MPI_Win_get_attr (*p, MPI_WIN_BASE, &var, &flag);
 
   for(i = 0; i < spin_loop_max; ++i)
     {
-      MPI_Win_sync(*p);
+      MPI_Win_sync (*p);
       count = var[index];
       if(count >= until_count)
 	break;
     }
 
-  i=1;
+  i = 1;
   while(count < until_count)
-    /* for(i = 0; i < spin_loop_max; ++i) */
-      {
-	MPI_Win_sync(*p);
-	count = var[index];
-	/* if(count >= until_count) */
-	/*   break; */
-	usleep(10*i);
-	i++;
-	/* Needed to enforce MPI progress */
-	CAF_Win_unlock (image, *p);
-      }
+    {
+      MPI_Win_sync (*p);
+      count = var[index];
+      usleep (10 * i);
+	++i;
+      /* Needed to enforce MPI progress */
+      MPI_Win_flush (image, *p);
+    }
 
   newval = -until_count;
 

src/tests/regression/reported/CMakeLists.txt

@@ -13,9 +13,6 @@ target_link_libraries(source-alloc-sync OpenCoarrays)
 add_executable(convert-before-put issue-292-convert-type-before-put.f90)
 target_link_libraries(convert-before-put OpenCoarrays)
 
-add_executable(event-post issue-293-silent-event-failure.F90)
-target_link_libraries(event-post OpenCoarrays)
-
 add_executable(issue-422-send issue-422-send.F90)
 target_link_libraries(issue-422-send OpenCoarrays)
 

src/tests/unit/CMakeLists.txt

@@ -4,6 +4,7 @@ if (${opencoarrays_aware_compiler})
   add_subdirectory(init_register)
   add_subdirectory(collectives)
   add_subdirectory(sync)
+  add_subdirectory(events)
   if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7)
     add_subdirectory(fail_images)
   endif()

src/tests/unit/events/CMakeLists.txt

@@ -0,0 +1,8 @@
+# Fortran tests
+
+add_executable(allocatable_p2p_event_post allocatable_p2p_event_post.f90)
+target_link_libraries(allocatable_p2p_event_post OpenCoarrays)
+
+add_executable(static_event_post_issue_293 static_event_post_issue_293.f90)
+target_link_libraries(static_event_post_issue_293 OpenCoarrays)
+

src/tests/unit/events/allocatable_p2p_event_post.f90

@@ -0,0 +1,60 @@
+! BSD 3-Clause License
+!
+! Copyright (c) 2016, Sourcery Institute
+! All rights reserved.
+!
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+!
+! * Redistributions of source code must retain the above copyright notice, this
+!   list of conditions and the following disclaimer.
+!
+! * Redistributions in binary form must reproduce the above copyright notice,
+!   this list of conditions and the following disclaimer in the documentation
+!   and/or other materials provided with the distribution.
+!
+! * Neither the name of the copyright holder nor the names of its
+!   contributors may be used to endorse or promote products derived from
+!   this software without specific prior written permission.
+!
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+! Comments preceded by "!!" are formatted for the FORD docoumentation generator
+program allocatable_p2p_event_post
+  !! author: Andre Vehreschild
+  !! date: 2017-08-05
+  !! category: unit-test
+  !! Basic events test testing receipt of event post from one image to another
+  use iso_fortran_env, only: event_type
+  implicit none
+
+  type(event_type), allocatable :: snd_copied(:)[:]
+
+  if (num_images() < 4) error stop "num_images() >= 4 required for even_post_1 test"
+  associate(me => this_image(), np => num_images())
+    allocate(snd_copied(np)[*])
+    if (me == 2) print*,'I am  image 2, I am posting to 4'
+    if (me == 2) event post(snd_copied(2)[4])
+    if (me == 2) print*,' I am image 2, I have posted to 4'
+    if (me == 4) then
+      event wait(snd_copied(2))
+      sync all ! sync not required, but *may* expose cleanup issues/segfaults etc.
+      print *, 'Test passed.'
+    end if
+    if (me /= 4) then
+      sync all
+      print *, 'I am', me, 'and image 4 told me it received the event'
+    end if
+    if (allocated(snd_copied)) deallocate(snd_copied)
+  end associate
+end program
+! vim:ts=2:sts=2:sw=2:

src/tests/regression/reported/issue-293-silent-event-failure.F90 renamed to src/tests/unit/events/static_event_post_issue_293.f90

@@ -29,7 +29,7 @@
 ! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 ! Comments preceded by "!!" are formatted for the FORD docoumentation generator
-program main
+program static_event_post_issue_293
   !! author: Damian Rouson
   !! date: 2016-12-22
   !! category: regression
@@ -39,7 +39,7 @@ program main
   implicit none
   type(event_type) :: test_post[*]
 
-  if (num_images()<3) error stop "exposing issue 293 requires num_images()>=3"
+  if (num_images()<3) error stop "exposing issue 293 requires num_images() >= 3"
   event post(test_post)
   if (this_image()==1) print *,"Test passed."