[Fortran] PR37336 - FIINAL patch [1/n]: Implement the finalization wrapper subroutine

Dear all,

attached is a slightly updated patch:

* Call finalizers of nonallocatable, nonpointer components
* Generate FINAL wrapper for abstract types which have a finalizer. (The 
allocatable components are deallocated in the first type (abstract or 
not) which has a finalizer, i.e. abstract + finalizer or first 
nonabstract type.)

I had to disable some resolve warning; I did so by introducing an 
attr.artificial. I used it to also fix PR 51632, where we errored out 
for __def_init and __copy where there were coarray components.

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias

* PING *

On August 19, 2012, Tobias Burnus wrote:
> Dear all,
>
> attached is a slightly updated patch:
>
> * Call finalizers of nonallocatable, nonpointer components
> * Generate FINAL wrapper for abstract types which have a finalizer. 
> (The allocatable components are deallocated in the first type 
> (abstract or not) which has a finalizer, i.e. abstract + finalizer or 
> first nonabstract type.)
>
> I had to disable some resolve warning; I did so by introducing an 
> attr.artificial. I used it to also fix PR 51632, where we errored out 
> for __def_init and __copy where there were coarray components.
>
> Build and regtested on x86-64-linux.
> OK for the trunk?
>
> Tobias

Dear Tobias,

there are some problems with the final-wrapper-v2.diff patch; I get
the following error

final2.f90:71.15:

end module test
               1
Internal Error at (1):
gfc_code2string(): Bad code

for every test case that I use; in attachment final2.f90.

Regards

Alessandro

2012/8/19 Tobias Burnus <burnus@net-b.de>:
> Dear all,
>
> attached is a slightly updated patch:
>
> * Call finalizers of nonallocatable, nonpointer components
> * Generate FINAL wrapper for abstract types which have a finalizer. (The
> allocatable components are deallocated in the first type (abstract or not)
> which has a finalizer, i.e. abstract + finalizer or first nonabstract type.)
>
> I had to disable some resolve warning; I did so by introducing an
> attr.artificial. I used it to also fix PR 51632, where we errored out for
> __def_init and __copy where there were coarray components.
>
> Build and regtested on x86-64-linux.
> OK for the trunk?
>
> Tobias



--

On 19/08/2012 19:50, Tobias Burnus wrote:
> Dear all,
> 
> attached is a slightly updated patch:
> 
> * Call finalizers of nonallocatable, nonpointer components
> * Generate FINAL wrapper for abstract types which have a finalizer. (The
> allocatable components are deallocated in the first type (abstract or
> not) which has a finalizer, i.e. abstract + finalizer or first
> nonabstract type.)
> 
> I had to disable some resolve warning; I did so by introducing an
> attr.artificial. I used it to also fix PR 51632, where we errored out
> for __def_init and __copy where there were coarray components.
> 
> Build and regtested on x86-64-linux.
> OK for the trunk?
> 
> Tobias

Hello,

some general comment:

the patch mixes deallocation and finalization, which are treated
separately in the standard.  I don' know at this point whether it will
make our life really tougher or not, but I think it makes the code
slightly more difficult to read.

I have a mixed general feeling about the patch that
 1. some weird cases are not correctly covered (polymorphic components,
multiple level of finalizable and/or non-finalizable components, of
inheritance, ...)
 2. some of the above "incorrectnesses" may actually cancel each other;
the patch is implemented differently than how I thought it would be. I
may be missing the point after all.

I would like to point out that forcing the wrapper's array argument to
be contiguous will lead to poor code as repacking will be needed with
inherited types to call the parent's wrapper (and the parent's parent's,
etc...).

More specific comments below.

Mikael


> 2012-08-19  Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>
>             Tobias Burnus  <burnus@net-b.de>
> 
> 	PR fortran/37336
> 	* gfortran.h (symbol_attribute): Add artifical and final_comp.
> 	* parse.c (parse_derived): Set final_comp.
> 	* module.c (mio_symbol_attribute): Handle final.comp.
> 	* class.c (gfc_build_class_symbol): Defer creation of the vtab
> 	if the DT has finalizers, mark generated symbols as
> 	attr.artificial.
> 	(finalize_component, finalization_scalarizer,
> 	generate_finalization_wrapper): New static functions.
> 	(gfc_find_derived_vtab): Add _final component and call
> 	generate_finalization_wrapper.
>         * dump-parse-tree.c (show_f2k_derived): Use resolved
> 	proc_tree->n.sym rather than unresolved proc_sym.
> 	* resolve.c (gfc_resolve_finalizers): Remove not-implemented
> 	error and ensure that the vtab exists.
> 	(resolve_fl_derived): Resolve finalizers before
> 	generating the vtab.
> 	(resolve_symbol): Also allow assumed-rank arrays with CONTIGUOUS;
> 	skip artificial symbols.
> 	(resolve_fl_derived0): Skip artificial symbols.
> 
> 2012-08-19  Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>
>             Tobias Burnus  <burnus@net-b.de>
> 
> 	PR fortran/51632
> 	* gfortran.dg/coarray_class_1.f90: New.
> 
> 	PR fortran/37336
> 	* gfortran.dg/coarray_poly_3.f90: Update dg-error.
>  	* gfortran.dg/auto_dealloc_2.f90: Update scan-tree-dump-times.
> 	* gfortran.dg/class_19.f03: Ditto.
> 	* gfortran.dg/finalize_4.f03: Remove dg-excess-errors
> 	for not implemented.
> 	* gfortran.dg/finalize_5.f03: Ditto.
> 	* gfortran.dg/finalize_7.f03: Ditto.
> 
> diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
> index 21a91ba..122cc43 100644
> --- a/gcc/fortran/class.c
> +++ b/gcc/fortran/class.c
> @@ -689,6 +694,672 @@ copy_vtab_proc_comps (gfc_symbol *declared, gfc_symbol *vtype)
>  }
>  
>  
> +/* Call DEALLOCATE for the passed component if it is allocatable, if it is
> +   neither allocatable nor a pointer but has a finalizer, call it. If it
> +   is a nonpointer component with allocatable or finalizes components, walk
> +   them. Either of the is required; other nonallocatables and pointers aren't
> +   handled gracefully.
> +   Note: The DEALLOCATE handling takes care of finalizers, coarray
> +   deregistering and allocatable components of the allocatable.  */
> +
> +void
> +finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
> +		    gfc_expr *stat, gfc_code **code)
> +{
> +  gfc_expr *e;
> +  e = gfc_copy_expr (expr);
> +  e->ref = gfc_get_ref ();
You should walk to the end of the reference chain.  Otherwise you are
overwriting it here.  Unless you avoid recursing, in which case you can
assert it was NULL.

> +  e->ref->type = REF_COMPONENT;
> +  e->ref->u.c.sym = derived;
> +  e->ref->u.c.component = comp;
> +  e->ts = comp->ts;
> +
> +  if (comp->attr.dimension
> +      || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
> +	  && CLASS_DATA (comp)->attr.dimension))
> +    {
> +      e->ref->next = gfc_get_ref ();
> +      e->ref->next->type = REF_ARRAY;
> +      e->ref->next->u.ar.type = AR_FULL;
> +      e->ref->next->u.ar.dimen = 0;
> +      e->ref->next->u.ar.as = comp->ts.type == BT_CLASS ? CLASS_DATA (comp)->as
> +							: comp->as;
> +      e->rank = e->ref->next->u.ar.as->rank;
> +    }
> +
> +  if (comp->attr.allocatable
> +      || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
> +	  && CLASS_DATA (comp)->attr.allocatable))
> +    {
> +      /* Call DEALLOCATE (comp, stat=ignore).  */
> +      gfc_code *dealloc;
> +
> +      dealloc = XCNEW (gfc_code);
> +      dealloc->op = EXEC_DEALLOCATE;
> +      dealloc->loc = gfc_current_locus;
> +
> +      dealloc->ext.alloc.list = gfc_get_alloc ();
> +      dealloc->ext.alloc.list->expr = e;
> +
> +      dealloc->expr1 = stat;
> +      if (*code)
> +	{
> +	  (*code)->next = dealloc;
> +	  (*code) = (*code)->next;
> +	}
> +      else
> +	(*code) = dealloc;
> +    }
> +  else if (comp->ts.type == BT_DERIVED
> +	    && comp->ts.u.derived->f2k_derived
> +	    && comp->ts.u.derived->f2k_derived->finalizers)
What about polymorphic components?
What if only comp's subcomponents are finalizable, the finalization
wrapper should still be called, shouldn't it?

