https://gcc.gnu.org/bugzilla/show_bug.cgi?id=108838
Bug ID: 108838
Summary: [OpenMP] Array section of allocatable deferred-string
has the wrong offset for the data component
Product: gcc
Version: 13.0
Status: UNCONFIRMED
Keywords: openmp, wrong-code
Severity: normal
Priority: P3
Component: fortran
Assignee: unassigned at gcc dot gnu.org
Reporter: burnus at gcc dot gnu.org
Target Milestone: ---
The following program fails. Looking at the address passed to
GOMP_target_enter_exit_data, it has the address of 'astr(3)' not of 'astr(4)'
as expected.
(Looks vaguely related to issue PR 108837, but internally different.)
The dump shows:
parm.8.data = (void *) &(*(character(kind=1)[0:][1:.astr] * restrict)
astr.data)[4 - astr.dim[0].lbound];
which is identical to:
parm.8.data = (void *) &(*(character(kind=1)[0:][1:.astr] * restrict)
astr.data)[1];
and it sees as if '1:.astr' effectively is 0 as that would explain
the offset of 0. Probably, we want to use the array syntax only if
the UNIT_SIZE is either a constant or a SAVE_EXPR but not if it is some other
expression.
Or in other words: We probably do not want to use the array syntax for
deferred strings.
I wonder whether it will work with CLASS which has the
same issue (int the case the dynamic type has more components as the declared
one).
* * *
character(len=:), allocatable :: astr(:)
allocate(character(len=6) :: astr(3:5))
print '(z16,a)', loc(astr), ' astr'
print '(z16,a)', loc(astr(4)), ' astr4'
!$omp target enter data map(alloc: astr(4:5))
astr(3) = "01db45"
!$omp target map(alloc: astr(4:5))
if (.not. allocated(astr)) error stop
if (len(astr) /= 6) error stop
if (size(astr) /= 3) error stop
if (lbound(astr, 1) /= 3) error stop
if (ubound(astr, 1) /= 5) error stop
astr(4:5) = ["jk$D%S", "zutg47"]
!$omp end target
!$omp target exit data map(from: astr(4:5))
if (.not. allocated(astr)) error stop
if (len(astr) /= 6) error stop
if (size(astr) /= 3) error stop
if (lbound(astr, 1) /= 3) error stop
if (ubound(astr, 1) /= 5) error stop
print '(">",a,"<")', astr
if (any (astr /= ["01db45", "jk$D%S", "zutg47"])) error stop
end
