Hello world,
the attached patch fixes PR 60522, a regresseion where temporary
variables were incorrectly introduced in a BLOCK within a WHERE
statement.
Regression-tested on x86_64-unknown-linux-gnu.
OK for trunk and the other open branches?
Thomas
2014-04-16 Thomas Koenig <[email protected]>
PR fortran/60522
* frontend-passes.c (top level): New variables where_level
and where_code.
(optimize_code): Set where_code if we are within a
WHERE statment.
(cfe_code): Likewise.
(create_var): Use where_code if within a WHERE statement.
(optimize_namespace): Set where_level.
(gfc_code_walker): Keep track of where_level.
2014-04-16 Thomas Koenig <[email protected]>
PR fortran/60522
* gfortran.dg/where_4.f90: New test case.
! { dg-do compile }
! PR 60522 - this used to ICE.
! Original test case Roger Ferrer Ibanez
subroutine foo(a, b)
implicit none
integer, dimension(:), intent(inout) :: a
integer, dimension(:), intent(in) :: b
where (b(:) > 0)
where (b(:) > 100)
a(lbound(a, 1):ubound(a, 1)) = b(lbound(b, 1):ubound(b, 1)) * b(lbound(b, 1):ubound(b, 1)) - 100
elsewhere
a(lbound(a, 1):ubound(a, 1)) = b(lbound(b, 1):ubound(b, 1)) * b(lbound(b, 1):ubound(b, 1))
end where
elsewhere
a(lbound(a, 1):ubound(a, 1)) = - b(lbound(b, 1):ubound(b, 1)) * b(lbound(b, 1):ubound(b, 1))
end where
end subroutine foo
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 208592)
+++ frontend-passes.c (Arbeitskopie)
@@ -84,6 +84,12 @@ static int iterator_level;
static gfc_code **doloop_list;
static int doloop_size, doloop_level;
+/* Keep track of whether we are within a WHERE
+ statement. */
+
+static int where_level;
+static gfc_code **where_code;
+
/* Vector of gfc_expr * to keep track of DO loops. */
struct my_struct *evec;
@@ -139,6 +145,18 @@ optimize_code (gfc_code **c, int *walk_subtrees AT
inserted_block = NULL;
changed_statement = NULL;
+
+ /* Keep track where to put a block around a WHERE statement.
+ TODO: We can do the same thing for FORALL. */
+
+ if (where_level == 0)
+ {
+ if ((*c)->op == EXEC_WHERE)
+ where_code = c;
+ else
+ where_code = NULL;
+ }
+
if (op == EXEC_ASSIGN)
optimize_assignment (*c);
return 0;
@@ -442,34 +460,40 @@ create_var (gfc_expr * e)
gfc_expr *result;
gfc_code *n;
gfc_namespace *ns;
+ gfc_code **cc;
int i;
+ if (where_level > 0)
+ cc = where_code;
+ else
+ cc = current_code;
+
/* If the block hasn't already been created, do so. */
if (inserted_block == NULL)
{
inserted_block = XCNEW (gfc_code);
inserted_block->op = EXEC_BLOCK;
- inserted_block->loc = (*current_code)->loc;
+ inserted_block->loc = (*cc)->loc;
ns = gfc_build_block_ns (current_ns);
inserted_block->ext.block.ns = ns;
inserted_block->ext.block.assoc = NULL;
- ns->code = *current_code;
+ ns->code = *cc;
/* If the statement has a label, make sure it is transferred to
the newly created block. */
- if ((*current_code)->here)
+ if ((*cc)->here)
{
inserted_block->here = (*current_code)->here;
- (*current_code)->here = NULL;
+ (*cc)->here = NULL;
}
- inserted_block->next = (*current_code)->next;
+ inserted_block->next = (*cc)->next;
changed_statement = &(inserted_block->ext.block.ns->code);
- (*current_code)->next = NULL;
+ (*cc)->next = NULL;
/* Insert the BLOCK at the right position. */
- *current_code = inserted_block;
+ *cc = inserted_block;
ns->parent = current_ns;
}
else
@@ -633,6 +657,18 @@ cfe_code (gfc_code **c, int *walk_subtrees ATTRIBU
current_code = c;
inserted_block = NULL;
changed_statement = NULL;
+
+ /* Keep track where to put a block around a WHERE statement.
+ TODO: We can do the same thing for FORALL. */
+
+ if (where_level == 0)
+ {
+ if ((*c)->op == EXEC_WHERE)
+ where_code = c;
+ else
+ where_code = NULL;
+ }
+
return 0;
}
@@ -798,6 +834,7 @@ optimize_namespace (gfc_namespace *ns)
forall_level = 0;
iterator_level = 0;
in_omp_workshare = false;
+ where_level = 0;
gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
gfc_code_walker (&ns->code, convert_elseif, dummy_expr_callback, NULL);
@@ -1980,6 +2017,10 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
break;
}
+ case EXEC_WHERE:
+ where_level ++;
+ break;
+
case EXEC_OPEN:
WALK_SUBEXPR (co->ext.open->unit);
WALK_SUBEXPR (co->ext.open->file);
@@ -2144,6 +2185,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
if (co->op == EXEC_DO)
doloop_level --;
+ if (co-> op == EXEC_WHERE)
+ where_level --;
+
in_omp_workshare = saved_in_omp_workshare;
}
}
