Change interfaces for gcc-trunk and testcases

vehre · zbeekman · commit d510348eabf9 · 2016-12-13T20:09:56.000-05:00
libcaf.h/mpi_caf.c: ------------------- Changed the library API to needs of gcc-7 by adding the new constants for caf_register and caf_deregister. Changing the interface of caf_deregster to take the dereg mode and adding the prototype for caf_is_present(). The inquiry function caf_is_present() is available as protoype only and error stops as unimplemented when called. tests/unit/init_register/*rename_me*: ------------------------------------- Renaming to reasonable filename done. tests/unit/init_register/register_alloc_comp_[1-3].f90: ------------------------------------------------------- Testing that allocation of (scalar|vector|matrix) components works. src/tests/unit/init_register/check_remote_alloced_comp_1.f90: ------------------------------------------------------------- Testing that asynchronous allocation of scalar components works. The test fails/hangs for two reasons at the moment: 1. caf_register is not asynchronously allocation components, 2. caf_is_present is not implemented and is therefore deactivated in the testsection of the main CMakeLists.txt CMakeLists.txt: --------------- Added testcases. (cherry picked from commit e3dba75 and commit ca76a39, and then these two were squashed. All code done by Andre/@vehre and original commit messages tidied by @zbeekman)
diff --git a/CMakeLists.txt b/CMakeLists.txt
@@ -360,10 +360,14 @@ if(opencoarrays_aware_compiler)
   # Unit tests targeting each libcaf_mpi function, argument, and branch of code
   add_mpi_test(initialize_mpi 2 ${tests_root}/unit/init_register/initialize_mpi)
   add_mpi_test(register 2 ${tests_root}/unit/init_register/register)
-  add_mpi_test(register_rename_me 2 ${tests_root}/unit/init_register/register_rename_me)
-  add_mpi_test(register_rename_me_too 2 ${tests_root}/unit/init_register/register_rename_me_too)
+  add_mpi_test(register_vector 2 ${tests_root}/unit/init_register/register_vector)
+  add_mpi_test(register_alloc_vector 2 ${tests_root}/unit/init_register/register_alloc_vector)
+  add_mpi_test(register_alloc_comp_1 2 ${tests_root}/unit/init_register/register_alloc_comp_1)
+  add_mpi_test(register_alloc_comp_2 2 ${tests_root}/unit/init_register/register_alloc_comp_2)
+  add_mpi_test(register_alloc_comp_3 2 ${tests_root}/unit/init_register/register_alloc_comp_3)
   add_mpi_test(allocate_as_barrier 2 ${tests_root}/unit/init_register/allocate_as_barrier)
   add_mpi_test(allocate_as_barrier_proc 32 ${tests_root}/unit/init_register/allocate_as_barrier_proc)
+#  add_mpi_test(check_remote_alloced_comp_1 6 ${tests_root}/unit/init_register/check_remote_alloced_comp_1)
   add_mpi_test(get_array 2 ${tests_root}/unit/send-get/get_array)
   add_mpi_test(get_self 2 ${tests_root}/unit/send-get/get_self)
   add_mpi_test(send_array 2 ${tests_root}/unit/send-get/send_array)
diff --git a/src/libcaf.h b/src/libcaf.h
@@ -242,9 +242,10 @@ void PREFIX(sendget_by_ref) (caf_token_t dst_token, int dst_image_index,
 		caf_reference_t *dst_refs, caf_token_t src_token, int src_image_index,
 		caf_reference_t *src_refs, int dst_kind, int src_kind,
 		bool may_require_tmp, int *dst_stat, int *src_stat);
+int PREFIX(is_present) (caf_token_t, int, caf_reference_t *refs);
 #endif
 
-void PREFIX (co_broadcast) (gfc_descriptor_t *, int, int *, char *, int);			    
+void PREFIX (co_broadcast) (gfc_descriptor_t *, int, int *, char *, int);
 void PREFIX (co_max) (gfc_descriptor_t *, int, int *, char *, int, int);
 void PREFIX (co_min) (gfc_descriptor_t *, int, int *, char *, int, int);
 void PREFIX (co_reduce) (gfc_descriptor_t *, void *(*opr) (void *, void *),
diff --git a/src/mpi/mpi_caf.c b/src/mpi/mpi_caf.c
@@ -535,13 +535,11 @@ PREFIX (register) (size_t size, caf_register_t type, caf_token_t *token,
 
   mpi_caf_token_t *mpi_token;
   MPI_Win *p;
-  if (!(type == CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY
-        || (type == CAF_REGTYPE_COARRAY_ALLOC && *token != NULL)))
+  if (type != CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY)
     *token = malloc (sizeof (mpi_caf_token_t));
 
   mpi_token = (mpi_caf_token_t *) *token;
   p = TOKEN(mpi_token);
-  fprintf (stderr, "%d: _caf_register(type = %d, token = %p)!\n", caf_this_image, type, *token);
 
   if (type == CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY
       || type == CAF_REGTYPE_COARRAY_ALLOC
@@ -564,8 +562,6 @@ PREFIX (register) (size_t size, caf_register_t type, caf_token_t *token,
 #if MPI_VERSION >= 3
   if (type != CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY)
     {
-      fprintf (stderr, "%d: Adding memory to token %p, desc = %p.\n",
-	       caf_this_image, token, mpi_token->desc);
       MPI_Win_allocate (actual_size, 1, MPI_INFO_NULL, CAF_COMM_WORLD, &mem, p);
       CAF_Win_lock_all (*p);
     }
@@ -588,7 +584,7 @@ PREFIX (register) (size_t size, caf_register_t type, caf_token_t *token,
 
   if (type != CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY)
     {
-      PREFIX(sync_all) (NULL,NULL,0);
+//      PREFIX(sync_all) (NULL,NULL,0);
 
       caf_static_t *tmp = malloc (sizeof (caf_static_t));
       tmp->prev  = caf_tot;
@@ -641,11 +637,11 @@ PREFIX (register) (size_t size, caf_register_t type, caf_token_t *token,
 #ifdef COMPILER_SUPPORTS_CAF_INTRINSICS
 void *
   _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
-                int *stat, char *errmsg, int errmsg_len)
+                          int *stat, char *errmsg, int errmsg_len)
 #else
 void *
   PREFIX (register) (size_t size, caf_register_t type, caf_token_t *token,
-                int *stat, char *errmsg, int errmsg_len)
+                     int *stat, char *errmsg, int errmsg_len)
 #endif
 {
   /* int ierr; */
