[Patch, Fortran] PR 42647: Missed initialization/dealloc of allocatable scalar DT with allocatable component

[Janus Weil]

2010/10/13 Tobias Burnus <burnus@net-b.de>:
>  On 10/13/2010 02:08 PM, Janus Weil wrote:
>>
>> Self-review: Three things were still missing:
>> 1) Auto-deallocation of CLASS components.
>> 2) Auto-deallocation of "sub-components", i.e. stuff like a%b%c.
>> 3) Test cases.
>
> I have not yet had a closer look at the patch, but I think you should also
> take care of the DEALLOCATE statement. Example:
>
> type t
>  integer, allocatable :: p
> end type t
> type(t), allocatable :: a
>
> deallocate(a)
> end
>
> (Allocate left away to make dump cleaner.) The DEALLOCATE is translated into
> the following. You see many accesses to "a.p" which cause a segfault if "a"
> is not allocated - assume
>
>      if (a.p != 0B)
>        {
>          __builtin_free ((void *) a.p);
>        }
>      a.p = 0B;
>      if (a == 0B)         {
>          _gfortran_runtime_error_at
>        }       else         {
>          __builtin_free ((void *) a);
>        }
>      a = 0B;
>
> Hmm, I actually could not make the program crash - even though the dump
> looks wrong.

Yes, you're right. I need to restructure my patch a bit to make it
work also for DEALLOCATE.


> In any case the following program leaks memory (without the "if" line); with
> the "if" line it aborts as "istat" is not zero, without stat= it aborts with
> an error message stating that "a" is not allocated. Expected: No error, no
> valgrind error and istat == 0.
>
> type t
>  integer, allocatable :: p(:)
> end type t
> type(t), allocatable :: a
>
> allocate(a)
> allocate(a%p(10000))
>
> deallocate(a, stat=istat)
> if(istat /= 0) call abort()
> end

This is fixed by the following hunk:

Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c    (revision 165461)
+++ gcc/fortran/trans-stmt.c    (working copy)
@@ -4679,7 +4679,11 @@
          if (!(last && last->u.c.component->attr.pointer)
                && !(!last && expr->symtree->n.sym->attr.pointer))
            {
-             tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, se.expr,
+             if (!expr->rank)
+               tmp = build_fold_indirect_ref_loc (input_location, se.expr);
+             else
+               tmp = se.expr;
+             tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp,
                                               expr->rank);
              gfc_add_expr_to_block (&se.pre, tmp);
            }


Cheers,
Janus