openmp, fortran: Check that the type of an event handle in a detach clause is suitabl...

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-03  Kwok Cheung Yeung  <kcy@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.

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 19142c4..16cd03a 100644 (file)
--- 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 (file)
index 0000000..472d19d
--- /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 020be13..2e77aea 100644 (file)
--- 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