> +    {
> +      /* Call FINAL_WRAPPER (comp);  */
> +      gfc_code *final_wrap;
> +      gfc_symbol *vtab;
> +      gfc_component *c;
> +
> +      vtab = gfc_find_derived_vtab (comp->ts.u.derived);
> +      for (c = vtab->ts.u.derived->components; c; c = c->next)
> +	if (c->name[0] == '_' && c->name[1] == 'f')
> +           break;
> +
> +      gcc_assert (c);
> +      final_wrap = XCNEW (gfc_code);
> +      final_wrap->op = EXEC_CALL;
> +      final_wrap->loc = gfc_current_locus;
> +      final_wrap->next->loc = gfc_current_locus;
> +      final_wrap->next->symtree = c->initializer->symtree;
> +      final_wrap->next->resolved_sym = c->initializer->symtree->n.sym;
> +      final_wrap->next->ext.actual = gfc_get_actual_arglist ();
> +      final_wrap->next->ext.actual->expr = e;
> +
> +      if (*code)
> +	{
> +	  (*code)->next = final_wrap;
> +	  (*code) = (*code)->next;
> +	}
> +      else
> +	(*code) = final_wrap;
> +    }


> +  else
> +    {
> +      gfc_component *c;
> +
> +      gcc_assert ((comp->attr.alloc_comp || comp->attr.final_comp)
> +		  && comp->ts.type != BT_CLASS);
> +      for (c = comp->ts.u.derived->components; c; c = c->next)
> +	if ((comp->ts.type != BT_CLASS && !comp->attr.pointer
> +	     && (comp->attr.alloc_comp || comp->attr.allocatable
> +		 || comp->attr.final_comp))
> +	    || ((comp->ts.type == BT_CLASS && CLASS_DATA (comp)
> +		 && CLASS_DATA (comp)->attr.allocatable)))
> +	  finalize_component (e, comp->ts.u.derived, comp, stat, code);
> +    }
This doesn't work, you use comp instead of c.

If there is a polymorphic component whose declared type is not
finalizable, but whose actual type is, the finalization wrapper should
still be called. So basically one can't just look at the components.

If comp has finalizable subcomponents, it has a finalization wrapper,
which is (or should be) caught above, so this branch is (or should be)
unreachable.

