Hi Thomas,
I had a quick look at the patch – I thought that it is only a band aid
and should be handled more properly, but after having a closer look, I
believe the latter is more work than I expected and Jakub's patch makes
perfectly sense for Stage 3/4. (Hence, I also did not reply.)
On 1/7/20 6:33 PM, Thomas Schwinge wrote:
Do I understand correctly that this relates to the r279631 "Fortran
polymorphic class-type support for OpenACC" changes?
I think it relates to the deep-copy change three commits / few minutes
earlier: "OpenACC 2.6 deep copy: Fortran front-end parts" which
permitted components in r279628.
Julian and/or Tobias, will you please review that at some point (in
context of the OpenACC usage/support recently introduced), and add
test cases etc. (... but need not be done right now.)
The bug only triggers if there is a reference of some kind, which is
(obviously) not an array reference and where accessing "ar.type" in the
union ref->-u will hit a condition which either evaluates to AR_FULL by
accident or which reads invalid memory (unlikely as all union members
are similar or size + alignment). — Or as with PR 93162 when building
with UBSAN.
Well, you have asked for a test case: as the PR shows,
testsuite/gfortran.dg/goacc/derived-types-3.f90 is a test case, you just
need to bootstrap GCC with UBSAN enabled :-P
Especially in light of the OpenMP 4.5's structure element mapping (for
C/C++ since GCC 7, for Fortran still unsupported), I had preferred some
consolidation like taking the last reference in that check instead of
just checking that the first reference is a whole array. Namely:
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2498,3 +2498,6 @@ gfc_trans_omp_clauses (stmtblock_t *block,
gfc_omp_clauses *clauses,
- if (n->expr == NULL
- || (n->expr->ref->type == REF_ARRAY
- && n->expr->ref->u.ar.type == AR_FULL))
+ gfc_array_ref *array_ref = NULL;
+ if (n->expr)
+ for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
+ if (ref->type == REF_ARRAY)
+ array_ref = &ref->u.ar;
+ if (array_ref && array_ref->type == AR_FULL)
I still believe believe that's a good/better approach.
BUT: This needs some additional changes if one wants to handle components
– and the committed OpenACC code handles arrays at in other conditional blocks.
This can be disentangled, but that not during Stage 3 and just before Stage 4.
Tobias
PS: The attached patch – I think from October (r277442, i.e. before a lot of
changes went in) – is a draft implementation for OpenMP's 4.5 structure element
mapping. I think it does handled all required, but it also commented-out
nearly all checks. (Fortunately, OpenMP 4.5 does not permit automatic deep
copy of allocatable components. OpenMP 5 does, also for polymorphic components;
it just doesn't support "stacks"/recursive types, i.e. derived types with
allocatable components of the same type.)
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 5c91fcdfd31..1644383bcbf 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -259,7 +259,9 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
case MATCH_YES:
gfc_expr *expr;
expr = NULL;
- if (allow_sections && gfc_peek_ascii_char () == '(')
+ if (allow_sections
+ && (gfc_peek_ascii_char () == '('
+ || gfc_peek_ascii_char () == '%'))
{
gfc_current_locus = cur_loc;
m = gfc_match_variable (&expr, 0);
@@ -4451,11 +4453,12 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
if (!gfc_resolve_expr (n->expr)
|| n->expr->expr_type != EXPR_VARIABLE
|| n->expr->ref == NULL
- || n->expr->ref->next
- || n->expr->ref->type != REF_ARRAY)
+/* || n->expr->ref->next
+ || n->expr->ref->type != REF_ARRAY*/)
gfc_error ("%qs in %s clause at %L is not a proper "
"array section", n->sym->name, name,
&n->where);
+#if 0
else if (n->expr->ref->u.ar.codimen)
gfc_error ("Coarrays not supported in %s clause at %L",
name, &n->where);
@@ -4493,6 +4496,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
break;
}
}
+#endif
}
else if (openacc)
{
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index dad11a24430..6ce2c6ce635 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2167,12 +2167,54 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree node2 = NULL_TREE;
tree node3 = NULL_TREE;
tree node4 = NULL_TREE;
- tree decl = gfc_trans_omp_variable (n->sym, false);
+ tree node5 = NULL_TREE;
+ tree decl = NULL_TREE;
+ gfc_array_ref *array_ref = NULL;
+ bool compref = false;
+ if (n->expr)
+ {
+ // FIXME: Can be simplified if "dt(1)%comp" is invalid
+ for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
+ {
+ if (ref->type == REF_COMPONENT)
+ compref = true;
+ if (ref->type == REF_ARRAY)
+ array_ref = &ref->u.ar;
+ }
+ }
+ if (compref)
+ {
+ gfc_se se;
+ gfc_init_se (&se, NULL);
+ se. descriptor_only = 1;
+ gfc_conv_expr (&se, n->expr);
+ decl = se.expr;
+ gcc_assert (se.pre.head == NULL && se.post.head == NULL);
+
+ if (POINTER_TYPE_P (TREE_TYPE (decl))
+ || INDIRECT_REF_P (decl))
+ {
+ node5 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (node5, GOMP_MAP_ALWAYS_POINTER);
+ OMP_CLAUSE_SIZE (node5) = size_int (0);
+ /* Scalar pointers/allocatables are always dereferenced in
+ gfc_conv_component_ref. */
+ OMP_CLAUSE_DECL (node5) = INDIRECT_REF_P (decl)
+ ? TREE_OPERAND (decl, 0) : decl;
+ }
+ }
+ else
+ decl = gfc_trans_omp_variable (n->sym, false);
+
if (DECL_P (decl))
TREE_ADDRESSABLE (decl) = 1;
- if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
+
+ if (!array_ref || array_ref->type == AR_FULL)
{
- if (POINTER_TYPE_P (TREE_TYPE (decl))
+ if (n->u.map_op != OMP_MAP_DELETE
+ && n->u.map_op != OMP_MAP_RELEASE
+ && POINTER_TYPE_P (TREE_TYPE (decl))
+ && DECL_P (decl) /* FIXME: check whether this excludes too much. */
&& (gfc_omp_privatize_by_reference (decl)
|| GFC_DECL_GET_SCALAR_POINTER (decl)
|| GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
@@ -2252,11 +2294,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
else_b));
OMP_CLAUSE_SIZE (node) = size;
}
- else if (n->sym->attr.dimension)
+ else if (n->expr ? gfc_expr_attr (n->expr).dimension
+ : n->sym->attr.dimension)
OMP_CLAUSE_SIZE (node)
= gfc_full_array_size (block, decl,
GFC_TYPE_ARRAY_RANK (type));
- if (n->sym->attr.dimension)
+ if (n->expr ? gfc_expr_attr (n->expr).dimension
+ : n->sym->attr.dimension)
{
tree elemsz
= TYPE_SIZE_UNIT (gfc_get_element_type (type));
@@ -2273,7 +2317,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
{
tree ptr, ptr2;
gfc_init_se (&se, NULL);
- if (n->expr->ref->u.ar.type == AR_ELEMENT)
+ if (array_ref->type == AR_ELEMENT)
{
gfc_conv_expr_reference (&se, n->expr);
gfc_add_block_to_block (block, &se.pre);
@@ -2302,7 +2346,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
ptr);
OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
- if (POINTER_TYPE_P (TREE_TYPE (decl))
+ if (n->u.map_op != OMP_MAP_DELETE
+ && n->u.map_op != OMP_MAP_RELEASE
+ && POINTER_TYPE_P (TREE_TYPE (decl))
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
{
node4 = build_omp_clause (input_location,
@@ -2403,6 +2449,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (node3, omp_clauses);
if (node4)
omp_clauses = gfc_trans_add_clause (node4, omp_clauses);
+ if (node5)
+ omp_clauses = gfc_trans_add_clause (node5, omp_clauses);
}
break;
case OMP_LIST_TO:
