Hello
I have updated the patch to catch array elements and structure
components as additional checks, in addition to checking that the
variable is a scalar.
The check has been moved to the end of resolve_omp_clauses as it is more
appropriate there. This gets rid of the additional 'Unexpected !$OMP END
TASK statement' error, since the type error is now caught after the
matching phase.
Coarrays (with the testcases in pr104131-2.f90) can be dealt with in a
separate patch. Is this part okay for trunk?
Thanks
Kwok
On 01/03/2022 3:37 pm, Mikael Morin wrote:
So, if I try to sum up what has been gathered in this thread:
- pr104131.f90 is invalid, as x is not scalar.
Checks are better done in resolve_omp_clauses after a call
to gfc_resolve_expr.
Checking expr->sym->attr.dimension seems to cover more cases than
expr->rank > 0.
- pr104131-2.f90 is valid and should be accepted.
- Some other cases should be rejected, including x[1] (coindexed
variable), x(1) (array element), x%comp (structure component).
Is that correct? Anything else?
Regarding the expr->rank vs expr->sym->attr.dimension controversy, my
take is that it should stick to the error message. Use expr->rank is
the error is about scalar vs array, use expr->sym->attr.dimension if
it’s about subobject-ness of an array variable.
Coming back to the PR, the ICE backtraces for pr104131.f90 and
pr104131-2.f90 are different and should probably be treated separatedly.
I don’t know how difficult the bullet 2 above would be, but bullet 1 and
3 seem quite doable.
From 3ed6eb1e38ad2a25c6eca18f9ff4d05d3f227db3 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <k...@codesourcery.com>
Date: Wed, 2 Mar 2022 17:09:45 +0000
Subject: [PATCH] openmp, fortran: Check that the type of an event handle in a
detach clause is suitable [PR104131]
This rejects variables that are array types, array elements or derived type
members when used as the event handle inside a detach clause (in accordance
with the OpenMP specification). This would previously lead to an ICE.
2022-03-02 Kwok Cheung Yeung <k...@codesourcery.com>
gcc/fortran/
PR fortran/104131
* openmp.cc (gfc_match_omp_detach): Move check for type of event
handle to...
(resolve_omp_clauses) ...here. Also check that the event handle is
not an array, or an array access or structure element access.
gcc/testsuite/
PR fortran/104131
* gfortran.dg/gomp/pr104131.f90: New.
* gfortran.dg/gomp/task-detach-1.f90: Update expected error message.
---
gcc/fortran/openmp.cc | 34 +++++++++++++------
gcc/testsuite/gfortran.dg/gomp/pr104131.f90 | 26 ++++++++++++++
.../gfortran.dg/gomp/task-detach-1.f90 | 4 +--
3 files changed, 51 insertions(+), 13 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr104131.f90
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 19142c4d8d0..16cd03a3d67 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -531,14 +531,6 @@ gfc_match_omp_detach (gfc_expr **expr)
if (gfc_match_variable (expr, 0) != MATCH_YES)
goto syntax_error;
- if ((*expr)->ts.type != BT_INTEGER || (*expr)->ts.kind != gfc_c_intptr_kind)
- {
- gfc_error ("%qs at %L should be of type "
- "integer(kind=omp_event_handle_kind)",
- (*expr)->symtree->n.sym->name, &(*expr)->where);
- return MATCH_ERROR;
- }
-
if (gfc_match_char (')') != MATCH_YES)
goto syntax_error;
@@ -7581,9 +7573,29 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses
*omp_clauses,
gfc_error ("%s must contain at least one MAP clause at %L",
p, &code->loc);
}
- if (!openacc && omp_clauses->mergeable && omp_clauses->detach)
- gfc_error ("%<DETACH%> clause at %L must not be used together with "
- "%<MERGEABLE%> clause", &omp_clauses->detach->where);
+
+ if (!openacc && omp_clauses->detach)
+ {
+ if (!gfc_resolve_expr (omp_clauses->detach)
+ || omp_clauses->detach->ts.type != BT_INTEGER
+ || omp_clauses->detach->ts.kind != gfc_c_intptr_kind
+ || omp_clauses->detach->rank != 0)
+ gfc_error ("%qs at %L should be a scalar of type "
+ "integer(kind=omp_event_handle_kind)",
+ omp_clauses->detach->symtree->n.sym->name,
+ &omp_clauses->detach->where);
+ else if (omp_clauses->detach->symtree->n.sym->attr.dimension > 0)
+ gfc_error ("The event handle at %L must not be an array element",
+ &omp_clauses->detach->where);
+ else if (omp_clauses->detach->symtree->n.sym->ts.type == BT_DERIVED
+ || omp_clauses->detach->symtree->n.sym->ts.type == BT_CLASS)
+ gfc_error ("The event handle at %L must not be part of "
+ "a derived type or class", &omp_clauses->detach->where);
+
+ if (omp_clauses->mergeable)
+ gfc_error ("%<DETACH%> clause at %L must not be used together with "
+ "%<MERGEABLE%> clause", &omp_clauses->detach->where);
+ }
}
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr104131.f90
b/gcc/testsuite/gfortran.dg/gomp/pr104131.f90
new file mode 100644
index 00000000000..472d19dd753
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr104131.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program p
+ use iso_c_binding, only: c_intptr_t
+ implicit none
+ integer, parameter :: omp_event_handle_kind = c_intptr_t
+
+ type dt
+ integer(omp_event_handle_kind) :: f
+ end type
+ integer(omp_event_handle_kind) :: x(1)
+ type(dt) :: y
+
+ !$omp task detach(x) ! { dg-error "'x' at \\\(1\\\) should be a scalar of
type integer\\\(kind=omp_event_handle_kind\\\)" }
+ !$omp end task
+
+ !$omp task detach(x(1)) ! { dg-error "The event handle at \\\(1\\\) must not
be an array element" }
+ !$omp end task
+
+ !$omp task detach(y) ! { dg-error "'y' at \\\(1\\\) should be a scalar of
type integer\\\(kind=omp_event_handle_kind\\\)" }
+ !$omp end task
+
+ !$omp task detach(y%f) ! { dg-error "The event handle at \\\(1\\\) must not
be part of a derived type or class" }
+ !$omp end task
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90
b/gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90
index 020be13a8b6..2e77aea0549 100644
--- a/gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90
@@ -18,8 +18,8 @@ program task_detach_1
!$omp task detach(x) mergeable ! { dg-error "'DETACH' clause at \\\(1\\\)
must not be used together with 'MERGEABLE' clause" }
!$omp end task
- !$omp task detach(z) ! { dg-error "'z' at \\\(1\\\) should be of type
integer\\\(kind=omp_event_handle_kind\\\)" }
- !$omp end task ! { dg-error "Unexpected !\\\$OMP END TASK statement at
\\\(1\\\)" }
+ !$omp task detach(z) ! { dg-error "'z' at \\\(1\\\) should be a scalar of
type integer\\\(kind=omp_event_handle_kind\\\)" }
+ !$omp end task
!$omp task detach (x) firstprivate (x) ! { dg-error "DETACH event handle 'x'
in FIRSTPRIVATE clause at \\\(1\\\)" }
!$omp end task
--
2.25.1