> +}
> +
> +
> +/* Generate code equivalent to
> +   CALL C_F_POINTER (TRANSFER (TRANSFER (C_LOC (array, cptr), c_intptr)
> +		     + idx * STORAGE_SIZE (array)/NUMERIC_STORAGE_SIZE., c_ptr),
> +		     ptr).  */
> +
> +static gfc_code *
> +finalization_scalarizer (gfc_symbol *idx, gfc_symbol *array, gfc_symbol *ptr,
> +			 gfc_namespace *sub_ns)
> +{
> +  gfc_code *block;
> +  gfc_expr *expr, *expr2, *expr3;
> +
> +  /* C_F_POINTER().  */
> +  block = XCNEW (gfc_code);
> +  block->op = EXEC_CALL;
> +  block->loc = gfc_current_locus;


> +  block->symtree = gfc_find_symtree (sub_ns->sym_root, "c_f_pointer");
This is useless...
> +  gfc_get_sym_tree ("c_f_pointer", sub_ns, &block->symtree, true);
... if followed by this. Or maybe you want to assert that symtree is
NULL in between?

[...]

> +
> +
> +/* Generate the wrapper finalization/polymorphic freeing subroutine for the
> +   derived type "derived". The function first calls the approriate FINAL
> +   subroutine, then it DEALLOCATEs (finalizes/frees) the allocatable
> +   components (but not the inherited ones). Last, it calls the wrapper
> +   subroutine of the parent. The generated wrapper procedure takes as argument
> +   an assumed-rank array.
> +   If neither allocatable components nor FINAL subroutines exists, the vtab
> +   will contain a NULL pointer.  */
> +
> +static void
> +generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
> +			       const char *tname, gfc_component *vtab_final)
> +{
> +  gfc_symbol *final, *array, *nelem;
> +  gfc_symbol *ptr = NULL, *idx = NULL;
> +  gfc_component *comp;
> +  gfc_namespace *sub_ns;
> +  gfc_code *last_code;
> +  char name[GFC_MAX_SYMBOL_LEN+1];
> +  bool alloc_comp = false;
This is misnamed, it should be final_comp or something.

> +  gfc_expr *ancestor_wrapper = NULL;
> +
> +  /* Search for the ancestor's finalizers. */
> +  if (derived->attr.extension && derived->components
> +      && (!derived->components->ts.u.derived->attr.abstract
> +	  || derived->components->attr.final_comp))
> +    {
> +      gfc_symbol *vtab;
> +      gfc_component *comp;
> +
> +      vtab = gfc_find_derived_vtab (derived->components->ts.u.derived);
> +      for (comp = vtab->ts.u.derived->components; comp; comp = comp->next)
> +	if (comp->name[0] == '_' && comp->name[1] == 'f')
I have no strong opinion about it, but slightly prefer strcmp (...,
"_final") with regard to readability, and solidity against future vtab
extensions with methods starting with "_f".

> +	  {
> +	    ancestor_wrapper = comp->initializer;
> +	    break;
> +	  }
> +    }
> +
> +  /* No wrapper of the ancestor and no own FINAL subroutines and
> +     allocatable components: Return a NULL() expression.  */
> +  if ((!ancestor_wrapper || ancestor_wrapper->expr_type == EXPR_NULL)
> +      && !derived->attr.alloc_comp
shouldn't there be `&& !derived->attr.final_comp' also?

> +      && (!derived->f2k_derived || !derived->f2k_derived->finalizers))
> +    {
> +      vtab_final->initializer = gfc_get_null_expr (NULL);
> +      return;
> +    }
> +
> +  /* Check whether there are new allocatable components.  */
> +  for (comp = derived->components; comp; comp = comp->next)
> +    {
> +      if (comp == derived->components && derived->attr.extension
> +	  && ancestor_wrapper && ancestor_wrapper->expr_type != EXPR_NULL)
> +	continue;
> +
> +      if (comp->ts.type != BT_CLASS && !comp->attr.pointer
> +	  && (comp->attr.alloc_comp || comp->attr.allocatable
> +	      || comp->attr.final_comp))
> +	alloc_comp = true;

> +      else if (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
> +	       && CLASS_DATA (comp)->attr.allocatable)
> +	alloc_comp = true;
Shouldn't one assume without condition that there are allocatable or
finalizable subcomponents when there is a polymorphic component?
Same further below.

> +    }
> +
> +  /* If there is no new finalizer and no new allocatable, return with
> +     an expr to the ancestor's one.  */
> +  if ((!derived->f2k_derived || !derived->f2k_derived->finalizers)
> +      && !alloc_comp)
> +    {
> +      vtab_final->initializer = gfc_copy_expr (ancestor_wrapper);
> +      return;
> +    }
> +
> +  /* We now create a wrapper, which does the following:
> +     1. It calls the suitable finalization subroutine for this type
> +     2. In a loop over all noninherited allocatable components and noninherited
> +	components with allocatable components and DEALLOCATE those; this will
> +	take care of finalizers, coarray deregistering and allocatable
> +	nested components.
> +     3. Call the ancestor's finalizer.  */
> +
> +  /* Declare the wrapper function; it takes an assumed-rank array
> +     as argument. */
> +
> +  /* Set up the namespace.  */
> +  sub_ns = gfc_get_namespace (ns, 0);
> +  sub_ns->sibling = ns->contained;
> +  ns->contained = sub_ns;
> +  sub_ns->resolved = 1;
> +
> +  /* Set up the procedure symbol.  */
> +  sprintf (name, "__final_%s", tname);
> +  gfc_get_symbol (name, sub_ns, &final);
> +  sub_ns->proc_name = final;
> +  final->attr.flavor = FL_PROCEDURE;
> +  final->attr.subroutine = 1;
> +  final->attr.pure = 1;
> +  final->attr.artificial = 1;
> +  final->attr.if_source = IFSRC_DECL;
> +  if (ns->proc_name->attr.flavor == FL_MODULE)
> +    final->module = ns->proc_name->name;
> +  gfc_set_sym_referenced (final);
> +
> +  /* Set up formal argument.  */
> +  gfc_get_symbol ("array", sub_ns, &array);
> +  array->ts.type = BT_DERIVED;
> +  array->ts.u.derived = derived;
> +  array->attr.flavor = FL_VARIABLE;
> +  array->attr.dummy = 1;
> +  array->attr.contiguous = 1;
> +  array->attr.dimension = 1;
> +  array->attr.artificial = 1;
> +  array->as = gfc_get_array_spec();
> +  array->as->type = AS_ASSUMED_RANK;
> +  array->as->rank = -1;
> +  array->attr.intent = INTENT_INOUT;
> +  gfc_set_sym_referenced (array);
> +  final->formal = gfc_get_formal_arglist ();
> +  final->formal->sym = array;
> +  gfc_commit_symbol (array);
> +
> +  /* Obtain the size (number of elements) of "array" MINUS ONE,
> +     which is used in the scalarization.  */
> +  gfc_get_symbol ("nelem", sub_ns, &nelem);
> +  nelem->ts.type = BT_INTEGER;
> +  nelem->ts.kind = gfc_index_integer_kind;
> +  nelem->attr.flavor = FL_VARIABLE;
> +  nelem->attr.artificial = 1;
> +  gfc_set_sym_referenced (nelem);
> +  gfc_commit_symbol (nelem);
> +
> +  /* Generate: nelem = SIZE (array) - 1.  */
> +  last_code = XCNEW (gfc_code);
> +  last_code->op = EXEC_ASSIGN;
> +  last_code->loc = gfc_current_locus;
> +
> +  last_code->expr1 = gfc_lval_expr_from_sym (nelem);
> +
> +  last_code->expr2 = gfc_get_expr ();
> +  last_code->expr2->expr_type = EXPR_OP;
> +  last_code->expr2->value.op.op = INTRINSIC_MINUS;
> +  last_code->expr2->value.op.op2
> +	= gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
> +  last_code->expr2->ts = last_code->expr2->value.op.op2->ts;
> +
> +  last_code->expr2->value.op.op1 = gfc_get_expr ();
> +  last_code->expr2->value.op.op1->expr_type = EXPR_FUNCTION;
> +  last_code->expr2->value.op.op1->value.function.isym
> +	= gfc_intrinsic_function_by_id (GFC_ISYM_SIZE);
> +  last_code->expr2->value.op.op1->symtree
> +	= gfc_find_symtree (sub_ns->sym_root, "size");
> +  gfc_get_sym_tree ("size", sub_ns, &last_code->expr2->value.op.op1->symtree,
> +		    false);
> +  last_code->expr2->value.op.op1->symtree->n.sym->attr.flavor = FL_PROCEDURE;
> +  last_code->expr2->value.op.op1->symtree->n.sym->attr.intrinsic = 1;
> +  gfc_commit_symbol (last_code->expr2->value.op.op1->symtree->n.sym);
> +  last_code->expr2->value.op.op1->value.function.actual
> +	= gfc_get_actual_arglist ();
> +  last_code->expr2->value.op.op1->value.function.actual->expr
> +	= gfc_lval_expr_from_sym (array);
> +  /* dim=NULL. */
> +  last_code->expr2->value.op.op1->value.function.actual->next
> +	= gfc_get_actual_arglist ();
> +  /* kind=c_intptr_t. */
> +  last_code->expr2->value.op.op1->value.function.actual->next->next
> +	= gfc_get_actual_arglist ();
> +  last_code->expr2->value.op.op1->value.function.actual->next->next->expr
> +	= gfc_get_int_expr (gfc_index_integer_kind, NULL, 0);
> +  last_code->expr2->value.op.op1->ts
> +	= last_code->expr2->value.op.op1->value.function.isym->ts;
> +
> +  sub_ns->code = last_code;
> +
> +  /* Call final subroutines. We now generate code like:
> +     use iso_c_binding
> +     integer, pointer :: ptr
> +     type(c_ptr) :: cptr
> +     integer(c_intptr_t) :: i, addr
> +
> +     select case (rank (array))
> +       case (3)
> +         call final_rank3 (array)
> +       case default:
> +	 do i = 0, size (array)-1
> +	   addr = transfer (c_loc (array), addr) + i * STORAGE_SIZE (array)
> +	   call c_f_pointer (transfer (addr, cptr), ptr)
> +	   call elemental_final (ptr)
> +	 end do
> +     end select */
> +
> +  if (derived->f2k_derived && derived->f2k_derived->finalizers)
> +    {
> +      gfc_finalizer *fini, *fini_elem = NULL;
> +      gfc_code *block = NULL;
> +
> +      /* SELECT CASE (RANK (array)).  */
> +      last_code->next = XCNEW (gfc_code);
> +      last_code = last_code->next;
> +      last_code->op = EXEC_SELECT;
> +      last_code->loc = gfc_current_locus;
> +
> +      last_code->expr1 = gfc_get_expr ();
> +      last_code->expr1->expr_type = EXPR_FUNCTION;
> +      last_code->expr1->value.function.isym
> +	    = gfc_intrinsic_function_by_id (GFC_ISYM_RANK);
> +      last_code->expr1->symtree = gfc_find_symtree (sub_ns->sym_root, "rank");
> +      gfc_get_sym_tree ("rank", sub_ns, &last_code->expr1->symtree,
> +			false);
> +      last_code->expr1->symtree->n.sym->attr.flavor = FL_PROCEDURE;
> +      last_code->expr1->symtree->n.sym->attr.intrinsic = 1;
> +      gfc_commit_symbol (last_code->expr1->symtree->n.sym);
> +      last_code->expr1->value.function.actual = gfc_get_actual_arglist ();
> +      last_code->expr1->value.function.actual->expr
> +	    = gfc_lval_expr_from_sym (array);
> +      last_code->expr1->ts = last_code->expr1->value.function.isym->ts;
> +
> +      for (fini = derived->f2k_derived->finalizers; fini; fini = fini->next)
> +	{
> +	  if (fini->proc_tree->n.sym->attr.elemental)
> +	    {
> +	      fini_elem = fini;
> +	      continue;
> +            }
> +
> +	  /* CASE (fini_rank).  */
> +	  if (block)
> +	    {
> +	      block->block = XCNEW (gfc_code);
> +	      block = block->block;
> +	    }
> +          else
> +	    {
> +	      block = XCNEW (gfc_code);
> +	      last_code->block = block;
> +	    }
> +	  block->loc = gfc_current_locus;
> +	  block->op = EXEC_SELECT;
> +	  block->ext.block.case_list = gfc_get_case ();
> +          block->ext.block.case_list->where = gfc_current_locus;
> +	  if (fini->proc_tree->n.sym->formal->sym->attr.dimension)
> +	    block->ext.block.case_list->low
> +	     = gfc_get_int_expr (gfc_default_integer_kind, NULL,
> +				 fini->proc_tree->n.sym->formal->sym->as->rank);
> +	  else
> +	    block->ext.block.case_list->low
> +		= gfc_get_int_expr (gfc_default_integer_kind, NULL, 0);
> +	  block->ext.block.case_list->high
> +		= block->ext.block.case_list->low;
> +
> +          /* CALL fini_rank (array).  */
> +	  block->next = XCNEW (gfc_code);
> +	  block->next->op = EXEC_CALL;
> +	  block->next->loc = gfc_current_locus;
> +	  block->next->symtree = fini->proc_tree;
> +	  block->next->resolved_sym = fini->proc_tree->n.sym;
> +	  block->next->ext.actual = gfc_get_actual_arglist ();
> +	  block->next->ext.actual->expr = gfc_lval_expr_from_sym (array);
> +	}
> +
> +      /* Elemental call - scalarized.  */
> +      if (fini_elem)
> +	{
> +	  gfc_iterator *iter;
> +
> +	  /* CASE DEFAULT.  */
> +	  if (block)
> +	    {
> +	      block->block = XCNEW (gfc_code);
> +	      block = block->block;
> +	    }
> +	  else
> +	    {
> +	      block = XCNEW (gfc_code);
> +	      last_code->block = block;
> +	    }
> +	  block->loc = gfc_current_locus;
> +	  block->op = EXEC_SELECT;
> +	  block->ext.block.case_list = gfc_get_case ();
> +
> +	  gfc_get_symbol ("idx", sub_ns, &idx);
> +	  idx->ts.type = BT_INTEGER;
> +	  idx->ts.kind = gfc_index_integer_kind;
> +	  idx->attr.flavor = FL_VARIABLE;
> +	  idx->attr.artificial = 1;
> +	  gfc_set_sym_referenced (idx);
> +	  gfc_commit_symbol (idx);
> +
> +	  gfc_get_symbol ("ptr", sub_ns, &ptr);
> +	  ptr->ts.type = BT_DERIVED;
> +	  ptr->ts.u.derived = derived;
> +	  ptr->attr.flavor = FL_VARIABLE;
> +	  ptr->attr.pointer = 1;
> +	  ptr->attr.artificial = 1;
> +	  gfc_set_sym_referenced (ptr);
> +	  gfc_commit_symbol (ptr);
> +
> +	  /* Create loop.  */
> +	  iter = gfc_get_iterator ();
> +	  iter->var = gfc_lval_expr_from_sym (idx);
> +	  iter->start = gfc_get_int_expr (gfc_index_integer_kind, NULL, 0);
> +	  iter->end = gfc_lval_expr_from_sym (nelem);
> +	  iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
> +	  block->next = XCNEW (gfc_code);
> +	  block = block->next;
> +	  block->op = EXEC_DO;
> +	  block->loc = gfc_current_locus;
> +	  block->ext.iterator = iter;
> +	  block->block = gfc_get_code ();
> +	  block->block->op = EXEC_DO;
> +
> +          /* Create code for
> +	     CALL C_F_POINTER (TRANSFER (TRANSFER (C_LOC (array, cptr), c_intptr)
> +			   + idx * STORAGE_SIZE (array), c_ptr), ptr).  */
> +	  block->block->next = finalization_scalarizer (idx, array, ptr, sub_ns);
> +	  block = block->block->next;
> +
> +	  /* CALL final_elemental (array).  */
> +	  block->next = XCNEW (gfc_code);
> +	  block = block->next;
> +	  block->op = EXEC_CALL;
> +	  block->loc = gfc_current_locus;
> +	  block->symtree = fini_elem->proc_tree;
> +	  block->resolved_sym = fini_elem->proc_sym;
> +	  block->ext.actual = gfc_get_actual_arglist ();
> +	  block->ext.actual->expr = gfc_lval_expr_from_sym (ptr);
> +	}
> +    }
> +
> +  /* Finalize and deallocate allocatable components. The same manual
> +     scalarization is used as above.  */
> +
> +  if (alloc_comp)
> +    {
> +      gfc_symbol *stat;
> +      gfc_code *block = NULL;
> +      gfc_iterator *iter;
> +
> +      if (!idx)
> +	{
> +	  gfc_get_symbol ("idx", sub_ns, &idx);
> +	  idx->ts.type = BT_INTEGER;
> +	  idx->ts.kind = gfc_index_integer_kind;
> +	  idx->attr.flavor = FL_VARIABLE;
> +	  idx->attr.artificial = 1;
> +	  gfc_set_sym_referenced (idx);
> +	  gfc_commit_symbol (idx);
> +	}
> +
> +      if (!ptr)
> +	{
> +	  gfc_get_symbol ("ptr", sub_ns, &ptr);
> +	  ptr->ts.type = BT_DERIVED;
> +	  ptr->ts.u.derived = derived;
> +	  ptr->attr.flavor = FL_VARIABLE;
> +	  ptr->attr.pointer = 1;
> +	  ptr->attr.artificial = 1;
> +	  gfc_set_sym_referenced (ptr);
> +	  gfc_commit_symbol (ptr);
> +	}
> +
> +      gfc_get_symbol ("ignore", sub_ns, &stat);
> +      stat->attr.flavor = FL_VARIABLE;
> +      stat->attr.artificial = 1;
> +      stat->ts.type = BT_INTEGER;
> +      stat->ts.kind = gfc_default_integer_kind;
> +      gfc_set_sym_referenced (stat);
> +      gfc_commit_symbol (stat);
> +
> +      /* Create loop.  */
> +      iter = gfc_get_iterator ();
> +      iter->var = gfc_lval_expr_from_sym (idx);
> +      iter->start = gfc_get_int_expr (gfc_index_integer_kind, NULL, 0);
> +      iter->end = gfc_lval_expr_from_sym (nelem);
> +      iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
> +      last_code->next = XCNEW (gfc_code);
> +      last_code = last_code->next;
> +      last_code->op = EXEC_DO;
> +      last_code->loc = gfc_current_locus;
> +      last_code->ext.iterator = iter;
> +      last_code->block = gfc_get_code ();
> +      last_code->block->op = EXEC_DO;
> +
> +      /* Create code for
> +	 CALL C_F_POINTER (TRANSFER (TRANSFER (C_LOC (array, cptr), c_intptr)
> +			   + idx * STORAGE_SIZE (array), c_ptr), ptr).  */
> +      last_code->block->next = finalization_scalarizer (idx, array, ptr, sub_ns);
> +      block = last_code->block->next;
> +
> +      for (comp = derived->components; comp; comp = comp->next)
> +	{
> +	  if (comp == derived->components && derived->attr.extension
> +	      && ancestor_wrapper && ancestor_wrapper->expr_type != EXPR_NULL)
> +	    continue;
> +
> +	  if ((comp->ts.type != BT_CLASS && !comp->attr.pointer
> +	       && (comp->attr.alloc_comp || comp->attr.allocatable
> +		   || comp->attr.final_comp))
> +	      || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
> +		  && CLASS_DATA (comp)->attr.allocatable))
> +	    {
> +	      finalize_component (gfc_lval_expr_from_sym (ptr), derived, comp,
> +				  gfc_lval_expr_from_sym (stat), &block);
> +	      if (!last_code->block->next)
> +		last_code->block->next = block;
> +	    }
> +	}
> +    }
> +
> +  /* Call the finalizer of the ancestor.  */
> +  if (ancestor_wrapper && ancestor_wrapper->expr_type != EXPR_NULL)
> +    {
> +      last_code->next = XCNEW (gfc_code);
> +      last_code = last_code->next;
> +      last_code->op = EXEC_CALL;
> +      last_code->loc = gfc_current_locus;
> +      last_code->symtree = ancestor_wrapper->symtree;
> +      last_code->resolved_sym = ancestor_wrapper->symtree->n.sym;
> +
> +      last_code->ext.actual = gfc_get_actual_arglist ();
> +      last_code->ext.actual->expr = gfc_lval_expr_from_sym (array);
I think a reference to the parent component is missing.

> +    }
> +
> +  gfc_commit_symbol (final);
> +  vtab_final->initializer = gfc_lval_expr_from_sym (final);
> +  vtab_final->ts.interface = final;
> +}
> +
> +
>  /* Add procedure pointers for all type-bound procedures to a vtab.  */
>  
>  static void

> diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
> index 44b1900..4cafefe 100644
> --- a/gcc/fortran/parse.c
> +++ b/gcc/fortran/parse.c
> @@ -2250,6 +2250,16 @@ endType:
>  	  sym->attr.lock_comp = 1;
>  	}
>  
> +      /* Look for finalizers.  */
> +      if (c->attr.final_comp
c->attr.final_comp is never set.

I would like to avoid if possible yet another symbol attribute set in
three different functions in three different files and used all over the
place.  What about using a function "calculating" the predicate this time?

> +	  || (c->ts.type == BT_CLASS && c->attr.class_ok
> +	      && CLASS_DATA (c)->ts.u.derived->f2k_derived
> +	      && CLASS_DATA (c)->ts.u.derived->f2k_derived->finalizers)
> +	  || (c->ts.type == BT_DERIVED
> +	      && c->ts.u.derived->f2k_derived
> +	      && c->ts.u.derived->f2k_derived->finalizers))
> +	sym->attr.final_comp = 1;
> +
>        /* Check for F2008, C1302 - and recall that pointers may not be coarrays
>  	 (5.3.14) and that subobjects of coarray are coarray themselves (2.4.7),
>  	 unless there are nondirect [allocatable or pointer] components

Dear Mikael, dear all,

Mikael Morin wrote:
> the patch mixes deallocation and finalization, which are treated
> separately in the standard.

First, I want to remark that the standard - in many cases - does not 
require memory freeing ("deallocation"), it "merely" makes it possible 
that one does not leak memory with allocatables. The actually freeing of 
the memory is just a matter of the qualify of the implementation.

Secondly, for a polymorphic type, one does not know at compile time 
whether it has allocatable components or not - nor whether it has a 
finalizer or not. Hence, I do not see another possibility to have a 
common _free/_final entry point in the vtable. As there has to be a 
common entry point, I think it makes sense to have a single finalization 
wrapper which handles both. (I had also initially thought, that one 
could handle those two cases separately, but now I don't see it anymore.)

>   1. some weird cases are not correctly covered (polymorphic components,
> multiple level of finalizable and/or non-finalizable components, of
> inheritance, ...)

I do believe that polymorphic components are correctly handled: If they 
are a POINTER, they are untouched but if they are ALLOCATABLE, one calls 
DEALLOCATE for the component, which should handle the 
finalization/deallocation correctly. (And nonallocatble, nonpointer 
components do not exist.)

> I would like to point out that forcing the wrapper's array argument to
> be contiguous will lead to poor code as repacking will be needed with
> inherited types to call the parent's wrapper (and the parent's parent's,
> etc...).

I think that's unavoidable with the current array descriptor, which 
assumes that the stride is always a multiple of the size of the type. I 
concur that with the new array descriptor, one restrict the 
copy-in/copy-out to calling explict-shape/assumed-size finalizers, which 
probably do not occur in practice.


> >+finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
> >+  e = gfc_copy_expr (expr);
> >+  e->ref = gfc_get_ref ();
> You should walk to the end of the reference chain.  Otherwise you are
> overwriting it here.

I will do this.

>> >+  if (comp->attr.allocatable
>> >+      || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
>> >+	  && CLASS_DATA (comp)->attr.allocatable))
>> >+    {
>>
>> >+    }
>> >+  else if (comp->ts.type == BT_DERIVED
>> >+	    && comp->ts.u.derived->f2k_derived
>> >+	    && comp->ts.u.derived->f2k_derived->finalizers)
> What about polymorphic components?

I have to admit that the code is a bit implicit: polymorphic components 
are either ALLOCATABLE - and hence handled in the "if" block, or they 
are pointers - in which case this function is not called at all.

> What if only comp's subcomponents are finalizable, the finalization
> wrapper should still be called, shouldn't it?

Well, that's handled in the "else" branch. There, I walk all 
subcomponents. I do not need to walk them in case there is a finalizer 
as the called finalization wrapper will handle them.

>> >+  else
>> >+    {
>> >+      gfc_component *c;
>> >+
>> >+      gcc_assert ((comp->attr.alloc_comp || comp->attr.final_comp)
>> >+		  && comp->ts.type != BT_CLASS);
>> >+      for (c = comp->ts.u.derived->components; c; c = c->next)
>> >+	if ((comp->ts.type != BT_CLASS && !comp->attr.pointer
>> >+	     && (comp->attr.alloc_comp || comp->attr.allocatable
>> >+		 || comp->attr.final_comp))
>> >+	    || ((comp->ts.type == BT_CLASS && CLASS_DATA (comp)
>> >+		 && CLASS_DATA (comp)->attr.allocatable)))
>> >+	  finalize_component (e, comp->ts.u.derived, comp, stat, code);
>> >+    }
> This doesn't work, you use comp instead of c.

I hate copy-and-paste bugs. Thanks.

> If there is a polymorphic component whose declared type is not
> finalizable, but whose actual type is, the finalization wrapper should
> still be called.

But it will, as written above, polymorphic components are allocatable 
(or they are pointers and won't get finalized).

> If comp has finalizable subcomponents, it has a finalization wrapper,
> which is (or should be) caught above, so this branch is (or should be)
> unreachable.

I probably miss something, but I don't see why this branch should be 
unreachable. One has:

if (component is allocatable)
   call DEALLOCATE(comp) ! which might invoke finalizers
else if (component itself has a finalizer)
   call FINAL_WRAPPER
else
    for all nonpointer subcomponents which are allocatables, have 
finalizers or have allocatable/finalizable components, call 
finalize_component.
end if


>> >+  block->symtree = gfc_find_symtree (sub_ns->sym_root, "c_f_pointer");
> This is useless...

I concur.

>> >+  bool alloc_comp = false;
> This is misnamed, it should be final_comp or something.

I concur, its use became extended during the development of the patch.

>
>> >+      for (comp = vtab->ts.u.derived->components; comp; comp = comp->next)
>> >+	if (comp->name[0] == '_' && comp->name[1] == 'f')
> I have no strong opinion about it, but slightly prefer strcmp (...,
> "_final") with regard to readability, and solidity against future vtab
> extensions with methods starting with "_f".

Maybe. "_" && "f" should be faster and I don't see us adding more vtable 
functions. on the other hand, strcmp is safer and clearer. I also don't 
have a strong opinion about that.


>
>> >+	  {
>> >+	    ancestor_wrapper = comp->initializer;
>> >+	    break;
>> >+	  }
>> >+    }
>> >+
>> >+  /* No wrapper of the ancestor and no own FINAL subroutines and
>> >+     allocatable components: Return a NULL() expression.  */
>> >+  if ((!ancestor_wrapper || ancestor_wrapper->expr_type == EXPR_NULL)
>> >+      && !derived->attr.alloc_comp
> shouldn't there be `&& !derived->attr.final_comp' also?

I concur; I forgot that line when I retrofitted the case that there is a 
finalizer but no allocatable componet.


>> >+      else if (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
>> >+	       && CLASS_DATA (comp)->attr.allocatable)
>> >+	alloc_comp = true;
> Shouldn't one assume without condition that there are allocatable or
> finalizable subcomponents when there is a polymorphic component?

Well, we do not deallocate/finalize polymorphic POINTER components.

>> >+  if (ancestor_wrapper && ancestor_wrapper->expr_type != EXPR_NULL)
>> >+    {
>> >+      last_code->next = XCNEW (gfc_code);
>> >+      last_code = last_code->next;
>> >+      last_code->op = EXEC_CALL;
>> >+      last_code->loc = gfc_current_locus;
>> >+      last_code->symtree = ancestor_wrapper->symtree;
>> >+      last_code->resolved_sym = ancestor_wrapper->symtree->n.sym;
>> >+
>> >+      last_code->ext.actual = gfc_get_actual_arglist ();
>> >+      last_code->ext.actual->expr = gfc_lval_expr_from_sym (array);
> I think a reference to the parent component is missing.

Actually, for a scalar it does not matter and for nonscalars, I still 
need to write the pack/unpack support. For the latter, I am not yet sure 
how to handle it best. As the Fortran standard doesn't allow 
"assumed_rank%comp", this case has to be handled in some special way.

>> >diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
>> >index 44b1900..4cafefe 100644
>> >--- a/gcc/fortran/parse.c
>> >+++ b/gcc/fortran/parse.c
>> >@@ -2250,6 +2250,16 @@ endType:
>> >  	  sym->attr.lock_comp = 1;
>> >  	}
>> >  
>> >+      /* Look for finalizers.  */
>> >+      if (c->attr.final_comp
> c->attr.final_comp is never set.
>
> I would like to avoid if possible yet another symbol attribute set in
> three different functions in three different files and used all over the
> place.  What about using a function "calculating" the predicate this time?

Maybe, however, one has then to call the function a lot of times: In 
generate_finalization_wrapper for the whole type, then for the new added 
components, and then for each component in finalize_component. With the 
current code, the latter has a complexity of approx. O(n lg n), but one 
might be able to improve it a bit by restructuring the code. (On the 
other hand, "n" is probably not excessively large.)

Tobias

On 25/08/2012 17:21, Tobias Burnus wrote:
> (And nonallocatble, nonpointer
> components do not exist.)
I missed that indeed.

>> What if only comp's subcomponents are finalizable, the finalization
>> wrapper should still be called, shouldn't it?
> 
> Well, that's handled in the "else" branch. There, I walk all
> subcomponents. I do not need to walk them in case there is a finalizer
> as the called finalization wrapper will handle them.
Actually, I don't understand why you walk twice over the subcomponents:
in the else branch here and in the finalizer.

>> If comp has finalizable subcomponents, it has a finalization wrapper,
>> which is (or should be) caught above, so this branch is (or should be)
>> unreachable.
> 
> I probably miss something, but I don't see why this branch should be
> unreachable. One has:
> 
> if (component is allocatable)
>   call DEALLOCATE(comp) ! which might invoke finalizers
> else if (component itself has a finalizer)
>   call FINAL_WRAPPER
> else
>    for all nonpointer subcomponents which are allocatables, have
> finalizers or have allocatable/finalizable components, call
> finalize_component.
> end if

I expected something like:
if (allocatable)
  call deallocate (comp)
else if (finalizer or subcomponents have a finalizer)
  call FINAL_WRAPPER

As said above, I don't understand why you would walk over the components
twice

>>> >+      else if (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
>>> >+           && CLASS_DATA (comp)->attr.allocatable)
>>> >+    alloc_comp = true;
>> Shouldn't one assume without condition that there are allocatable or
>> finalizable subcomponents when there is a polymorphic component?
> 
> Well, we do not deallocate/finalize polymorphic POINTER components.
Indeed, then I prefer having !CLASS_DATA(comp)->attr.pointer.


>>> >diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
>>> >index 44b1900..4cafefe 100644
>>> >--- a/gcc/fortran/parse.c
>>> >+++ b/gcc/fortran/parse.c
>>> >@@ -2250,6 +2250,16 @@ endType:
>>> >        sym->attr.lock_comp = 1;
>>> >      }
>>> >  >+      /* Look for finalizers.  */
>>> >+      if (c->attr.final_comp
>> c->attr.final_comp is never set.
>>
>> I would like to avoid if possible yet another symbol attribute set in
>> three different functions in three different files and used all over the
>> place.  What about using a function "calculating" the predicate this
>> time?
> 
> Maybe, however, one has then to call the function a lot of times: In
> generate_finalization_wrapper for the whole type, then for the new added
> components, and then for each component in finalize_component. With the
> current code, the latter has a complexity of approx. O(n lg n), but one
> might be able to improve it a bit by restructuring the code. (On the
> other hand, "n" is probably not excessively large.)
> 
If performance is a problem, the function could use the flag as a
backend.  As long as the field is used and set in a single place, I
don't mind.  I don't have a strong opinion either, there is already a
full bag of flags; one more wouldn't make things dramatically worse.

Mikael

Mikael Morin wrote:
>>> What if only comp's subcomponents are finalizable, the finalization
>>> wrapper should still be called, shouldn't it?
>> Well, that's handled in the "else" branch. There, I walk all
>> subcomponents. I do not need to walk them in case there is a finalizer
>> as the called finalization wrapper will handle them.
> Actually, I don't understand why you walk twice over the subcomponents:
> in the else branch here and in the finalizer.

Well, I only walk once per component. However, I could unconditionally 
call this function – and move some of the checks from the main program here.

>>> If comp has finalizable subcomponents, it has a finalization wrapper,
>>> which is (or should be) caught above, so this branch is (or should be)
>>> unreachable.
>> I probably miss something, but I don't see why this branch should be
>> unreachable. One has:
>>
>> if (component is allocatable)
>>    call DEALLOCATE(comp) ! which might invoke finalizers
>> else if (component itself has a finalizer)
>>    call FINAL_WRAPPER
>> else
>>     for all nonpointer subcomponents which are allocatables, have
>> finalizers or have allocatable/finalizable components, call
>> finalize_component.
>> end if
> I expected something like:
> if (allocatable)
>    call deallocate (comp)
> else if (finalizer or subcomponents have a finalizer)
>    call FINAL_WRAPPER

Well, the question is whether one wants to call a finalize wrapper for a 
simple "comp%alloctable_int(10)" or not. In the current scheme, I tried 
to avoid calling a finalizer wrapper for simple allocatable components.

Thus, one has the choice:
a) Directly call DEALLOCATE for alloctable components of subcomponents
b) Always call the finalizer wrapper – also for nonalloctable TYPEs 
(with finalizable/allocatable components)

