From mboxrd@z Thu Jan  1 00:00:00 1970
Return-Path: <gcc-bugzilla@gcc.gnu.org>
Received: by sourceware.org (Postfix, from userid 48)
	id 0E47A385B510; Fri, 17 Feb 2023 17:04:52 +0000 (GMT)
DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 0E47A385B510
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org;
	s=default; t=1676653492;
	bh=XGDV7rBGkwm8SKTIWV19SUpVmTVNmFPZPPHJ+O/3/Ug=;
	h=From:To:Subject:Date:From;
	b=PX1ZGbNwQ2f5/ox85ed2n3BCbchuCNkPEHFN4za8p6GZuxaOxnWkGK9DbzbOdoLHZ
	 EvsFKiQfb2fhmgvzY7tygKwP0gBoX3yiDmyLSS7vZVmidMttPZf/t7JMBhTYR4uw0Z
	 nrLsg7vLdhRnIeKgrO4rN9uOJ3O09R6HeSOzbxWw=
From: "burnus at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>
To: gcc-bugs@gcc.gnu.org
Subject: [Bug fortran/108838] New: [OpenMP] Array section of allocatable
 deferred-string has the wrong offset for the data component
Date: Fri, 17 Feb 2023 17:04:51 +0000
X-Bugzilla-Reason: CC
X-Bugzilla-Type: new
X-Bugzilla-Watch-Reason: None
X-Bugzilla-Product: gcc
X-Bugzilla-Component: fortran
X-Bugzilla-Version: 13.0
X-Bugzilla-Keywords: openmp, wrong-code
X-Bugzilla-Severity: normal
X-Bugzilla-Who: burnus at gcc dot gnu.org
X-Bugzilla-Status: UNCONFIRMED
X-Bugzilla-Resolution: 
X-Bugzilla-Priority: P3
X-Bugzilla-Assigned-To: unassigned at gcc dot gnu.org
X-Bugzilla-Target-Milestone: ---
X-Bugzilla-Flags: 
X-Bugzilla-Changed-Fields: bug_id short_desc product version bug_status
 keywords bug_severity priority component assigned_to reporter
 target_milestone
Message-ID: <bug-108838-4@http.gcc.gnu.org/bugzilla/>
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: quoted-printable
X-Bugzilla-URL: http://gcc.gnu.org/bugzilla/
Auto-Submitted: auto-generated
MIME-Version: 1.0
List-Id: <gcc-bugs.sourceware.org>

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=3D108838

            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=20
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 =3D (void *) &(*(character(kind=3D1)[0:][1:.astr] * restr=
ict)
                              astr.data)[4 - astr.dim[0].lbound];

which is identical to:
      parm.8.data =3D (void *) &(*(character(kind=3D1)[0:][1:.astr] * restr=
ict)
                               astr.data)[1];
and it sees as if '1:.astr' effectively is 0 as that would explain=20
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 oth=
er
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 declar=
ed
one).

* * *


character(len=3D:), allocatable :: astr(:)
allocate(character(len=3D6) :: 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) =3D "01db45"
!$omp target map(alloc: astr(4:5))
  if (.not. allocated(astr)) error stop
  if (len(astr) /=3D 6) error stop
  if (size(astr) /=3D 3) error stop
  if (lbound(astr, 1) /=3D 3) error stop
  if (ubound(astr, 1) /=3D 5) error stop
  astr(4:5) =3D ["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) /=3D 6) error stop
if (size(astr) /=3D 3) error stop
if (lbound(astr, 1) /=3D 3) error stop
if (ubound(astr, 1) /=3D 5) error stop
print '(">",a,"<")', astr
if (any (astr /=3D ["01db45", "jk$D%S", "zutg47"])) error stop
end=