Fortran: Fix scope for OMP AFFINITY clause iterator variables [PR103695]

gfc_finish_var_decl was confused by the undocumented overloading of
the proc_name field in struct gfc_namespace to contain iterator
variables for the OpenMP AFFINITY clause, causing it to insert the
decls in the wrong scope.  This patch adds a new distinct field to
hold these variables.

2022-01-20  Sandra Loosemore  <sandra@codesourcery.com>

	PR fortran/103695
	PR fortran/102621

	gcc/fortran
	* gfortran.h (struct gfc_namespace) Add omp_affinity_iterator
	field.
	* dump-parse-tree.cc (show_iterator): Use it.
	* openmp.cc (gfc_match_iterator): Likewise.
	(resolve_omp_clauses): Likewise.
	* trans-decl.cc (gfc_finish_var_decl): Likewise.
	* trans-openmp.cc (handle_iterator): Likewise.

	gcc/testsuite/
	* gfortran.dg/gomp/affinity-clause-3.f90: Adjust pattern.
	* gfortran.dg/gomp/pr102621.f90: New.
	* gfortran.dg/gomp/pr103695.f90: New.
This commit is contained in:
Sandra Loosemore 2022-01-20 13:29:48 -08:00
parent cc01cd9397
commit d2ad748eee
8 changed files with 43 additions and 7 deletions

View file

@ -1302,10 +1302,10 @@ show_code (int level, gfc_code *c)
static void
show_iterator (gfc_namespace *ns)
{
for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink)
for (gfc_symbol *sym = ns->omp_affinity_iterators; sym; sym = sym->tlink)
{
gfc_constructor *c;
if (sym != ns->proc_name)
if (sym != ns->omp_affinity_iterators)
fputc (',', dumpfile);
fputs (sym->name, dumpfile);
fputc ('=', dumpfile);

View file

@ -2107,6 +2107,9 @@ typedef struct gfc_namespace
/* !$ACC ROUTINE clauses. */
gfc_omp_clauses *oacc_routine_clauses;
/* !$ACC TASK AFFINITY iterator symbols. */
gfc_symbol *omp_affinity_iterators;
/* !$ACC ROUTINE names. */
gfc_oacc_routine_name *oacc_routine_names;

View file

@ -1123,7 +1123,7 @@ gfc_match_iterator (gfc_namespace **ns, bool permit_var)
if (last)
last->tlink = sym;
else
(*ns)->proc_name = sym;
(*ns)->omp_affinity_iterators = sym;
last = sym;
sym->declared_at = prev_loc;
sym->ts = ts;
@ -6832,8 +6832,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
&& n->u2.ns && !n->u2.ns->resolved)
{
n->u2.ns->resolved = 1;
for (gfc_symbol *sym = n->u2.ns->proc_name; sym;
sym = sym->tlink)
for (gfc_symbol *sym = n->u2.ns->omp_affinity_iterators;
sym; sym = sym->tlink)
{
gfc_constructor *c;
c = gfc_constructor_first (sym->value->value.constructor);

View file

@ -647,6 +647,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
&& sym->ns->proc_name->attr.flavor == FL_LABEL)
/* This is a BLOCK construct. */
add_decl_as_local (decl);
else if (sym->ns->omp_affinity_iterators)
/* This is a block-local iterator. */
add_decl_as_local (decl);
else
gfc_add_decl_to_parent_function (decl);
}

View file

@ -2483,7 +2483,7 @@ static tree
handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block)
{
tree list = NULL_TREE;
for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink)
for (gfc_symbol *sym = ns->omp_affinity_iterators; sym; sym = sym->tlink)
{
gfc_constructor *c;
gfc_se se;

View file

@ -11,4 +11,4 @@ subroutine foo
!$omp end task
end
! { dg-final { scan-tree-dump-times "= ibar \\(&C\\." 3 "gimple" } }
! { dg-final { scan-tree-dump-times "= ibar \\(j\\." 1 "gimple" } }
! { dg-final { scan-tree-dump-times "= ibar \\(&j" 1 "gimple" } }

View file

@ -0,0 +1,12 @@
! This program used to ICE in convert_nonlocal_reference_op due to
! incorrect scoping of AFFINITY clause iterator variables.
program p
integer :: a(8)
!$omp task affinity (iterator(j=1:8) : a(j))
!$omp end task
contains
integer function f(x)
class(*) :: x
end
end

View file

@ -0,0 +1,18 @@
! This test case used to ICE in verify_ssa due to the iterator variable j
! incorrectly being inserted into program scope.
program p
integer :: i
do i = 1, 3
call sub (s(i))
end do
contains
function s(n) result(z)
integer, target, intent(in) :: n
integer, pointer :: z
integer :: a(8), b(8), c(8)
!$omp task affinity (iterator(j=1:8) : a(j), b(j), c(j))
!$omp end task
z => n
end
end