diff mbox series

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

Message ID 21a15d76-bc78-5cfc-bdf1-9839e3dcedf0@codesourcery.com
State New
Headers show
Series Fortran/OpenMP: Avoid ICE for invalid char array in omp atomic [PR104329] | expand

Commit Message

Tobias Burnus Feb. 4, 2022, 11:39 a.m. UTC
Already during parsing, the allocatable character array assignment
    x = (x)

is converted to two gfc_codes with EXEC_ASSIGN, namely:

   ASSIGN z1:_F.DA0(FULL) (parens z1:x(FULL))
   ASSIGN z1:x(FULL) z1:_F.DA0(FULL)

But the current code expects only one gfc_code - as parse.c does some
checks, that's unexpected for resolution and currently is checked with
an gcc_assert.

Solution: I now defer the gfc_assert until after diagnosing the arguments.

OK for mainline (only affected version)?

Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

Comments

Jakub Jelinek Feb. 9, 2022, 7:27 p.m. UTC | #1
On Fri, Feb 04, 2022 at 12:39:53PM +0100, Tobias Burnus wrote:
> Already during parsing, the allocatable character array assignment
>    x = (x)
> 
> is converted to two gfc_codes with EXEC_ASSIGN, namely:
> 
>   ASSIGN z1:_F.DA0(FULL) (parens z1:x(FULL))
>   ASSIGN z1:x(FULL) z1:_F.DA0(FULL)
> 
> But the current code expects only one gfc_code - as parse.c does some
> checks, that's unexpected for resolution and currently is checked with
> an gcc_assert.
> 
> Solution: I now defer the gfc_assert until after diagnosing the arguments.
> 
> OK for mainline (only affected version)?
> 
> Tobias
> -----------------
> Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

> Fortran/OpenMP: Avoid ICE for invalid char array in omp atomic [PR104329]
> 
> 	PR fortran/104329
> gcc/fortran/ChangeLog:
> 
> 	* openmp.cc (resolve_omp_atomic): Defer extra-code assert after
> 	other diagnostics.
> 
> gcc/testsuite/ChangeLog:
> 
> 	* gfortran.dg/gomp/atomic-28.f90: New test.
> 
>  gcc/fortran/openmp.cc                        | 11 ++++++++---
>  gcc/testsuite/gfortran.dg/gomp/atomic-28.f90 | 28 ++++++++++++++++++++++++++++
>  2 files changed, 36 insertions(+), 3 deletions(-)

Ok, thanks.

	Jakub
diff mbox series

Patch

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

	PR fortran/104329
gcc/fortran/ChangeLog:

	* openmp.cc (resolve_omp_atomic): Defer extra-code assert after
	other diagnostics.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/atomic-28.f90: New test.

 gcc/fortran/openmp.cc                        | 11 ++++++++---
 gcc/testsuite/gfortran.dg/gomp/atomic-28.f90 | 28 ++++++++++++++++++++++++++++
 2 files changed, 36 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 38c67e1f640..b1c065d9e8b 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -7687,7 +7687,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;
 
@@ -7825,7 +7825,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
     {
@@ -7833,7 +7834,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)
@@ -7886,6 +7888,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/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