Skip to content

Commit cac15cb

Browse files
author
Damian Rouson
committed
Issue #422: better error message & more unit tests
1 parent 71e9f4f commit cac15cb

File tree

7 files changed

+192
-9
lines changed

7 files changed

+192
-9
lines changed

‎CMakeLists.txt

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -585,6 +585,8 @@ if(opencoarrays_aware_compiler)
585585
add_mpi_test(co_reduce-factorial 4 ${tests_root}/regression/reported/co_reduce-factorial)
586586
add_mpi_test(co_reduce-factorial-int8 4 ${tests_root}/regression/reported/co_reduce-factorial-int8)
587587
add_mpi_test(co_reduce-factorial-int64 4 ${tests_root}/regression/reported/co_reduce-factorial-int64)
588+
add_mpi_test(put-alloc-comp 2 ${tests_root}/regression/reported/issue-422-send)
589+
add_mpi_test(get-put-alloc-comp 3 ${tests_root}/regression/reported/issue-422-send-get)
588590
add_mpi_test(co_reduce_string 4 ${tests_root}/unit/collectives/co_reduce_string)
589591

590592
# IMAGE FAIL tests

‎src/mpi/mpi_caf.c

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -595,7 +595,7 @@ void mutex_lock(MPI_Win win, int image_index, int index, int *stat,
595595
#endif
596596

597597
locking_atomic_op(win, &value, newval, compare, image_index, index);
598-
#ifdef WITH_FAILED_IMAGES
598+
#ifdef WITH_FAILED_IMAGES
599599
if (image_stati[value] == STAT_FAILED_IMAGE)
600600
{
601601
CAF_Win_lock (MPI_LOCK_EXCLUSIVE, image_index - 1, win);
@@ -613,7 +613,7 @@ void mutex_lock(MPI_Win win, int image_index, int index, int *stat,
613613
*stat = ierr;
614614
else if (ierr == STAT_FAILED_IMAGE)
615615
terminate_internal (ierr, 0);
616-
616+
617617
return;
618618

619619
stat_error:
@@ -659,7 +659,7 @@ void mutex_unlock(MPI_Win win, int image_index, int index, int *stat,
659659
*stat = ierr;
660660
else if(ierr == STAT_FAILED_IMAGE)
661661
terminate_internal (ierr, 0);
662-
662+
663663
return;
664664

665665
stat_error:
@@ -4436,7 +4436,7 @@ PREFIX (event_post) (caf_token_t token, size_t index,
44364436

44374437
if(!stat && ierr == STAT_FAILED_IMAGE)
44384438
terminate_internal (ierr, 0);
4439-
4439+
44404440
if(ierr != MPI_SUCCESS)
44414441
{
44424442
if(stat != NULL)
@@ -4496,7 +4496,7 @@ PREFIX (event_wait) (caf_token_t token, size_t index,
44964496

44974497
if(!stat && ierr == STAT_FAILED_IMAGE)
44984498
terminate_internal (ierr, 0);
4499-
4499+
45004500
if(ierr != MPI_SUCCESS)
45014501
{
45024502
if(stat != NULL)
@@ -4794,10 +4794,11 @@ unsupported_fail_images_message (const char * functionname)
47944794
void
47954795
unimplemented_alloc_comps_message (const char * functionname)
47964796
{
4797-
fprintf (stderr, "*** caf_mpi-lib runtime message on image %d:\n"
4798-
"*** The allocatable components feature '%s' of Fortran 2008 standard\n"
4799-
"*** is not yet supported by OpenCoarrays.\n",
4800-
caf_this_image, functionname);
4797+
fprintf (stderr,
4798+
"*** Message from libcaf_mpi runtime function '%s' on image %d:\n"
4799+
"*** Assigning to an allocatable coarray component of a derived type is not yet supported with GCC 7.\n"
4800+
"*** Either revert to GCC 6 or convert all puts (type(foo)::x; x%%y[recipient] = z) to gets (z = x%%y[provider]).\n",
4801+
functionname, caf_this_image );
48014802
#ifdef STOP_ON_UNSUPPORTED
48024803
exit (EXIT_FAILURE);
48034804
#endif

‎src/tests/regression/open/issue-422-send.f90

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
../reported/issue-422-send.f90

‎src/tests/regression/open/issue-422-sendget.f90

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
../reported/issue-422-sendget.f90

‎src/tests/regression/reported/CMakeLists.txt

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,3 +16,8 @@ target_link_libraries(convert-before-put OpenCoarrays)
1616
add_executable(event-post issue-293-silent-event-failure.F90)
1717
target_link_libraries(event-post OpenCoarrays)
1818

19+
add_executable(issue-422-send issue-422-send.f90)
20+
target_link_libraries(issue-422-send OpenCoarrays)
21+
22+
add_executable(issue-422-send-get issue-422-send-get.f90)
23+
target_link_libraries(issue-422-send-get OpenCoarrays)

‎src/tests/regression/reported/issue-422-send-get.f90

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
! BSD 3-Clause License
2+
!
3+
! Copyright (c) 2016, Sourcery Institute
4+
! All rights reserved.
5+
!
6+
! Redistribution and use in source and binary forms, with or without
7+
! modification, are permitted provided that the following conditions are met:
8+
!
9+
! * Redistributions of source code must retain the above copyright notice, this
10+
! list of conditions and the following disclaimer.
11+
!
12+
! * Redistributions in binary form must reproduce the above copyright notice,
13+
! this list of conditions and the following disclaimer in the documentation
14+
! and/or other materials provided with the distribution.
15+
!
16+
! * Neither the name of the copyright holder nor the names of its
17+
! contributors may be used to endorse or promote products derived from
18+
! this software without specific prior written permission.
19+
!
20+
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21+
! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22+
! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
23+
! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
24+
! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25+
! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26+
! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27+
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28+
! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29+
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30+
31+
program main
32+
!! author: Damian Rouson
33+
!! date: 2017-08-01
34+
!! category: regression
35+
!! Test whether assigning an allocatable coarray component to an allocatable
36+
!! coarray component works.
37+
!! OpenCoarrays issue #422
38+
use iso_fortran_env, only : error_unit
39+
implicit none
40+
41+
type foo
42+
!! A derived type is required to demonstrate issue #422
43+
integer, allocatable :: bar(:)[:]
44+
end type
45+
type(foo) :: foobar
46+
47+
enum, bind(C)
48+
enumerator :: recipient=1, provider, getter_putter
49+
end enum
50+
51+
integer, parameter :: bar_size=2
52+
53+
associate( me=>this_image(), N_images=>num_images(), required_images=>maxval([recipient,provider,getter_putter]) )
54+
55+
verify_num_images: if (N_images<required_images) then
56+
write(error_unit,*) "issue-422-send-get.f90 requires at least ",required_images," images"
57+
error stop
58+
end if verify_num_images
59+
60+
allocate(foobar%bar(bar_size)[*],source=me)
61+
!! Assign each image's identifier to each element of foobar%bar
62+
63+
get_put_component: if (me==getter_putter) then
64+
foobar%bar(:)[recipient] = foobar%bar(:)[provider]
65+
!! Get bar from provider image and put bar on recipient image
66+
sync images(recipient)
67+
!! Signal recipient that get and put have completed
68+
end if get_put_component
69+
70+
wait_and_verify: if (me==recipient) then
71+
sync images(getter_putter)
72+
!! Wait for signal from getter-putter
73+
74+
verify_result: if (any(foobar%bar/=provider)) then
75+
write(error_unit,*) "Recipient image ",recipient," received ",foobar%bar," but expected ",provider
76+
error stop
77+
end if verify_result
78+
79+
print *,"Test passed."
80+
!! Report success
81+
82+
end if wait_and_verify
83+
84+
end associate
85+
86+
end program

‎src/tests/regression/reported/issue-422-send.f90

Lines changed: 87 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,87 @@
1+
! BSD 3-Clause License
2+
!
3+
! Copyright (c) 2016, Sourcery Institute
4+
! All rights reserved.
5+
!
6+
! Redistribution and use in source and binary forms, with or without
7+
! modification, are permitted provided that the following conditions are met:
8+
!
9+
! * Redistributions of source code must retain the above copyright notice, this
10+
! list of conditions and the following disclaimer.
11+
!
12+
! * Redistributions in binary form must reproduce the above copyright notice,
13+
! this list of conditions and the following disclaimer in the documentation
14+
! and/or other materials provided with the distribution.
15+
!
16+
! * Neither the name of the copyright holder nor the names of its
17+
! contributors may be used to endorse or promote products derived from
18+
! this software without specific prior written permission.
19+
!
20+
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21+
! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22+
! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
23+
! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
24+
! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25+
! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26+
! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27+
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28+
! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29+
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30+
31+
program main
32+
!! author: Damian Rouson
33+
!! date: 2017-08-01
34+
!! category: regression
35+
!! Test whether assigning an allocatable coarray component to an allocatable
36+
!! coarray component works.
37+
!! OpenCoarrays issue #422
38+
use iso_fortran_env, only : error_unit
39+
implicit none
40+
41+
type foo
42+
!! A derived type is required to demonstrate issue #422
43+
integer, allocatable :: bar(:)[:]
44+
end type
45+
type(foo) :: foobar
46+
47+
enum, bind(C)
48+
enumerator :: recipient=1, provider
49+
end enum
50+
51+
integer, parameter :: message(*)=[3,4]
52+
!! Data for provider image to put on recipient image
53+
54+
associate( me=>this_image(), N_images=>num_images(), required_images=>maxval([recipient,provider]) )
55+
56+
verify_num_images: if (N_images<required_images) then
57+
write(error_unit,*) "issue-422-send.f90 requires at least ",required_images," images"
58+
error stop
59+
end if verify_num_images
60+
61+
allocate(foobar%bar(size(message))[*],source=me)
62+
!! Assign each image's identifier to each element of foobar%bar
63+
64+
get_put_component: if (me==provider) then
65+
foobar%bar(:)[recipient] = message
66+
!! Get bar from provider image and put bar on recipient image
67+
sync images(recipient)
68+
!! Signal recipient that get and put have completed
69+
end if get_put_component
70+
71+
wait_and_verify: if (me==recipient) then
72+
sync images(provider)
73+
!! Wait for signal from provider image
74+
75+
verify_result: if (any(foobar%bar/=message)) then
76+
write(error_unit,*) "Recipient image ",recipient," received ",foobar%bar," but expected ",provider
77+
error stop
78+
end if verify_result
79+
80+
print *,"Test passed."
81+
!! Report success
82+
83+
end if wait_and_verify
84+
85+
end associate
86+
87+
end program

0 commit comments

Comments
 (0)