From 73ecbc2672a5352a08260f7a9d0de6d2c29ea2b6 Mon Sep 17 00:00:00 2001
From: Paul-Antoine Arras <pa@codesourcery.com>
Date: Wed, 21 Sep 2022 15:52:56 +0000
Subject: [PATCH] OpenMP: Fix ICE with OMP metadirectives

Problem: ending an OpenMP metadirective block with an OMP end statement
results in an internal compiler error.
Solution: reject invalid end statements and issue a proper diagnostic.

Also add a new test to check this behaviour.

gcc/fortran/ChangeLog:

	* parse.cc (parse_omp_metadirective_body): Reject OMP end statements
	at the end of an OMP metadirective.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/metadirective-9.f90: New test.
---
 gcc/fortran/ChangeLog.omp                     |  5 ++++
 gcc/fortran/parse.cc                          | 14 +++++++++
 gcc/testsuite/ChangeLog.omp                   |  4 +++
 .../gfortran.dg/gomp/metadirective-9.f90      | 29 +++++++++++++++++++
 4 files changed, 52 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90

diff --git gcc/fortran/ChangeLog.omp gcc/fortran/ChangeLog.omp
index 8c89cd5bd43..7b253608bf8 100644
--- gcc/fortran/ChangeLog.omp
+++ gcc/fortran/ChangeLog.omp
@@ -1,3 +1,8 @@
+2022-09-21  Paul-Antoine Arras  <pa@codesourcery.com>
+
+        * parse.cc (parse_omp_metadirective_body): Reject OMP end statements
+        at the end of an OMP metadirective.
+
 2022-09-09  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backport from mainline:
diff --git gcc/fortran/parse.cc gcc/fortran/parse.cc
index b35d76a4f6b..1f1fa0eba0e 100644
--- gcc/fortran/parse.cc
+++ gcc/fortran/parse.cc
@@ -5863,6 +5863,20 @@ parse_omp_metadirective_body (gfc_statement omp_st)
 	  break;
 	}
 
+      if (gfc_state_stack->state == COMP_OMP_METADIRECTIVE
+	  && startswith (gfc_ascii_statement (st), "!$OMP END "))
+	{
+	  for (gfc_state_data *p = gfc_state_stack; p; p = p->previous)
+	    if (p->state == COMP_OMP_STRUCTURED_BLOCK)
+	      goto finish;
+	  gfc_error (
+	    "Unexpected %s statement in an OMP METADIRECTIVE block at %C",
+	    gfc_ascii_statement (st));
+	  reject_statement ();
+	  st = next_statement ();
+	}
+    finish:
+
       gfc_in_metadirective_body = old_in_metadirective_body;
 
       if (gfc_state_stack->head)
diff --git gcc/testsuite/ChangeLog.omp gcc/testsuite/ChangeLog.omp
index e0c8c138620..f075354af4d 100644
--- gcc/testsuite/ChangeLog.omp
+++ gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,7 @@
+2022-09-21  Paul-Antoine Arras  <pa@codesourcery.com>
+
+        * gfortran.dg/gomp/metadirective-9.f90: New test.
+
 2022-09-09  Paul-Antoine Arras  <pa@codesourcery.com>
 
 	Backport from mainline:
diff --git gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90 gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90
new file mode 100644
index 00000000000..4db37dd0ef9
--- /dev/null
+++ gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+
+program OpenMP_Metadirective_WrongEnd_Test
+
+  integer :: &
+    iV, jV, kV
+  integer, dimension ( 3 ) :: &
+    lV, uV
+  logical :: &
+    UseDevice
+
+    !$OMP metadirective &
+    !$OMP   when ( user = { condition ( UseDevice ) } &
+    !$OMP     : target teams distribute parallel do simd collapse ( 3 ) &
+    !$OMP         private ( iaVS ) ) &
+    !$OMP   default ( parallel do simd collapse ( 3 ) private ( iaVS ) )
+    do kV = lV ( 3 ), uV ( 3 )
+      do jV = lV ( 2 ), uV ( 2 )
+        do iV = lV ( 1 ), uV ( 1 )
+
+
+        end do
+      end do
+    end do
+    !$OMP end target teams distribute parallel do simd ! { dg-error "Unexpected !.OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD statement in an OMP METADIRECTIVE block at .1." }
+
+
+end program
+
-- 
2.31.1