Re: [PATCH] Fortran: Fix scope for OMP AFFINITY clause iterator variables [PR103695]
On 1/19/22 3:01 PM, Thomas Koenig wrote:
Hi Sandra,
This patch is for PR103695, marked as a P1 regression. OK to check in?
I'm not an OpenMP expert, but this looks straightforward enough.
I assume you ran a regression-test? OK if that is the case.
Yes, test results on x86_64-linux-gnu look good.
Tobias pointed out to me that this bug was likely also the cause of the
ICE reported in PR102621, so I verified that was also fixed now, added
the test case from that issue to the patch, and committed this version.
-Sandra
commit d2ad748eeef0dd260f3993b8dcbffbded3240a0a
Author: Sandra Loosemore
Date: Thu Jan 20 13:29:48 2022 -0800
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
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.
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index a618ae2..3112cae 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -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);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 00a558a..993879f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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;
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 9b73b9f..073e5a1 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -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);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 1112ca9..6493cc2 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -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);
}
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 9eabf68..d5a6b2d 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -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;
diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-3.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-3.f90
index 3fd39fe..eebe4dd 100644
--- a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-3.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-3.f90
@@ -11,4 +11,4 @@ subroutine foo
!$omp end task
end
! { dg-final { scan-tree-dump-times "= ibar \\(&C\\." 3
[PATCH] PR fortran/104127 - [9/10/11/12 Regression] ICE in get_array_charlen, at fortran/trans-array.c:7244
Dear Fortranners,
when simplifying TRANSFER with a MOLD argument of type character
and with SIZE=0 we lose the character length.
This happens in all gfortran versions and results in wrong code.
The purported regression is that at some point in the 9-development
this lead to a (previously possibly latent) ICE.
The attached patch sets up the character length in the typespec and
fixes the ICE. There is another generic hidden/latent problem with
array constructors of size 0 passed to procedures (see e.g. pr86277)
which will remain and is beyond the scope of this fix.
Regtested on x86_64-pc-linux-gnu. I also fixed a minor logic bug
in testcase transfer_simplify_11.f90.
OK for mainline? Backports to branches?
Thanks,
Harald
From c9882ace6199e2a327b69449f825e0366b442cba Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Thu, 20 Jan 2022 22:36:50 +0100
Subject: [PATCH] Fortran: fix simplification of TRANSFER for zero-sized
character array result
gcc/fortran/ChangeLog:
PR fortran/104127
* simplify.cc (gfc_simplify_transfer): Ensure that the result
typespec is set up for TRANSFER with MOLD of type CHARACTER
including character length even if the result is a zero-sized
array.
gcc/testsuite/ChangeLog:
PR fortran/104127
* gfortran.dg/transfer_simplify_11.f90: Fix logic.
* gfortran.dg/transfer_simplify_13.f90: New test.
---
gcc/fortran/simplify.cc | 13 ++-
.../gfortran.dg/transfer_simplify_11.f90 | 2 +-
.../gfortran.dg/transfer_simplify_13.f90 | 34 +++
3 files changed, 47 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/transfer_simplify_13.f90
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 3881370d947..8604162cfd5 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -8162,7 +8162,18 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
set even for array expressions, in order to pass this information into
gfc_target_interpret_expr. */
if (result->ts.type == BT_CHARACTER && gfc_is_constant_expr (mold_element))
-result->value.character.length = mold_element->value.character.length;
+{
+ result->value.character.length = mold_element->value.character.length;
+
+ /* Let the typespec of the result inherit the string length.
+ This is crucial if a resulting array has size zero. */
+ if (mold_element->ts.u.cl->length)
+ result->ts.u.cl->length = gfc_copy_expr (mold_element->ts.u.cl->length);
+ else
+ result->ts.u.cl->length =
+ gfc_get_int_expr (gfc_charlen_int_kind, NULL,
+ mold_element->value.character.length);
+}
/* Set the number of elements in the result, and determine its size. */
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_11.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_11.f90
index 0911f9dba3a..409e4768a10 100644
--- a/gcc/testsuite/gfortran.dg/transfer_simplify_11.f90
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_11.f90
@@ -4,5 +4,5 @@
integer, parameter :: N = 2
character(len=1) :: chr(N)
chr = transfer(repeat("x",ncopies=N),[character(len=1) ::], N)
- if (chr(1) /= 'x' .and. chr(2) /= 'x') STOP 1
+ if (chr(1) /= 'x' .or. chr(2) /= 'x') STOP 1
end
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_13.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_13.f90
new file mode 100644
index 000..59109c6029d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_13.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+! PR fortran/104127 - ICE in get_array_charlen
+! Contributed by G.Steinmetz
+
+program p
+ character(4) :: mold = "XYZ"
+ integer :: i = 0
+ integer, parameter :: l1 = len (transfer('ab', 'xyz', size=0))
+ integer, parameter :: s1 = size (transfer('ab', 'xyz', size=0))
+ integer, parameter :: l4 = len (transfer(4_'abcd', 4_'xy', size=0))
+ integer, parameter :: s4 = size (transfer(4_'abcd', 4_'xy', size=0))
+ integer, parameter :: l2 = len (transfer('ab', mold, size=0))
+ integer, parameter :: l3 = len (transfer('ab', mold, size=1))
+ integer, parameter :: l5 = len (transfer('ab',['xyz'], size=0))
+ integer, parameter :: s5 = size (transfer('ab',['xyz'], size=0))
+ call sub0 ( transfer('a', 'y', size=0) )
+ call sub1 ([transfer('a', 'y', size=0)])
+ call sub2 ([transfer('a',['y'],size=0)])
+ call sub3 ( transfer('a', 'y', size=1) )
+ call sub4 ([transfer('a', 'y', size=1)])
+ call sub5 ( transfer('a', 'y', size=i) )
+ call sub6 ( transfer(1_'abcd', 1_'xy' , size=0))
+ call sub7 ( transfer(1_'abcd',[1_'xy'], size=0))
+ call sub8 ( transfer(4_'abcd', 4_'xy' , size=0))
+ call sub9 ( transfer(4_'abcd',[4_'xy'], size=0))
+ print *, transfer('abcd', 'xy', size=0)
+ if (l1 /= 3 .or. s1 /= 0) stop 1
+ if (l4 /= 2 .or. s4 /= 0) stop 2
+ if (l2 /= 4 .or. l3 /= 4) stop 3
+ if (l5 /= 3 .or. s5 /= 0) stop 1
+end
+
+! { dg-final { scan-tree-dump-not "_gfortran_stop_num
