This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[committed] Fix ICE with F2008 BLOCK inside of !$OMP PARALLEL (PR fortran/82568)
- From: Jakub Jelinek <jakub at redhat dot com>
- To: gcc-patches at gcc dot gnu dot org
- Cc: fortran at gcc dot gnu dot org
- Date: Thu, 19 Oct 2017 09:44:26 +0200
- Subject: [committed] Fix ICE with F2008 BLOCK inside of !$OMP PARALLEL (PR fortran/82568)
- Authentication-results: sourceware.org; auth=none
- Authentication-results: ext-mx04.extmail.prod.ext.phx2.redhat.com; dmarc=none (p=none dis=none) header.from=redhat.com
- Authentication-results: ext-mx04.extmail.prod.ext.phx2.redhat.com; spf=fail smtp.mailfrom=jakub at redhat dot com
- Dmarc-filter: OpenDMARC Filter v1.3.2 mx1.redhat.com E59EC410E3
- Reply-to: Jakub Jelinek <jakub at redhat dot com>
Hi!
As OpenMP 4.5 supports only F2003 and earlier, this is strictly speaking
code with unspecified behavior, but we shouldn't ICE on it, so if we find
a sequential loop iterator inside of BLOCK inside of parallel or task
generating construct, and the loop iterator is explicitly or implicitly
declared inside of the BLOCK, we make sure the variable isn't added to
PRIVATE clauses on the surrounding OMP PARALLEL (or task generating
construct).
Bootstrapped/regtested on x86_64-linux and i686-linux, committed to trunk,
queued for backporting.
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.
* gfortran.dg/gomp/pr82568.f90: New test.
--- gcc/fortran/gfortran.h.jj 2017-10-09 09:41:20.000000000 +0200
+++ gcc/fortran/gfortran.h 2017-10-18 17:06:23.441304104 +0200
@@ -3103,7 +3103,8 @@ void gfc_free_omp_declare_simd_list (gfc
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 *);
--- gcc/fortran/openmp.c.jj 2017-09-22 20:51:49.000000000 +0200
+++ gcc/fortran/openmp.c 2017-10-18 17:42:21.632834909 +0200
@@ -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_cod
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_sa
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,
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,
&& 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,
}
}
+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)
--- gcc/fortran/resolve.c.jj 2017-10-14 14:12:20.000000000 +0200
+++ gcc/fortran/resolve.c 2017-10-18 17:41:44.627283366 +0200
@@ -10916,6 +10916,8 @@ gfc_resolve_code (gfc_code *code, gfc_na
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:
@@ -10931,8 +10933,6 @@ gfc_resolve_code (gfc_code *code, gfc_na
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:
@@ -11193,7 +11193,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;
@@ -16244,6 +16245,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);
--- gcc/testsuite/gfortran.dg/gomp/pr82568.f90.jj 2017-10-18 17:47:43.197937972 +0200
+++ gcc/testsuite/gfortran.dg/gomp/pr82568.f90 2017-10-18 17:47:14.000000000 +0200
@@ -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
Jakub