Message ID | 503514B5.20402@net-b.de |
---|---|
State | New |
Headers | show |
On 22/08/2012 19:19, Tobias Burnus wrote: > 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 that's fine: rank 1 array > (gdb) p ss->dim[0] > $9 = 0 that's fine: the first dimension of the array subreference is the first dimension of the full array. > (gdb) p ss->info->data.array.subscript > $10 = {0x0, 0x15f37f0, 0x0, 0x0, 0x0, 0x0, 0x0} that's fine: there is a (scalar) subscript ss in dimension 1 corresponding to `qcount', and nothing in dimension 0 as there is no vector subscript in that dimension. > > 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. No, it's fine as is. > 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. Yes, that's the way it should be. For example gfc_add_loop_ss_code has already one "brute force" loop about subscripts: case GFC_SS_SECTION: /* Add the expressions for scalar and vector subscripts. */ for (n = 0; n < GFC_MAX_DIMENSIONS; n++) if (info->subscript[n]) gfc_add_loop_ss_code (loop, info->subscript[n], true, where); > > > 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. In general, I prefer having allocation and deallocation at the same scope for clarity. In gfc_conv_expr_descriptor, it makes some sense to throw away ss once it has been used for a loop, so it would be better to have the allocation happen there too. I have reviewed gfc_conv_expr_descriptor calls, and unless I missed some, they all follow the same pattern: ss = gfc_walk_expr (expr); ... gfc_init_se (&se, ...); ... gfc_conv_expr_descriptor (&se, expr, ss); This shows that ss is redundant with expr, so I think the walking should be internal to gfc_conv_expr_descriptor, the ss argument should be removed, and then gfc_conv_array_parameter doesn't need ss any more. I believe it would solve your problem, and make allocation and cleanup happen in the same function, which is nice. I don't think it would avoid invasive changes though. Mikael
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);