diff options
| -rw-r--r-- | gcc/fortran/openmp.cc | 15 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/atomic-27.f90 | 34 |
2 files changed, 46 insertions, 3 deletions
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 073e5a1..38c67e1 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -7660,9 +7660,16 @@ static bool is_scalar_intrinsic_expr (gfc_expr *expr, bool must_be_var, bool conv_ok) { if (must_be_var - && (expr->expr_type != EXPR_VARIABLE || !expr->symtree) - && (!conv_ok || !is_conversion (expr, true, true))) - return false; + && (expr->expr_type != EXPR_VARIABLE || !expr->symtree)) + { + if (!conv_ok) + return false; + gfc_expr *conv = is_conversion (expr, true, true); + if (!conv) + return false; + if (conv->expr_type != EXPR_VARIABLE || !conv->symtree) + return false; + } return (expr->rank == 0 && !gfc_is_coindexed (expr) && (expr->ts.type == BT_INTEGER @@ -7705,6 +7712,7 @@ resolve_omp_atomic (gfc_code *code) if (next->op == EXEC_IF && next->block && next->block->op == EXEC_IF + && next->block->next && next->block->next->op == EXEC_ASSIGN) { comp_cond = next->block->expr1; @@ -7757,6 +7765,7 @@ resolve_omp_atomic (gfc_code *code) if (code->op == EXEC_IF && code->block && code->block->op == EXEC_IF + && code->block->next && code->block->next->op == EXEC_ASSIGN) { comp_cond = code->block->expr1; diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-27.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-27.f90 new file mode 100644 index 0000000..5f7311a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/atomic-27.f90 @@ -0,0 +1,34 @@ +! PR fortran/104328 +! { dg-do compile } + +subroutine foo + integer :: k = 1 + !$omp atomic compare + if ( k == 2 ) then ! { dg-error "unexpected !.OMP ATOMIC expression" } + end if +end +subroutine bar + real :: x = 1 + !$omp atomic compare + if ( x == 2 ) then ! { dg-error "unexpected !.OMP ATOMIC expression" } + end if +end +subroutine baz + integer :: i + !$omp atomic capture + i = 1 + i = i + 1. ! { dg-error "!.OMP ATOMIC capture-statement requires a scalar variable of intrinsic type" } +end +subroutine qux + integer :: i = 0 + !$omp atomic capture + i = i + 1.0 + i = i + 1.0 ! { dg-error "!.OMP ATOMIC capture-statement requires a scalar variable of intrinsic type" } +end +subroutine garply + logical :: k = .true. + !$omp atomic capture compare + if ( k ) then ! { dg-error "unexpected !.OMP ATOMIC expression" } + else + end if +end |