From: Jakub Jelinek Date: Wed, 31 Aug 2016 18:42:08 +0000 (+0200) Subject: re PR fortran/77374 (ICE in resolve_omp_atomic, at fortran/openmp.c:3949) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f25f40be277fe6687e86b6395a55781211811bef;p=gcc.git re PR fortran/77374 (ICE in resolve_omp_atomic, at fortran/openmp.c:3949) PR fortran/77374 * parse.c (parse_omp_oacc_atomic): Copy over cp->ext.omp_atomic to cp->block->ext.omp_atomic. * resolve.c (gfc_resolve_blocks): Assert block with one or two EXEC_ASSIGNs for EXEC_*_ATOMIC. * openmp.c (resolve_omp_atomic): Don't assert one or two EXEC_ASSIGNs, instead return quietly for EXEC_NOPs and otherwise error unexpected statements. * gfortran.dg/gomp/pr77374.f08: New test. From-SVN: r239903 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 62bdd9e387b..d7f416128ab 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,8 +1,18 @@ +2016-08-31 Jakub Jelinek + + PR fortran/77374 + * parse.c (parse_omp_oacc_atomic): Copy over cp->ext.omp_atomic + to cp->block->ext.omp_atomic. + * resolve.c (gfc_resolve_blocks): Assert block with one or two + EXEC_ASSIGNs for EXEC_*_ATOMIC. + * openmp.c (resolve_omp_atomic): Don't assert one or two + EXEC_ASSIGNs, instead return quietly for EXEC_NOPs and otherwise + error unexpected statements. + 2016-08-31 Paul Thomas - Jerry DeLisle + Jerry DeLisle PR fortran/48298 - * decl.c (access_attr_decl): Include case INTERFACE_DTIO as appropriate. * gfortran.h : Add INTRINSIC_FORMATTED and diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index f50e6e83d91..03e7dbe2f37 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -3946,12 +3946,33 @@ resolve_omp_atomic (gfc_code *code) = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK); code = code->block->next; - gcc_assert (code->op == EXEC_ASSIGN); - gcc_assert (((aop != GFC_OMP_ATOMIC_CAPTURE) && code->next == NULL) - || ((aop == GFC_OMP_ATOMIC_CAPTURE) - && code->next != NULL - && code->next->op == EXEC_ASSIGN - && code->next->next == NULL)); + /* resolve_blocks asserts this is initially EXEC_ASSIGN. + If it changed to EXEC_NOP, assume an error has been emitted already. */ + if (code->op == EXEC_NOP) + return; + if (code->op != EXEC_ASSIGN) + { + unexpected: + gfc_error ("unexpected !$OMP ATOMIC expression at %L", &code->loc); + return; + } + if (aop != GFC_OMP_ATOMIC_CAPTURE) + { + if (code->next != NULL) + goto unexpected; + } + else + { + if (code->next == NULL) + goto unexpected; + if (code->next->op == EXEC_NOP) + return; + if (code->next->op != EXEC_ASSIGN || code->next->next) + { + code = code->next; + goto unexpected; + } + } if (code->expr1->expr_type != EXPR_VARIABLE || code->expr1->symtree == NULL diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index deba4311f2a..86f2c427368 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -4695,6 +4695,7 @@ parse_omp_oacc_atomic (bool omp_p) np = new_level (cp); np->op = cp->op; np->block = NULL; + np->ext.omp_atomic = cp->ext.omp_atomic; count = 1 + ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) == GFC_OMP_ATOMIC_CAPTURE); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 72be6e57330..39c1330c455 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9519,6 +9519,24 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_WAIT: break; + case EXEC_OMP_ATOMIC: + case EXEC_OACC_ATOMIC: + { + gfc_omp_atomic_op aop + = (gfc_omp_atomic_op) (b->ext.omp_atomic & GFC_OMP_ATOMIC_MASK); + + /* Verify this before calling gfc_resolve_code, which might + change it. */ + gcc_assert (b->next && b->next->op == EXEC_ASSIGN); + gcc_assert (((aop != GFC_OMP_ATOMIC_CAPTURE) + && b->next->next == NULL) + || ((aop == GFC_OMP_ATOMIC_CAPTURE) + && b->next->next != NULL + && b->next->next->op == EXEC_ASSIGN + && b->next->next->next == NULL)); + } + break; + case EXEC_OACC_PARALLEL_LOOP: case EXEC_OACC_PARALLEL: case EXEC_OACC_KERNELS_LOOP: @@ -9531,9 +9549,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: - case EXEC_OACC_ATOMIC: case EXEC_OACC_ROUTINE: - case EXEC_OMP_ATOMIC: case EXEC_OMP_CRITICAL: case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4a9043c07cf..d77d548481f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2016-08-31 Jakub Jelinek + + PR fortran/77374 + * gfortran.dg/gomp/pr77374.f08: New test. + 2016-08-31 Marc Glisse PR tree-optimization/73714 @@ -21,7 +26,7 @@ intended item on the stack. 2016-08-31 Jerry DeLisle - Paul Thomas + Paul Thomas PR fortran/48298 * gfortran.dg/dtio_1.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/gomp/pr77374.f08 b/gcc/testsuite/gfortran.dg/gomp/pr77374.f08 new file mode 100644 index 00000000000..66ca5bd5115 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr77374.f08 @@ -0,0 +1,21 @@ +! PR fortran/77374 +! { dg-do compile } + +subroutine foo (a, b) + integer :: a, b +!$omp atomic + b = b + a +!$omp atomic + z(1) = z(1) + 1 ! { dg-error "must have the pointer attribute" } +end subroutine +subroutine bar (a, b) + integer :: a, b + interface + function baz (i) result (res) + integer, pointer :: res + integer :: i + end function + end interface +!$omp atomic + baz (i) = 1 ! { dg-error "unexpected" } +end subroutine