(a) is more direct and possibly a bit faster while (b) makes the wrapper 
function a tad smaller.


> As said above, I don't understand why you would walk over the components
> twice

I don't. I touch every ((sub)sub)component only once; I only do a deep 
walk until there is either no component or a pointer or an allocatable 
or a finalizable component. I do acknowledge that I repeat some of the 
logic by handling the outer component in the wrapper and the inner 
(sub)subcomponents in the final_components.

>>>>> +      else if (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
>>>>> +           && CLASS_DATA (comp)->attr.allocatable)
>>>>> +    alloc_comp = true;
>>> Shouldn't one assume without condition that there are allocatable or
>>> finalizable subcomponents when there is a polymorphic component?
>> Well, we do not deallocate/finalize polymorphic POINTER components.
> Indeed, then I prefer having !CLASS_DATA(comp)->attr.pointer.

Okay, that's equivalent; though, I have to admit that I prefer the 
current version, which I regard as cleaner.

  * * *

Regarding the flag or nonflag final_comp, I have to admit that I still 
do not completely understand how you would implement it.

One option would be something like the following

bool has_final_comp(derived) {
   for (comp = derived->components; comp; comp = comp->next)
   {
    if (comp->attr.pointer)
      continue;
     if (comp->f2k_derived->finalizers || comp->ts.type == BT_CLASS)
       return true;
     if (comp->ts.type == BT_DERIVED
         && has_final_comp(comp->ts.u.derived))
      return true;
   }
   return false
}

in class.c

Another is the version which gets set in parse.c.

However, I do not understand what you mean by:

> If performance is a problem, the function could use the flag as a
> backend.  As long as the field is used and set in a single place, I
> don't mind.  I don't have a strong opinion either, there is already a
> full bag of flags; one more wouldn't make things dramatically worse.


Tobias

On 25/08/2012 22:06, Tobias Burnus wrote:
>>>> If comp has finalizable subcomponents, it has a finalization
>>>> wrapper, which is (or should be) caught above, so this branch
>>>> is (or should be) unreachable.
>>> I probably miss something, but I don't see why this branch should
>>> be unreachable. One has:
>>> 
>>> if (component is allocatable) call DEALLOCATE(comp) ! which might
>>> invoke finalizers else if (component itself has a finalizer) call
>>> FINAL_WRAPPER else for all nonpointer subcomponents which are
>>> allocatables, have finalizers or have allocatable/finalizable
>>> components, call finalize_component. end if
>> I expected something like: if (allocatable) call deallocate (comp) 
>> else if (finalizer or subcomponents have a finalizer) call
>> FINAL_WRAPPER
> 
> Well, the question is whether one wants to call a finalize wrapper
> for a simple "comp%alloctable_int(10)" or not. In the current scheme,
> I tried to avoid calling a finalizer wrapper for simple allocatable
> components.
> 
> Thus, one has the choice: a) Directly call DEALLOCATE for alloctable
> components of subcomponents b) Always call the finalizer wrapper –
> also for nonalloctable TYPEs (with finalizable/allocatable
> components)
> 
> (a) is more direct and possibly a bit faster while (b) makes the
> wrapper function a tad smaller.
OK, this is a deliberate choice of implementation to avoid call
overhead. I slightly prefer (b), but we can keep (a).
I'm fine with (a) if the code walking the components is shared - which
avoids c vs. comp issues by the way ;-) .

