Commit cd30a0b8 by Jakub Jelinek Committed by Jakub Jelinek

re PR fortran/82568 ([6/7/8] ICE with do-loop inside BLOCK inside omp)

	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
parent bcc478b9
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> 2017-10-19 Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
* gfortran.h (gfc_lookup_function_fuzzy): New declaration. * gfortran.h (gfc_lookup_function_fuzzy): New declaration.
......
...@@ -3114,7 +3114,8 @@ void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *); ...@@ -3114,7 +3114,8 @@ void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
void gfc_free_omp_udr (gfc_omp_udr *); void gfc_free_omp_udr (gfc_omp_udr *);
gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *); gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *);
void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *); 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_parallel_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *); void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_declare_simd (gfc_namespace *); void gfc_resolve_omp_declare_simd (gfc_namespace *);
......
...@@ -5262,7 +5262,7 @@ resolve_omp_atomic (gfc_code *code) ...@@ -5262,7 +5262,7 @@ resolve_omp_atomic (gfc_code *code)
} }
struct fortran_omp_context static struct fortran_omp_context
{ {
gfc_code *code; gfc_code *code;
hash_set<gfc_symbol *> *sharing_clauses; hash_set<gfc_symbol *> *sharing_clauses;
...@@ -5345,6 +5345,8 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns) ...@@ -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:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_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:
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
...@@ -5390,8 +5392,11 @@ gfc_omp_restore_state (struct gfc_omp_saved_state *state) ...@@ -5390,8 +5392,11 @@ gfc_omp_restore_state (struct gfc_omp_saved_state *state)
construct, where they are predetermined private. */ construct, where they are predetermined private. */
void 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; int i = omp_current_do_collapse;
gfc_code *c = omp_current_do_code; gfc_code *c = omp_current_do_code;
...@@ -5410,9 +5415,6 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym) ...@@ -5410,9 +5415,6 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
c = c->block->next; c = c->block->next;
} }
if (omp_current_ctx == NULL)
return;
/* An openacc context may represent a data clause. Abort if so. */ /* An openacc context may represent a data clause. Abort if so. */
if (!omp_current_ctx->is_openmp && !oacc_is_loop (omp_current_ctx->code)) if (!omp_current_ctx->is_openmp && !oacc_is_loop (omp_current_ctx->code))
return; return;
...@@ -5421,7 +5423,7 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym) ...@@ -5421,7 +5423,7 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
&& omp_current_ctx->sharing_clauses->contains (sym)) && omp_current_ctx->sharing_clauses->contains (sym))
return; 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_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses;
gfc_omp_namelist *p; gfc_omp_namelist *p;
...@@ -5433,6 +5435,22 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym) ...@@ -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 static void
resolve_omp_do (gfc_code *code) resolve_omp_do (gfc_code *code)
......
...@@ -11008,6 +11008,8 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) ...@@ -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_PARALLEL_DO_SIMD:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
case EXEC_OMP_TASK: case EXEC_OMP_TASK:
case EXEC_OMP_TASKLOOP:
case EXEC_OMP_TASKLOOP_SIMD:
case EXEC_OMP_TEAMS: case EXEC_OMP_TEAMS:
case EXEC_OMP_TEAMS_DISTRIBUTE: case EXEC_OMP_TEAMS_DISTRIBUTE:
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
...@@ -11023,8 +11025,6 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) ...@@ -11023,8 +11025,6 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_DO_SIMD: case EXEC_OMP_DO_SIMD:
case EXEC_OMP_SIMD: case EXEC_OMP_SIMD:
case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_SIMD:
case EXEC_OMP_TASKLOOP:
case EXEC_OMP_TASKLOOP_SIMD:
gfc_resolve_omp_do_blocks (code, ns); gfc_resolve_omp_do_blocks (code, ns);
break; break;
case EXEC_SELECT_TYPE: case EXEC_SELECT_TYPE:
...@@ -11285,7 +11285,8 @@ start: ...@@ -11285,7 +11285,8 @@ start:
{ {
gfc_iterator *iter = code->ext.iterator; gfc_iterator *iter = code->ext.iterator;
if (gfc_resolve_iterator (iter, true, false)) 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; break;
...@@ -16352,6 +16353,7 @@ resolve_codes (gfc_namespace *ns) ...@@ -16352,6 +16353,7 @@ resolve_codes (gfc_namespace *ns)
bitmap_obstack_initialize (&labels_obstack); bitmap_obstack_initialize (&labels_obstack);
gfc_resolve_oacc_declare (ns); gfc_resolve_oacc_declare (ns);
gfc_resolve_omp_local_vars (ns);
gfc_resolve_code (ns->code, ns); gfc_resolve_code (ns->code, ns);
bitmap_obstack_release (&labels_obstack); bitmap_obstack_release (&labels_obstack);
......
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> 2017-10-19 Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
* gfortran.dg/spellcheck-operator.f90: New testcase. * gfortran.dg/spellcheck-operator.f90: New testcase.
......
! 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment