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 62bdd9e387be7e874ecf39f1f5821596e96c179a..d7f416128abacd0849e3ad77f97d27de39e5794c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,8 +1,18 @@
+2016-08-31  Jakub Jelinek  <jakub@redhat.com>
+
+       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  <pault@gcc.gnu.org>
-       Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+           Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        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 f50e6e83d919e92b09b4f5f9cea5826b2604be6f..03e7dbe2f372a0aeb79f397f26ea21269f10d992 100644 (file)
--- 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 deba4311f2aec55b7e57ab7221ad79c028ea36c6..86f2c427368cc90a28c377e2bc3f56b49222973a 100644 (file)
--- 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 72be6e57330fec15e666503111981058222b7b6b..39c1330c45571aa65499a52327ab753cb259f460 100644 (file)
--- 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 4a9043c07cf5db5c6e15da94fd182f325966ffbd..d77d548481f95f5318ddc826ed0aa315c56c7d75 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-08-31  Jakub Jelinek  <jakub@redhat.com>
+
+       PR fortran/77374
+       * gfortran.dg/gomp/pr77374.f08: New test.
+
 2016-08-31  Marc Glisse  <marc.glisse@inria.fr>
 
        PR tree-optimization/73714
@@ -21,7 +26,7 @@
        intended item on the stack.
 
 2016-08-31  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
-       Paul Thomas  <pault@gcc.gnu.org>
+           Paul Thomas  <pault@gcc.gnu.org>
 
        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 (file)
index 0000000..66ca5bd
--- /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