> * * *
> 
> Regarding the flag or nonflag final_comp, I have to admit that I
> still do not completely understand how you would implement it.
> 
> One option would be something like the following
> 
> bool has_final_comp(derived) { for (comp = derived->components; comp;
> comp = comp->next) { if (comp->attr.pointer) continue; if
> (comp->f2k_derived->finalizers || comp->ts.type == BT_CLASS) return
> true; if (comp->ts.type == BT_DERIVED &&
> has_final_comp(comp->ts.u.derived)) return true; } return false }
This was my initial proposition. The benefit is it is very clear how it
works compared to manual setting the flag here and there.
As you raised a performance issue, I proposed something like this:

bool has_final_comp(derived) {
  bool retval = false;

  if (derived->cache.final_comp_set)
    return derived->cache.final_comp;

  for (comp = derived->components; comp; comp = comp->next)
  {
   if (comp->attr.pointer)
     continue;
    if (comp->f2k_derived->finalizers || comp->ts.type == BT_CLASS)
      {
        retval = true;
        break;
      }
    if (comp->ts.type == BT_DERIVED
        && has_final_comp(comp->ts.u.derived))
      {
        retval = true;
        break;
      }
  }
  derived->cache.final_comp_set = 1;
  derived->cache.final_comp = retval;
  return retval;
}

