procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran: fix TARGET attribute of associating entity in ASSOCIATE [PR112764]

Browse source 
The associating entity in an ASSOCIATE construct has the TARGET attribute
if and only if the selector is a variable and has either the TARGET or
POINTER attribute (e.g. F2018:11.1.3.3).

gcc/fortran/ChangeLog:

	PR fortran/112764
	* primary.cc (gfc_variable_attr): Set TARGET attribute of associating
	entity dependent on TARGET or POINTER attribute of selector.

gcc/testsuite/ChangeLog:

	PR fortran/112764
	* gfortran.dg/associate_62.f90: New test.
This commit is contained in:
Harald Anlauf 2023-11-29 21:47:24 +01:00
parent 2dde9f326d
commit 951a3e3749
2 changed files with 41 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
gcc/fortran/primary.cc
View file

@ -2653,6 +2653,22 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
if (pointer || attr.proc_pointer)
target = 1;
/* F2018:11.1.3.3: Other attributes of associate names
"The associating entity does not have the ALLOCATABLE or POINTER
attributes; it has the TARGET attribute if and only if the selector is
a variable and has either the TARGET or POINTER attribute." */
if (sym->attr.associate_var && sym->assoc && sym->assoc->target)
{
if (sym->assoc->target->expr_type == EXPR_VARIABLE)
{
symbol_attribute tgt_attr;
tgt_attr = gfc_expr_attr (sym->assoc->target);
target = (tgt_attr.pointer || tgt_attr.target);
}
else
target = 0;
}
if (ts != NULL && expr->ts.type == BT_UNKNOWN)
*ts = sym->ts;

25
gcc/testsuite/gfortran.dg/associate_62.f90 Normal file
View file

@ -0,0 +1,25 @@
! { dg-do compile }
! PR fortran/112764
! Contributed by martin <mscfd@gmx.net>
program assoc_target
implicit none
integer, dimension(:,:), pointer :: x
integer, pointer :: j
integer, allocatable, target :: z(:)
allocate (x(1:100,1:2), source=1)
associate (i1 => x(:,1))
j => i1(1)
print *, j
if (j /= 1) stop 1
end associate
deallocate (x)
allocate (z(3))
z(:) = [1,2,3]
associate (i2 => z(2:3))
j => i2(1)
print *, j
if (j /= 2) stop 2
end associate
deallocate (z)
end program assoc_target