@@ -764,8 +760,6 @@ PREFIX (deregister) (caf_token_t *token, int *stat, char *errmsg, int errmsg_len
 {
   /* int ierr; */
 
-  fprintf (stderr, "%d: deregistering token = %p, type = %d.\n", caf_this_image,
-	   *token, type);
   if (unlikely (caf_is_finalized))
     {
       const char msg[] = "Failed to deallocate coarray - "
@@ -2979,6 +2973,14 @@ PREFIX(sendget_by_ref) (caf_token_t dst_token, int dst_image_index,
   fprintf (stderr, "COARRAY ERROR: caf_sendget_by_ref() not implemented yet ");
   error_stop (1);
 }
+
+
+int
+PREFIX(is_present) (caf_token_t token, int image_index, caf_reference_t *refs)
+{
+  fprintf (stderr, "COARRAY ERROR: caf_is_present() not implemented yet ");
+  error_stop (1);
+}
 #endif
 
 
diff --git a/src/tests/unit/init_register/CMakeLists.txt b/src/tests/unit/init_register/CMakeLists.txt
@@ -4,14 +4,26 @@ target_link_libraries(initialize_mpi OpenCoarrays)
 add_executable(register register.f90)
 target_link_libraries(register OpenCoarrays)
 
-add_executable(register_rename_me register_rename_me.f90)
-target_link_libraries(register_rename_me OpenCoarrays)
+add_executable(register_vector register_vector.f90)
+target_link_libraries(register_vector OpenCoarrays)
 
-add_executable(register_rename_me_too register_rename_me_too.f90)
-target_link_libraries(register_rename_me_too OpenCoarrays)
+add_executable(register_alloc_vector register_alloc_vector.f90)
+target_link_libraries(register_alloc_vector OpenCoarrays)
+
+add_executable(register_alloc_comp_1 register_alloc_comp_1.f90)
+target_link_libraries(register_alloc_comp_1 OpenCoarrays)
+
+add_executable(register_alloc_comp_2 register_alloc_comp_2.f90)
+target_link_libraries(register_alloc_comp_2 OpenCoarrays)
+
+add_executable(register_alloc_comp_3 register_alloc_comp_3.f90)
+target_link_libraries(register_alloc_comp_3 OpenCoarrays)
 
 add_executable(allocate_as_barrier allocate_as_barrier.f90)
 target_link_libraries(allocate_as_barrier OpenCoarrays)
 
 add_executable(allocate_as_barrier_proc allocate_as_barrier_proc.f90)
 target_link_libraries(allocate_as_barrier_proc OpenCoarrays)
+
+add_executable(check_remote_alloced_comp_1 check_remote_alloced_comp_1.f90)
+target_link_libraries(check_remote_alloced_comp_1 OpenCoarrays)
diff --git a/src/tests/unit/init_register/check_remote_alloced_comp_1.f90 b/src/tests/unit/init_register/check_remote_alloced_comp_1.f90
@@ -0,0 +1,87 @@
+! Unit test for register procedure and remote allocated test.
+!
+! Test that scalar allocatable component in a derived typed coarray is
+! registered correctly, delayed allocatable and deregisterable. The checks
+! whether the component is allocated are done on the remote images.
+!
+! Copyright (c) 2012-2016, Sourcery, Inc.
+! 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 Sourcery, Inc., 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 SOURCERY, INC., 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.
+
+program check_remote_alloced_comp_1
+  implicit none
+
+  type dt
+    integer, allocatable :: i
+  end type dt
+
+  integer :: np = -2, me, remote, test
+  type(dt), allocatable :: obj[:]
+
+  np = num_images()
+  me = this_image()
+
+  ! Make sure that at least two images are available. This might not be
+  ! necessary, but simplyfies writing the test.
+  if (np < 2) error stop "Test failed. Need more than one image."
+
+  ! Allocate only the container. obj%i must not be allocated hereafter.
+  allocate(obj[*])
+  if (.not. allocated(obj)) error stop "Test failed. 'obj' not allocated."
+  if (allocated(obj%i)) error stop "Test failed. 'obj%i' is allocated."
+
+  ! The print statements are in for debugging purposes only.
+
+  ! All images have allocated the container. Now iterate over the images and
+  ! when this image's number is equal to remote, allocate the component,
+  ! else check the allocation status of all other remote components.
+  do remote = 1, np
+    print *, me, "/", np, ": remote=", remote
+    if (remote == me) then
+      print *, me, "/", np, ": allocating..."
+      allocate(obj%i, source = me)
+      print *, me, "/", np, ": allocated"
+      ! Now both objects have to be allocated and obj%i set to this_image()
+      if (.not. allocated(obj)) error stop "Test failed. 'obj' not allocated."
+      if (.not. allocated(obj%i)) error stop "Test failed. 'obj%i' not allocated."
+      if (obj%i /= me) error stop "Test failed. obj%i /= this_image()."
+      sync all
+    else
+      sync all
+      ! Iterate using test over the images to test:
+      ! when test less or equal than remote, check that the remote image's
+      !            component given by test is allocated,
+      ! else check that the remote component is not yet allocated.
+      do test = 1, np
+        print *, me, "/", np, ": Checking", test, " for allocation status."
+        if (test > remote) then
+          if (allocated(obj[test]%i)) error stop "Test failed. 'obj%i' on remote image already allocated."
+        else
+          if (.not. allocated(obj[test]%i)) error stop "Test failed. 'obj%i' on remote image not allocated."
+        end if
+      end do
+    end if
+  enddo
+end program
+
diff --git a/src/tests/unit/init_register/register_alloc_comp_1.f90 b/src/tests/unit/init_register/register_alloc_comp_1.f90
@@ -0,0 +1,74 @@
+! Unit test for register and allocated procedure.
+!
+! Test that scalar allocatable component in a derived typed coarray is
+! registered correctly, delayed allocatable and deregisterable. The checks
+! whether a component is allocated are done on this_image only.
+!
+! Copyright (c) 2012-2016, Sourcery, Inc.
+! 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 Sourcery, Inc., 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 SOURCERY, INC., 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.
+
+program register_alloc_comp_1
+  implicit none
+
+  type dt
+    integer, allocatable :: i
+  end type dt
+
+  integer :: np = -2
+  type(dt), allocatable :: obj[:]
+
+  np = num_images()
+
+  ! Allocate only the container. obj%i must not be allocated hereafter.
+  allocate(obj[*])
+  if (.not. allocated(obj)) error stop "Test failed. 'obj' not allocated."
+  if (allocated(obj%i)) error stop "Test failed. 'obj%i' is allocated."
+
+  ! Allocate the component.
+  allocate(obj%i, source=this_image())
+
+  ! Now both objects have to be allocated and obj%i set to this_image()
+  if (.not. allocated(obj)) error stop "Test failed. 'obj' not allocated."
+  if (.not. allocated(obj%i)) error stop "Test failed. 'obj%i' not allocated."
+  if (obj%i /= this_image()) error stop "Test failed. obj%i /= this_image()."
+
+  ! Deallocate the component.
+  deallocate(obj%i)
+
+  ! and test, that only the component is deallocated, but not the container.
+  if (allocated(obj%i)) error stop "Test failed. 'obj%i' still allocated."
+  if (.not. allocated(obj)) error stop "Test failed. 'obj' no longer allocated."
+
+  ! Now deallocate the container, too.
+  deallocate(obj)
+
+  ! and check, that it worked.
+  if (allocated(obj)) error stop "Test failed. 'obj' still allocated."
+
+  ! Failing tests would make whole program error out.  Therefore it is save
+  ! to print the pass message on image one, only.
+  if (this_image() == 1) print *, "Test passed."
+end program
+
diff --git a/src/tests/unit/init_register/register_alloc_comp_2.f90 b/src/tests/unit/init_register/register_alloc_comp_2.f90
@@ -0,0 +1,74 @@
+! Unit test for register and allocated procedure.
+!
+! Test that vector valued allocatable components in a derived typed coarray is
+! registered correctly, delayed allocatable and deregisterable. The checks
+! whether a component is allocated are done on this_image only.
+!
+! Copyright (c) 2012-2016, Sourcery, Inc.
+! 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 Sourcery, Inc., 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 SOURCERY, INC., 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.
+
+program register_alloc_comp_2
+  implicit none
+
+  type dt
+    integer, allocatable, dimension(:) :: v
+  end type dt
+
+  integer :: np = -2
+  type(dt), allocatable :: obj[:]
+
+  np = num_images()
+
+  ! Allocate only the container. obj%v must not be allocated hereafter.
+  allocate(obj[*])
+  if (.not. allocated(obj)) error stop "Test failed. 'obj' not allocated."
+  if (allocated(obj%v)) error stop "Test failed. 'obj%v' is allocated."
+
+  ! Allocate the component and initialize it with this_image()
+  allocate(obj%v(5), source=this_image())
+
+  ! Now both objects have to be allocated and obj%v(1:5) set to this_image()
+  if (.not. allocated(obj)) error stop "Test failed. 'obj' not allocated."
+  if (.not. allocated(obj%v)) error stop "Test failed. 'obj%v' not allocated."
+  if (any (obj%v(:) /= this_image())) error stop "Test failed. obj%v(:) /= this_image()."
+
+  ! Deallocate the component.
+  deallocate(obj%v)
+
+  ! and test, that only the component is deallocated, but not the container.
+  if (allocated(obj%v)) error stop "Test failed. 'obj%v' still allocated."
+  if (.not. allocated(obj)) error stop "Test failed. 'obj' no longer allocated."
+
+  ! Now deallocate the container, too.
+  deallocate(obj)
+
+  ! and check, that it worked.
+  if (allocated(obj)) error stop "Test failed. 'obj' still allocated."
+
+  ! Failing tests would make whole program error out.  Therefore it is save
+  ! to print the pass message on image one, only.
+  if (this_image() == 1) print *, "Test passed."
+end program
+
diff --git a/src/tests/unit/init_register/register_alloc_comp_3.f90 b/src/tests/unit/init_register/register_alloc_comp_3.f90
diff --git a/src/tests/unit/init_register/register_alloc_vector.f90 b/src/tests/unit/init_register/register_alloc_vector.f90
diff --git a/src/tests/unit/init_register/register_vector.f90 b/src/tests/unit/init_register/register_vector.f90