It's no big deal anyway.
I dream of a compiler where all the non-standard symbol attribute flags,
expression rank and typespec, etc, would be implemented like this... No
need for resolution, etc; it would just work everywhere.
I know the story, patches welcome; they may come, one day...

Mikael

Hi Mikael,

Is this patch approved?  I realize it's not the final step (no pun
intended), but I will be very excited to see this hit the trunk.
Supporting FINAL will have broad impact on my work and the work of others
writing modern Fortran libraries and applications.

Damian

On 8/25/12 1:42 PM, "Mikael Morin" <mikael.morin@sfr.fr> wrote:

>On 25/08/2012 22:06, Tobias Burnus wrote:
>>>>> If comp has finalizable subcomponents, it has a finalization
>>>>> wrapper, which is (or should be) caught above, so this branch
>>>>> is (or should be) unreachable.
>>>> I probably miss something, but I don't see why this branch should
>>>> be unreachable. One has:
>>>> 
>>>> if (component is allocatable) call DEALLOCATE(comp) ! which might
>>>> invoke finalizers else if (component itself has a finalizer) call
>>>> FINAL_WRAPPER else for all nonpointer subcomponents which are
>>>> allocatables, have finalizers or have allocatable/finalizable
>>>> components, call finalize_component. end if
>>> I expected something like: if (allocatable) call deallocate (comp)
>>> else if (finalizer or subcomponents have a finalizer) call
>>> FINAL_WRAPPER
>> 
>> Well, the question is whether one wants to call a finalize wrapper
>> for a simple "comp%alloctable_int(10)" or not. In the current scheme,
>> I tried to avoid calling a finalizer wrapper for simple allocatable
>> components.
>> 
>> Thus, one has the choice: a) Directly call DEALLOCATE for alloctable
>> components of subcomponents b) Always call the finalizer wrapper ­
>> also for nonalloctable TYPEs (with finalizable/allocatable
>> components)
>> 
>> (a) is more direct and possibly a bit faster while (b) makes the
>> wrapper function a tad smaller.
>OK, this is a deliberate choice of implementation to avoid call
>overhead. I slightly prefer (b), but we can keep (a).
>I'm fine with (a) if the code walking the components is shared - which
>avoids c vs. comp issues by the way ;-) .
>
>> * * *
>> 
>> Regarding the flag or nonflag final_comp, I have to admit that I
>> still do not completely understand how you would implement it.
>> 
>> One option would be something like the following
>> 
>> bool has_final_comp(derived) { for (comp = derived->components; comp;
>> comp = comp->next) { if (comp->attr.pointer) continue; if
>> (comp->f2k_derived->finalizers || comp->ts.type == BT_CLASS) return
>> true; if (comp->ts.type == BT_DERIVED &&
>> has_final_comp(comp->ts.u.derived)) return true; } return false }
>This was my initial proposition. The benefit is it is very clear how it
>works compared to manual setting the flag here and there.
>As you raised a performance issue, I proposed something like this:
>
>bool has_final_comp(derived) {
>  bool retval = false;
>
>  if (derived->cache.final_comp_set)
>    return derived->cache.final_comp;
>
>  for (comp = derived->components; comp; comp = comp->next)
>  {
>   if (comp->attr.pointer)
>     continue;
>    if (comp->f2k_derived->finalizers || comp->ts.type == BT_CLASS)
>      {
>        retval = true;
>        break;
>      }
>    if (comp->ts.type == BT_DERIVED
>        && has_final_comp(comp->ts.u.derived))
>      {
>        retval = true;
>        break;
>      }
>  }
>  derived->cache.final_comp_set = 1;
>  derived->cache.final_comp = retval;
>  return retval;
>}
>
>It's no big deal anyway.
>I dream of a compiler where all the non-standard symbol attribute flags,
>expression rank and typespec, etc, would be implemented like this... No
>need for resolution, etc; it would just work everywhere.
>I know the story, patches welcome; they may come, one day...
>
>Mikael
>

On 27/08/2012 20:20, Rouson, Damian wrote:
> Hi Mikael,
> 
> Is this patch approved?
There are a few overlooks to be fixed and the components walking code
that I would like to see shared.
Then I think it can go in. But there is no big stopper.

Mikael