[gcc/devel/omp/gcc-11] Fortran/OpenMP: Avoid ICE for invalid char array in omp atomic [PR104329]

[Tobias Burnus]

https://gcc.gnu.org/g:8f0a07de377d3adf3920058af49535db2806898c

commit 8f0a07de377d3adf3920058af49535db2806898c
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Thu Feb 10 09:30:19 2022 +0100

    Fortran/OpenMP: Avoid ICE for invalid char array in omp atomic [PR104329]
    
            PR fortran/104329
    gcc/fortran/ChangeLog:
    
            * openmp.c (resolve_omp_atomic): Defer extra-code assert after
            other diagnostics.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/gomp/atomic-28.f90: New test.
    
    (cherry picked from commit 9694f6121982668285a21020b55b44c3099f7042)

Diff:
---
 gcc/fortran/ChangeLog.omp                    |  9 +++++++++
 gcc/fortran/openmp.c                         | 11 ++++++++---
 gcc/testsuite/ChangeLog.omp                  |  8 ++++++++
 gcc/testsuite/gfortran.dg/gomp/atomic-28.f90 | 28 ++++++++++++++++++++++++++++
 4 files changed, 53 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 46a4e05b521..86177164c9d 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,12 @@
+2022-02-27  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backported from master:
+	2021-02-10 Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/104329
+	* openmp.cc (resolve_omp_atomic): Defer extra-code assert after
+	other diagnostics.
+
 2022-02-27  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backported from master:
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index d13a0c7374d..cd6fc759583 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -7740,7 +7740,7 @@ resolve_omp_atomic (gfc_code *code)
   gfc_omp_atomic_op aop
     = (gfc_omp_atomic_op) (atomic_code->ext.omp_clauses->atomic_op
 			   & GFC_OMP_ATOMIC_MASK);
-  gfc_code *stmt = NULL, *capture_stmt = NULL;
+  gfc_code *stmt = NULL, *capture_stmt = NULL, *tailing_stmt = NULL;
   gfc_expr *comp_cond = NULL;
   locus *loc = NULL;
 
@@ -7876,7 +7876,8 @@ resolve_omp_atomic (gfc_code *code)
 	  stmt = code;
 	  capture_stmt = code->next;
 	}
-      gcc_assert (!code->next->next);
+      /* Shall be NULL but can happen for invalid code. */
+      tailing_stmt = code->next->next;
     }
   else
     {
@@ -7884,7 +7885,8 @@ resolve_omp_atomic (gfc_code *code)
       stmt = code;
       if (!atomic_code->ext.omp_clauses->compare && stmt->op != EXEC_ASSIGN)
 	goto unexpected;
-      gcc_assert (!code->next);
+      /* Shall be NULL but can happen for invalid code. */
+      tailing_stmt = code->next;
     }
 
   if (comp_cond)
@@ -7937,6 +7939,9 @@ resolve_omp_atomic (gfc_code *code)
       return;
     }
 
+  /* Should be diagnosed above already. */
+  gcc_assert (tailing_stmt == NULL);
+
   var = stmt->expr1->symtree->n.sym;
   stmt_expr2 = is_conversion (stmt->expr2, true, true);
   if (stmt_expr2 == NULL)
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 89837a4a231..2db6eed7f2f 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,11 @@
+2022-02-27  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backported from master:
+	2021-02-10 Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/104329
+	* gfortran.dg/gomp/atomic-28.f90: New test.
+
 2022-02-27  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backported from master:
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-28.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-28.f90
new file mode 100644
index 00000000000..91e29c96d45
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-28.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR fortran/104329
+!
+! Contributed by G. Steinmetz
+!
+subroutine z1
+   character(:), allocatable :: x(:)
+   x = ['123']
+   !$omp atomic update
+   x = (x)  ! { dg-error "OMP ATOMIC statement must set a scalar variable of intrinsic type" }
+end
+
+subroutine z2
+   character(:), allocatable :: x(:)
+   x = ['123']
+   !$omp atomic update
+   x = 'a' // x // 'e'  ! { dg-error "OMP ATOMIC statement must set a scalar variable of intrinsic type" }
+end
+
+
+subroutine z3
+   character(:), allocatable :: x(:)
+   x = ['123']
+   !$omp atomic capture
+   x = 'a' // x // 'e'  ! { dg-error "OMP ATOMIC statement must set a scalar variable of intrinsic type" }
+   x = x
+end