OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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.
This commit is contained in:
Tobias Burnus 2022-02-10 09:30:19 +01:00
parent 6d98e83b2c
commit 9694f61219
2 changed files with 36 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/openmp.cc
View File

@ -7695,7 +7695,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;
@ -7833,7 +7833,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
{
@ -7841,7 +7842,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)
@ -7894,6 +7896,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)

28
gcc/testsuite/gfortran.dg/gomp/atomic-28.f90 Normal file
View File

@ -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