From 3ed6eb1e38ad2a25c6eca18f9ff4d05d3f227db3 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@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  <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.
---
 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