Skip to content
Draft
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
50 changes: 49 additions & 1 deletion app/native-multi-image.F90
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,7 @@ program native_multi_image
#endif

#ifndef HAVE_COARRAY
#define HAVE_COARRAY 0
#define HAVE_COARRAY 1

Copy link
Copy Markdown
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Please revert this change to the default, which would break existing CI jobs for versions predating coarray support.

#endif
#ifndef HAVE_MAIN_COARRAY
#define HAVE_MAIN_COARRAY HAVE_COARRAY
Expand All @@ -67,6 +67,23 @@ program native_multi_image
#define HAVE_ALLOC_COARRAY HAVE_COARRAY
#endif

! coarray query intrinsics
#ifndef HAVE_COARRAY_QUERY
#define HAVE_COARRAY_QUERY HAVE_COARRAY
#endif
#ifndef HAVE_COBOUND
#define HAVE_COBOUND HAVE_COARRAY_QUERY
#endif
#ifndef HAVE_COSHAPE
#define HAVE_COSHAPE HAVE_COARRAY_QUERY
#endif
#ifndef HAVE_IMAGE_INDEX
#define HAVE_IMAGE_INDEX HAVE_COARRAY_QUERY
#endif
#ifndef HAVE_THIS_IMAGE_COARRAY
#define HAVE_THIS_IMAGE_COARRAY HAVE_COARRAY_QUERY
#endif

! Helper macros
#define CHECK_TYPE_COMPLIANCE(subject_type, subject, is_team, min_size) \
BLOCK ; \
Expand Down Expand Up @@ -190,6 +207,37 @@ program native_multi_image
write(*,'(A,I3)') "After END TEAM statement, TEAM_NUMBER() is ", TEAM_NUMBER()
# endif

# if HAVE_MAIN_COARRAY
# if HAVE_COBOUND
call status("Testing LCOBOUND/UCOBOUND...")
write(*,'(A,3I3)') "lcobound(sca_int_3) = ", LCOBOUND(sca_int_3)
write(*,'(A,3I3)') "ucobound(sca_int_3) = ", UCOBOUND(sca_int_3)
write(*,'(A,I3)') "lcobound(sca_int_3, dim=2) = ", LCOBOUND(sca_int_3, dim=2)
write(*,'(A,I3)') "ucobound(sca_int_3, dim=2) = ", UCOBOUND(sca_int_3, dim=2)
write(*,'(A,I3)') "lcobound(sca_int_3, dim=2, kind=8) = ", LCOBOUND(sca_int_3, dim=2, kind=8)
write(*,'(A,I3)') "ucobound(sca_int_3, dim=2, kind=8) = ", UCOBOUND(sca_int_3, dim=2, kind=8)
# endif
# if HAVE_COSHAPE
call status("Testing COSHAPE...")
write(*,'(A,3I3)') "coshape(sca_int_3) = ", COSHAPE(sca_int_3)
write(*,'(A,3I3)') "coshape(sca_int_3, kind=8) = ", COSHAPE(sca_int_3, kind=8)
# endif
# if HAVE_IMAGE_INDEX
call status("Testing IMAGE_INDEX...")
write(*,'(A,I3)') "image_index(sca_int_1, [1]) = ", IMAGE_INDEX(sca_int_1, [1])
# if HAVE_TEAM
write(*,'(A,I3)') "image_index(sca_int_1, [1], get_team()) = ", IMAGE_INDEX(sca_int_1, [1], GET_TEAM())

Copy link
Copy Markdown
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You reported in Slack this line appears to be crashing. I've seen some flang codegen bugs with TEAM_TYPE that have not been fully diagnosed and remain unresolved.

Until that's resolved, I'd suggest trying a temporary variable here

Suggested change
write(*,'(A,I3)') "image_index(sca_int_1, [1], get_team()) = ", IMAGE_INDEX(sca_int_1, [1], GET_TEAM())
res = GET_TEAM()
write(*,'(A,I3)') "image_index(sca_int_1, [1], get_team()) = ", IMAGE_INDEX(sca_int_1, [1], res)

write(*,'(A,I3)') "image_index(sca_int_1, [1], team_number=-1) = ", IMAGE_INDEX(sca_int_1, [1], TEAM_NUMBER=-1)
# endif
# endif
# if HAVE_THIS_IMAGE_COARRAY
call status("Testing THIS_IMAGE(coarray)...")
write(*,'(A,I3)') "this_image(sca_int_1) = ", THIS_IMAGE(sca_int_1)
write(*,'(A,3I3)') "this_image(sca_int_3) = ", THIS_IMAGE(sca_int_3)
write(*,'(A,I3)') "this_image(sca_int_3, dim=2) = ", THIS_IMAGE(sca_int_3, dim=2)
Comment on lines +235 to +237

Copy link
Copy Markdown
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

These three lines are the only new output that will be image-specific.

I suggest that all the new write statements but these be conditional on this_image()==1, so we don't get flooded with a bunch of duplicate output.

# endif
# endif

# if HAVE_EVENT_TYPE
CHECK_TYPE_COMPLIANCE(EVENT_TYPE, default_event, .false., 64)
# endif
Expand Down
Loading