Dear all,
first, a question to Mikael (and others knowing the scalarizer): How to
properly fix the following:
implicit none
REAL qss(3)
REAL, ALLOCATABLE :: qj(:,:)
INTEGER :: qcount
qss(:)=qj(:,qcount)
end
For that one calls gfc_cleanup_loop (&loop) - and in gfc_free_ss:
case GFC_SS_SECTION:
for (n = 0; n < ss->dimen; n++)
{
if (ss_info->data.array.subscript[ss->dim[n]])
gfc_free_ss_chain (ss_info->data.array.subscript[ss->dim[n]]);
}
The problem is:
(gdb) p ss->dimen
$8 = 1
(gdb) p ss->dim[0]
$9 = 0
(gdb) p ss->info->data.array.subscript
$10 = {0x0, 0x15f37f0, 0x0, 0x0, 0x0, 0x0, 0x0}
The question is now whether ss->dim[0] should be 1 instead of 0, then
the bug is in gfc_walk_array_ref's AR_SECTION: -> DIMEN_ELEMENT
handling. Or whether the gfc_free_ss handling is wrong. A brute-force
method would be to walk all MAX_DIMENSION elements of
ss->info->data.array.subscript.
Secondly, I tried to to fix all gfc_ss mem leaks (including PR54350,
which I accidentally introduced).
The attached patch works nicely for the test suite (except for
realloc_on_assign_*.f90 aka PR54350), it also fixes the leaks in some
real-world test files. And it compiles nearly all polyhedron examples.
However: It fails to compile rnflow of Polyhedron 2005. Namely, one
enters an endless loop in gfc_conv_ss_startstride with the following
backtrace. Obviously, one has freed too much memory to early. Namely:
ss = gfc_walk_expr (expr1);
gfc_conv_array_parameter (&se, expr1, ss, false, NULL, NULL, NULL);
realloc_lhs_loop_for_fcn_call (&se, &expr1->where, &ss, &loop);
With the current patch, gfc_conv_array_parameter always frees "ss";
before, it only freed ss by calling gfc_conv_expr_descriptor.
How to solve that? A partial ss freeing is rather bad as one cannot
detect whether "ss" has been freed or not. One solution would be that
gfc_conv_expr_descriptor no longer frees the memory - i.e. the caller
has to do the duty. That's probably the most invasive patch, but at
least it makes the code clearer.
Suggestions?
#0 gfc_conv_ss_startstride (loop=0x7fffffffd8a0) at
/projects/tob/gcc-git/gcc/gcc/fortran/trans-array.c:3861
#1 0x000000000063b105 in realloc_lhs_loop_for_fcn_call
(loop=0x7fffffffd8a0, ss=<synthetic pointer>, where=0x183a990,
se=0x7fffffffd850)
at /projects/tob/gcc-git/gcc/gcc/fortran/trans-expr.c:6597
#2 gfc_trans_arrayfunc_assign (expr1=0x183a940,
expr2=expr2@entry=0x183e080) at
/projects/tob/gcc-git/gcc/gcc/fortran/trans-expr.c:6778
#3 0x000000000063c4c2 in gfc_trans_assignment (expr1=0x183a940,
expr2=0x183e080, init_flag=<optimized out>, dealloc=<optimized out>)
at /projects/tob/gcc-git/gcc/gcc/fortran/trans-expr.c:7441
#4 0x0000000000602be2 in trans_code (code=0x183ee10, cond=0x0) at
/projects/tob/gcc-git/gcc/gcc/fortran/trans.c:1312
#5 0x0000000000629937 in gfc_generate_function_code (ns=<optimized
out>) at /projects/tob/gcc-git/gcc/gcc/fortran/trans-decl.c:5346
Tobias
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 8c254dd..08f5a38 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6443,6 +6443,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
if (expr->ts.type == BT_CHARACTER)
se->string_length = gfc_get_expr_charlen (expr);
+ gfc_free_ss (ss);
return;
}
break;
@@ -6477,6 +6478,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
gcc_assert (se->ss == ss);
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
gfc_conv_expr (se, expr);
+ gfc_free_ss (ss);
return;
}
@@ -6986,6 +6988,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
se->expr = gfc_build_addr_expr (NULL_TREE, tmp);
if (size)
array_parameter_size (tmp, expr, size);
+ gfc_free_ss (ss);
return;
}
@@ -6996,6 +6999,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
gfc_conv_expr_descriptor (se, expr, ss);
tmp = se->expr;
}
+ else
+ gfc_free_ss (ss);
if (size)
array_parameter_size (tmp, expr, size);
se->expr = gfc_conv_array_data (tmp);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index cfb0862..28f8d28 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3534,7 +3534,6 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
gfc_add_block_to_block (&block, &loop.post);
gfc_add_block_to_block (&block, &fptrse.post);
gfc_cleanup_loop (&loop);
- gfc_free_ss (ss);
gfc_add_modify (&block, offset,
fold_build1_loc (input_location, NEGATE_EXPR,
@@ -4040,28 +4039,34 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
if (e->expr_type == EXPR_VARIABLE
&& is_subref_array (e))
- /* The actual argument is a component reference to an
- array of derived types. In this case, the argument
- is converted to a temporary, which is passed and then
- written back after the procedure call. */
- gfc_conv_subref_array_arg (&parmse, e, f,
+ {
+ /* The actual argument is a component reference to an
+ array of derived types. In this case, the argument
+ is converted to a temporary, which is passed and then
+ written back after the procedure call. */
+ gfc_conv_subref_array_arg (&parmse, e, f,
fsym ? fsym->attr.intent : INTENT_INOUT,
fsym && fsym->attr.pointer);
+ gfc_free_ss (argss);
+ }
else if (gfc_is_class_array_ref (e, NULL)
&& fsym && fsym->ts.type == BT_DERIVED)
- /* The actual argument is a component reference to an
- array of derived types. In this case, the argument
- is converted to a temporary, which is passed and then
- written back after the procedure call.
- OOP-TODO: Insert code so that if the dynamic type is
- the same as the declared type, copy-in/copy-out does
- not occur. */
- gfc_conv_subref_array_arg (&parmse, e, f,
+ {
+ /* The actual argument is a component reference to an
+ array of derived types. In this case, the argument
+ is converted to a temporary, which is passed and then
+ written back after the procedure call.
+ OOP-TODO: Insert code so that if the dynamic type is
+ the same as the declared type, copy-in/copy-out does
+ not occur. */
+ gfc_conv_subref_array_arg (&parmse, e, f,
fsym ? fsym->attr.intent : INTENT_INOUT,
fsym && fsym->attr.pointer);
+ gfc_free_ss (argss);
+ }
else
- gfc_conv_array_parameter (&parmse, e, argss, f, fsym,
- sym->name, NULL);
+ gfc_conv_array_parameter (&parmse, e, argss, f, fsym,
+ sym->name, NULL);
/* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
allocated on entry, it must be deallocated. */
@@ -6771,7 +6776,6 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
if (!expr2->value.function.isym)
{
realloc_lhs_loop_for_fcn_call (&se, &expr1->where, &ss, &loop);
- gfc_cleanup_loop (&loop);
ss->is_alloc_lhs = 1;
}
else
@@ -6780,7 +6784,6 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
gfc_conv_function_expr (&se, expr2);
gfc_add_block_to_block (&se.pre, &se.post);
- gfc_free_ss (se.ss);
return gfc_finish_block (&se.pre);
}
@@ -7380,7 +7383,6 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
/* Wrap the whole thing up. */
gfc_add_block_to_block (&block, &loop.pre);
gfc_add_block_to_block (&block, &loop.post);
-
gfc_cleanup_loop (&loop);
}
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index d0aebe9..fac29c7 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1328,7 +1328,6 @@ gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr)
argse.descriptor_only = 1;
gfc_conv_expr_descriptor (&argse, expr->value.function.actual->expr, ss);
- gfc_free_ss (ss);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
