Commit 79a592e3 by Jakub Jelinek Committed by Jakub Jelinek

re PR fortran/71687 (ICE in omp_add_variable, at gimplify.c:5821)

	PR fortran/71687
	* f95-lang.c (struct binding_level): Add reversed field.
	(clear_binding_level): Adjust initializer.
	(getdecls): If reversed is clear, set it and nreverse the names
	chain before returning it.
	(poplevel): Use getdecls.
	* trans-decl.c (gfc_generate_function_code, gfc_process_block_locals):
	Use nreverse to pushdecl decls in the declaration order.

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

From-SVN: r237926
parent e2298656
2016-07-01 Jakub Jelinek <jakub@redhat.com> 2016-07-01 Jakub Jelinek <jakub@redhat.com>
PR fortran/71687
* f95-lang.c (struct binding_level): Add reversed field.
(clear_binding_level): Adjust initializer.
(getdecls): If reversed is clear, set it and nreverse the names
chain before returning it.
(poplevel): Use getdecls.
* trans-decl.c (gfc_generate_function_code, gfc_process_block_locals):
Use nreverse to pushdecl decls in the declaration order.
PR fortran/71717 PR fortran/71717
* trans-openmp.c (gfc_omp_privatize_by_reference): Return false * trans-openmp.c (gfc_omp_privatize_by_reference): Return false
for GFC_DECL_ASSOCIATE_VAR_P with POINTER_TYPE. for GFC_DECL_ASSOCIATE_VAR_P with POINTER_TYPE.
......
...@@ -286,6 +286,9 @@ binding_level { ...@@ -286,6 +286,9 @@ binding_level {
tree blocks; tree blocks;
/* The binding level containing this one (the enclosing binding level). */ /* The binding level containing this one (the enclosing binding level). */
struct binding_level *level_chain; struct binding_level *level_chain;
/* True if nreverse has been already called on names; if false, names
are ordered from newest declaration to oldest one. */
bool reversed;
}; };
/* The binding level currently in effect. */ /* The binding level currently in effect. */
...@@ -296,7 +299,7 @@ static GTY(()) struct binding_level *current_binding_level = NULL; ...@@ -296,7 +299,7 @@ static GTY(()) struct binding_level *current_binding_level = NULL;
static GTY(()) struct binding_level *global_binding_level; static GTY(()) struct binding_level *global_binding_level;
/* Binding level structures are initialized by copying this one. */ /* Binding level structures are initialized by copying this one. */
static struct binding_level clear_binding_level = { NULL, NULL, NULL }; static struct binding_level clear_binding_level = { NULL, NULL, NULL, false };
/* Return true if we are in the global binding level. */ /* Return true if we are in the global binding level. */
...@@ -310,6 +313,11 @@ global_bindings_p (void) ...@@ -310,6 +313,11 @@ global_bindings_p (void)
tree tree
getdecls (void) getdecls (void)
{ {
if (!current_binding_level->reversed)
{
current_binding_level->reversed = true;
current_binding_level->names = nreverse (current_binding_level->names);
}
return current_binding_level->names; return current_binding_level->names;
} }
...@@ -347,7 +355,7 @@ poplevel (int keep, int functionbody) ...@@ -347,7 +355,7 @@ poplevel (int keep, int functionbody)
binding level that we are about to exit and which is returned by this binding level that we are about to exit and which is returned by this
routine. */ routine. */
tree block_node = NULL_TREE; tree block_node = NULL_TREE;
tree decl_chain = current_binding_level->names; tree decl_chain = getdecls ();
tree subblock_chain = current_binding_level->blocks; tree subblock_chain = current_binding_level->blocks;
tree subblock_node; tree subblock_node;
......
...@@ -6277,7 +6277,7 @@ gfc_generate_function_code (gfc_namespace * ns) ...@@ -6277,7 +6277,7 @@ gfc_generate_function_code (gfc_namespace * ns)
gfc_finish_block (&cleanup)); gfc_finish_block (&cleanup));
/* Add all the decls we created during processing. */ /* Add all the decls we created during processing. */
decl = saved_function_decls; decl = nreverse (saved_function_decls);
while (decl) while (decl)
{ {
tree next; tree next;
...@@ -6469,7 +6469,7 @@ gfc_process_block_locals (gfc_namespace* ns) ...@@ -6469,7 +6469,7 @@ gfc_process_block_locals (gfc_namespace* ns)
if (flag_coarray == GFC_FCOARRAY_LIB && has_coarray_vars) if (flag_coarray == GFC_FCOARRAY_LIB && has_coarray_vars)
generate_coarray_init (ns); generate_coarray_init (ns);
decl = saved_local_decls; decl = nreverse (saved_local_decls);
while (decl) while (decl)
{ {
tree next; tree next;
......
2016-07-01 Jakub Jelinek <jakub@redhat.com>
PR fortran/71687
* gfortran.dg/gomp/pr71687.f90: New test.
2016-07-01 Bill Schmidt <wschmidt@linux.vnet.ibm.com> 2016-07-01 Bill Schmidt <wschmidt@linux.vnet.ibm.com>
* gcc.dg/const-float128-ped.c: Require __float128 effective * gcc.dg/const-float128-ped.c: Require __float128 effective
......
! PR fortran/71687
! { dg-do compile }
! { dg-additional-options "-fstack-arrays -O2" }
subroutine s (n, x)
integer :: n
real :: x(n)
!$omp parallel
x(1:n) = x(n:1:-1)
!$omp end parallel
end
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