re PR fortran/82568 ([6/7/8] ICE with do-loop inside BLOCK inside omp)
authorJakub Jelinek <jakub@redhat.com>
Thu, 19 Oct 2017 07:38:59 +0000 (09:38 +0200)
committerJakub Jelinek <jakub@gcc.gnu.org>
Thu, 19 Oct 2017 07:38:59 +0000 (09:38 +0200)
PR fortran/82568
* gfortran.h (gfc_resolve_do_iterator): Add a bool arg.
(gfc_resolve_omp_local_vars): New declaration.
* openmp.c (omp_current_ctx): Make static.
(gfc_resolve_omp_parallel_blocks): Handle EXEC_OMP_TASKLOOP
and EXEC_OMP_TASKLOOP_SIMD.
(gfc_resolve_do_iterator): Add ADD_CLAUSE argument, if false,
don't actually add any clause.  Move omp_current_ctx test
earlier.
(handle_local_var, gfc_resolve_omp_local_vars): New functions.
* resolve.c (gfc_resolve_code): Call gfc_resolve_omp_parallel_blocks
instead of just gfc_resolve_omp_do_blocks for EXEC_OMP_TASKLOOP
and EXEC_OMP_TASKLOOP_SIMD.
(gfc_resolve_code): Adjust gfc_resolve_do_iterator caller.
(resolve_codes): Call gfc_resolve_omp_local_vars.

* gfortran.dg/gomp/pr82568.f90: New test.

From-SVN: r253878

gcc/fortran/ChangeLog
gcc/fortran/gfortran.h
gcc/fortran/openmp.c
gcc/fortran/resolve.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/gomp/pr82568.f90 [new file with mode: 0644]

index 0181c06..11c8ef0 100644 (file)
@@ -1,3 +1,21 @@
+2017-10-19  Jakub Jelinek  <jakub@redhat.com>
+
+       PR fortran/82568
+       * gfortran.h (gfc_resolve_do_iterator): Add a bool arg.
+       (gfc_resolve_omp_local_vars): New declaration.
+       * openmp.c (omp_current_ctx): Make static.
+       (gfc_resolve_omp_parallel_blocks): Handle EXEC_OMP_TASKLOOP
+       and EXEC_OMP_TASKLOOP_SIMD.
+       (gfc_resolve_do_iterator): Add ADD_CLAUSE argument, if false,
+       don't actually add any clause.  Move omp_current_ctx test
+       earlier.
+       (handle_local_var, gfc_resolve_omp_local_vars): New functions.
+       * resolve.c (gfc_resolve_code): Call gfc_resolve_omp_parallel_blocks
+       instead of just gfc_resolve_omp_do_blocks for EXEC_OMP_TASKLOOP
+       and EXEC_OMP_TASKLOOP_SIMD.
+       (gfc_resolve_code): Adjust gfc_resolve_do_iterator caller.
+       (resolve_codes): Call gfc_resolve_omp_local_vars.
+
 2017-10-19  Bernhard Reutner-Fischer  <aldot@gcc.gnu.org>
 
        * gfortran.h (gfc_lookup_function_fuzzy): New declaration.
index cdf2b54..2c2fc63 100644 (file)
@@ -3114,7 +3114,8 @@ void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
 void gfc_free_omp_udr (gfc_omp_udr *);
 gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *);
 void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
-void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *);
+void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *, bool);
+void gfc_resolve_omp_local_vars (gfc_namespace *);
 void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
 void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
 void gfc_resolve_omp_declare_simd (gfc_namespace *);
index c5e0088..2606323 100644 (file)
@@ -5262,7 +5262,7 @@ resolve_omp_atomic (gfc_code *code)
 }
 
 
-struct fortran_omp_context
+static struct fortran_omp_context
 {
   gfc_code *code;
   hash_set<gfc_symbol *> *sharing_clauses;
@@ -5345,6 +5345,8 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TASKLOOP:
+    case EXEC_OMP_TASKLOOP_SIMD:
     case EXEC_OMP_TEAMS_DISTRIBUTE:
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
@@ -5390,8 +5392,11 @@ gfc_omp_restore_state (struct gfc_omp_saved_state *state)
    construct, where they are predetermined private.  */
 
 void
-gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
+gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym, bool add_clause)
 {
+  if (omp_current_ctx == NULL)
+    return;
+
   int i = omp_current_do_collapse;
   gfc_code *c = omp_current_do_code;
 
@@ -5410,9 +5415,6 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
       c = c->block->next;
     }
 
-  if (omp_current_ctx == NULL)
-    return;
-
   /* An openacc context may represent a data clause.  Abort if so.  */
   if (!omp_current_ctx->is_openmp && !oacc_is_loop (omp_current_ctx->code))
     return;
@@ -5421,7 +5423,7 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
       && omp_current_ctx->sharing_clauses->contains (sym))
     return;
 
-  if (! omp_current_ctx->private_iterators->add (sym))
+  if (! omp_current_ctx->private_iterators->add (sym) && add_clause)
     {
       gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses;
       gfc_omp_namelist *p;
@@ -5433,6 +5435,22 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
     }
 }
 
+static void
+handle_local_var (gfc_symbol *sym)
+{
+  if (sym->attr.flavor != FL_VARIABLE
+      || sym->as != NULL
+      || (sym->ts.type != BT_INTEGER && sym->ts.type != BT_REAL))
+    return;
+  gfc_resolve_do_iterator (sym->ns->code, sym, false);
+}
+
+void
+gfc_resolve_omp_local_vars (gfc_namespace *ns)
+{
+  if (omp_current_ctx)
+    gfc_traverse_ns (ns, handle_local_var);
+}
 
 static void
 resolve_omp_do (gfc_code *code)
index 0188bdd..04d4e8a 100644 (file)
@@ -11008,6 +11008,8 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
            case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
            case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
            case EXEC_OMP_TASK:
+           case EXEC_OMP_TASKLOOP:
+           case EXEC_OMP_TASKLOOP_SIMD:
            case EXEC_OMP_TEAMS:
            case EXEC_OMP_TEAMS_DISTRIBUTE:
            case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
@@ -11023,8 +11025,6 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
            case EXEC_OMP_DO_SIMD:
            case EXEC_OMP_SIMD:
            case EXEC_OMP_TARGET_SIMD:
-           case EXEC_OMP_TASKLOOP:
-           case EXEC_OMP_TASKLOOP_SIMD:
              gfc_resolve_omp_do_blocks (code, ns);
              break;
            case EXEC_SELECT_TYPE:
@@ -11285,7 +11285,8 @@ start:
            {
              gfc_iterator *iter = code->ext.iterator;
              if (gfc_resolve_iterator (iter, true, false))
-               gfc_resolve_do_iterator (code, iter->var->symtree->n.sym);
+               gfc_resolve_do_iterator (code, iter->var->symtree->n.sym,
+                                        true);
            }
          break;
 
@@ -16352,6 +16353,7 @@ resolve_codes (gfc_namespace *ns)
   bitmap_obstack_initialize (&labels_obstack);
 
   gfc_resolve_oacc_declare (ns);
+  gfc_resolve_omp_local_vars (ns);
   gfc_resolve_code (ns->code, ns);
 
   bitmap_obstack_release (&labels_obstack);
index 971a9c4..39f2edd 100644 (file)
@@ -1,3 +1,8 @@
+2017-10-19  Jakub Jelinek  <jakub@redhat.com>
+
+       PR fortran/82568
+       * gfortran.dg/gomp/pr82568.f90: New test.
+
 2017-10-19  Bernhard Reutner-Fischer  <aldot@gcc.gnu.org>
 
        * gfortran.dg/spellcheck-operator.f90: New testcase.
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr82568.f90 b/gcc/testsuite/gfortran.dg/gomp/pr82568.f90
new file mode 100644 (file)
index 0000000..303278c
--- /dev/null
@@ -0,0 +1,75 @@
+! PR fortran/82568
+
+MODULE PR82568_MOD
+  INTEGER :: N
+END MODULE
+PROGRAM PR82568
+  INTEGER :: I, L
+  !$OMP PARALLEL DO
+  DO I=1,2
+    BLOCK
+      USE PR82568_MOD
+      INTEGER :: J
+      DO J=1,2
+        PRINT*,I,J
+      END DO
+      DO K=1,2
+        PRINT*,I,K
+      END DO
+      DO L=1,2
+        PRINT*,I,L
+      END DO
+      DO N=1,2
+        PRINT*,I,N
+      END DO
+    END BLOCK
+    DO M=1,2
+      PRINT*,I,M
+    END DO
+  END DO
+  !$OMP TASK
+  DO I=1,2
+    BLOCK
+      USE PR82568_MOD
+      INTEGER :: J
+      DO J=1,2
+        PRINT*,I,J
+      END DO
+      DO K=1,2
+        PRINT*,I,K
+      END DO
+      DO L=1,2
+        PRINT*,I,L
+      END DO
+      DO N=1,2
+        PRINT*,I,N
+      END DO
+    END BLOCK
+    DO M=1,2
+      PRINT*,I,M
+    END DO
+  END DO
+  !$OMP END TASK
+  !$OMP TASKLOOP
+  DO I=1,2
+    BLOCK
+      USE PR82568_MOD
+      INTEGER :: J
+      DO J=1,2
+        PRINT*,I,J
+      END DO
+      DO K=1,2
+        PRINT*,I,K
+      END DO
+      DO L=1,2
+        PRINT*,I,L
+      END DO
+      DO N=1,2
+        PRINT*,I,N
+      END DO
+    END BLOCK
+    DO M=1,2
+      PRINT*,I,M
+    END DO
+  END DO
+END PROGRAM PR82568