From 8ed3b8bd793298f94bdefbdff32f91eaea1a9d70 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Mon, 28 Feb 2022 12:34:22 +0000
Subject: [PATCH] openmp, fortran: Check that event handles passed to detach
 clauses are not arrays [PR104131]

2022-02-28  Kwok Cheung Yeung  <kcy@codesourcery.com>

gcc/fortran/

	PR fortran/104131
	* openmp.cc (gfc_match_omp_detach): Check that the event handle is not
	an array type.

gcc/testsuite/

	PR fortran/104131
	* gfortran.dg/gomp/pr104131.f90: New.
	* gfortran.dg/gomp/pr104131-2.f90: New.
	* gfortran.dg/gomp/task-detach-1.f90: Update expected error message.
---
 gcc/fortran/openmp.cc                            |  5 +++--
 gcc/testsuite/gfortran.dg/gomp/pr104131-2.f90    | 10 ++++++++++
 gcc/testsuite/gfortran.dg/gomp/pr104131.f90      | 10 ++++++++++
 gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90 |  2 +-
 4 files changed, 24 insertions(+), 3 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr104131-2.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr104131.f90

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 19142c4d8d0..50a1c476009 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -531,9 +531,10 @@ 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)
+  if ((*expr)->ts.type != BT_INTEGER || (*expr)->ts.kind != gfc_c_intptr_kind
+      || (*expr)->symtree->n.sym->as)
     {
-      gfc_error ("%qs at %L should be of type "
+      gfc_error ("%qs at %L should be a scalar of type "
 		 "integer(kind=omp_event_handle_kind)",
 		 (*expr)->symtree->n.sym->name, &(*expr)->where);
       return MATCH_ERROR;
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr104131-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr104131-2.f90
new file mode 100644
index 00000000000..8d10367ba3b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr104131-2.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fcoarray=single" }
+
+program p
+  use iso_c_binding, only: c_intptr_t
+  integer, parameter :: omp_event_handle_kind = c_intptr_t
+  integer (kind=omp_event_handle_kind) :: x[*]
+  !$omp task detach (x) ! { dg-error "'x' at \\\(1\\\) should be a scalar of type integer\\\(kind=omp_event_handle_kind\\\)" }
+  !$omp end task ! { dg-error "Unexpected !\\\$OMP END TASK statement at \\\(1\\\)" }
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr104131.f90 b/gcc/testsuite/gfortran.dg/gomp/pr104131.f90
new file mode 100644
index 00000000000..70a2dedfd7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr104131.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program p
+  use iso_c_binding, only: c_intptr_t
+  integer, parameter :: omp_event_handle_kind = c_intptr_t
+  integer(omp_event_handle_kind) :: x(1)
+  !$omp task detach(x) ! { dg-error "'x' at \\\(1\\\) should be a scalar of type integer\\\(kind=omp_event_handle_kind\\\)" }
+  !$omp end task ! { dg-error "Unexpected !\\\$OMP END TASK statement at \\\(1\\\)" }
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90 b/gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90
index 020be13a8b6..b73db07b7c3 100644
--- a/gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90
@@ -18,7 +18,7 @@ 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 task detach(z) ! { dg-error "'z' at \\\(1\\\) should be a scalar of type integer\\\(kind=omp_event_handle_kind\\\)" }
   !$omp end task ! { dg-error "Unexpected !\\\$OMP END TASK statement at \\\(1\\\)" }
   
   !$omp task detach (x) firstprivate (x) ! { dg-error "DETACH event handle 'x' in FIRSTPRIVATE clause at \\\(1\\\)" }
-- 
2.25.1