[Patch, fortran] PR64290 - [F03] No finalization at deallocation of LHS

2022-01-17 Thread Paul Richard Thomas via Gcc-patches
Hi All,

Strictly speaking, the attached patch is branching out into a more
generalised attack on PR37336(Finalization) - [F03] Finish derived-type
finalization but most of it fixes PR64290.

I started work on this patch almost a year ago but had to drop it due
daytime work pressure and only picked it up again a couple of weeks back.
It is not, as yet, complete but I thought to post it in its present form
because stage 3 ended yesterday.

The main thrusts of the patch are:

(i) To correct the order taken by finalization and deallocation of
components for the lhs of assignments. This is done instead by a call to
Tobias' finalization wrapper, rather than performing finalization component
by component in structure_alloc_comps;

(ii) To add finalization of scalar derived type function results, again by
use of the finalization wrapper. This points to a problem that I haven't
yet managed to fix, F2018(7.5.6.3 para 5) "If an executable construct
references a nonpointer function, the result is finalized after execution
of the innermost executable construct containing the reference." I have
been struggling to avoid implementing this by introducing a finalization
block into gfc_se but have run out of ideas as to how to do it otherwise.
(eg. Try using a finalizable function as the actual argument of another
procedure.); and

(iii) Once (ii) is added, a segfault occurs if the derived type has
allocatable, finalizable components. (PR96122) This occurred because the
call to the component finalization wrapper was missing two arguments in the
call; most particularly 'byte_stride'.

There is still quite a lot to do to bring together common code chunks, fix
the ordering requirement of F2018 (7.5.6.3 para 5), add more testcases.
It's certainly not ready to be committed yet :-(

Regards

Paul

Fortran:Implement missing finalization features [PR64290]

2022-01-17  Paul Thomas  

gcc/fortran
PR fortran/103854
* class.c (has_finalizer_component): Do not return true for
procedure pointer components.

PR fortran/96087
* class.c (finalize_component): Include the missing arguments
in the call to the component's finalizer wrapper.

PR fortran/64290
* resolve.c (resolve_where, gfc_resolve_where_code_in_forall,
gfc_resolve_forall_body, gfc_resolve_code): Check that the op
code is still EXEC_ASSIGN. If it is set lhs to must finalize.
* trans-array.c (structure_alloc_comps): Add boolean argument
to suppress finalization and use it for calls from
gfc_deallocate_alloc_comp_no_caf. Otherwise it defaults to
false.
(gfc_alloc_allocatable_for_assignment): Suppress finalization
by setting new arg in call to gfc_deallocate_alloc_comp_no_caf.
* trans-array.h : Add the new boolean argument to the prototype
of gfc_deallocate_alloc_comp_no_caf with a default of false.
* trans-expr.c (gfc_conv_procedure_call): Call finalizer for
finalizable scalar function results.
(gfc_trans_scalar_assign): Suppress finalization by setting new
argument in call to gfc_deallocate_alloc_comp_no_caf.
(gfc_assignment_finalizer_call): New function to provide
finalization on intrinsic assignment.
(trans_class_assignment, gfc_trans_assignment_1): Call it and
add the block between the rhs evaluation and any reallocation
on assignment that there might be.

gcc/testsuite/
PR fortran/64290
* gfortran.dg/finalize_38.f90 : New test.
* gfortran.dg/allocate_with_source_25.f90 : The number of final
calls goes down from 6 to 4.
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 2cb0c6572bd..18289eaffe8 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -896,7 +896,8 @@ has_finalizer_component (gfc_symbol *derived)
gfc_component *c;
 
   for (c = derived->components; c; c = c->next)
-if (c->ts.type == BT_DERIVED && !c->attr.pointer && !c->attr.allocatable)
+if (c->ts.type == BT_DERIVED && !c->attr.pointer && !c->attr.allocatable
+	&& c->attr.flavor != FL_PROCEDURE)
   {
 	if (c->ts.u.derived->f2k_derived
 	&& c->ts.u.derived->f2k_derived->finalizers)
@@ -1059,7 +1060,8 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
 {
   /* Call FINAL_WRAPPER (comp);  */
   gfc_code *final_wrap;
-  gfc_symbol *vtab;
+  gfc_symbol *vtab, *byte_stride;
+  gfc_expr *scalar, *size_expr, *fini_coarray_expr;
   gfc_component *c;
 
   vtab = gfc_find_derived_vtab (comp->ts.u.derived);
@@ -1068,12 +1070,54 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
 	  break;
 
   gcc_assert (c);
+
+  /* Set scalar argument for storage_size.  */
+  gfc_get_symbol ("comp_byte_stride", sub_ns, _stride);
+  byte_stride->ts = e->ts;
+  byte_stride->attr.flavor = FL_VARIABLE;
+  byte_stride->attr.value = 1;
+  byte_stride->attr.artificial = 1;
+  gfc_set_sym_referenced (byte_stride);
+  gfc_commit_symbol (byte_stride);
+  scalar = gfc_lval_expr_from_sym (byte_stride);
+
   final_wrap = gfc_get_code (EXEC_CALL);
   final_wrap->symtree = 

[Patch, fortran] PR64290 - [F03] No finalization at deallocation of LHS

2021-01-14 Thread Paul Richard Thomas via Gcc-patches
Hi All,

This patch was triggered by a thread on clf. Some years ago Tobias and I
discussed the remaining conditions where finalization should be triggered
and is not. Intrinsic assignment was one of the glaring omissions for which
implementation looked like a heavy lift job. As it happens, it wasn't too
bad :-)

Most of the work was suppressing partial finalization, as a prelude to
reallocation on assignment, and ensuring that finalization happened in the
right circumstances. gfc_assignment_finalizer_call does the work for
intrinsic assignment and is straightforward. Care has to be taken to place
the result between evaluation of the rhs and any reallocation of the lhs
that might occur.

I thought it to be a good idea to squeeze this in before Stage 4 and so the
testcase is not yet finished.I will post it separately once complete and
before pushing the patch. The process is a bit tedious since it involves
checking that the finalization is occurring at the correct point in the
assignment, that the results are consistent with my understanding of
7.5.6.3 and that another brand gives the same results.

Regtests on FC33/x86_64 - OK for master? It occurs to me that this should
also be backported to the 10-branch at very least.

Paul

Fortran:Implement finalization on intrinsic assignment [PR64290]

2021-01-14  Paul Thomas  

gcc/fortran
PR fortran/64290
* resolve.c (resolve_where, gfc_resolve_where_code_in_forall,
gfc_resolve_forall_body, gfc_resolve_code): Check that the op
code is still EXEC_ASSIGN. If it is set lhs to must finalize.
* trans-array.c (structure_alloc_comps): Add boolean argument
to suppress finalization and use it for calls from
gfc_deallocate_alloc_comp_no_caf. Otherwise it defaults to
false.
(gfc_alloc_allocatable_for_assignment): Suppress finalization
by setting new arg in call to gfc_deallocate_alloc_comp_no_caf.
* trans-array.h : Add the new boolean argument to the prototype
of gfc_deallocate_alloc_comp_no_caf with a default of false.
* trans-expr.c (gfc_trans_scalar_assign): Suppress finalization
by setting new arg in call to gfc_deallocate_alloc_comp_no_caf.
(gfc_assignment_finalizer_call): New function to provide
finalization on intrinsic assignment.
(gfc_trans_assignment_1): Call it and add the block between the
rhs evaluation and any reallocation on assignment that there
might be.

gcc/testsuite/
PR fortran/64290
* gfortran.dg/finalize_38.f90 : New test.
* gfortran.dg/allocate_with_source_16.f90 : The number of final
calls goes down from 6 to 4.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f243bd185b0..05f52185b8b 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10415,6 +10415,10 @@ resolve_where (gfc_code *code, gfc_expr *mask)
 	  if (e && !resolve_where_shape (cnext->expr1, e))
 	   gfc_error ("WHERE assignment target at %L has "
 			  "inconsistent shape", >expr1->where);
+
+	  if (cnext->op == EXEC_ASSIGN)
+		cnext->expr1->must_finalize = 1;
+
 	  break;
 
 
@@ -10502,6 +10506,10 @@ gfc_resolve_where_code_in_forall (gfc_code *code, int nvar,
 	/* WHERE assignment statement */
 	case EXEC_ASSIGN:
 	  gfc_resolve_assign_in_forall (cnext, nvar, var_expr);
+
+	  if (cnext->op == EXEC_ASSIGN)
+		cnext->expr1->must_finalize = 1;
+
 	  break;
 
 	/* WHERE operator assignment statement */
@@ -10548,6 +10556,10 @@ gfc_resolve_forall_body (gfc_code *code, int nvar, gfc_expr **var_expr)
 	case EXEC_ASSIGN:
 	case EXEC_POINTER_ASSIGN:
 	  gfc_resolve_assign_in_forall (c, nvar, var_expr);
+
+	  if (c->op == EXEC_ASSIGN)
+	c->expr1->must_finalize = 1;
+
 	  break;
 
 	case EXEC_ASSIGN_CALL:
@@ -11947,6 +11959,9 @@ start:
 	  && code->expr1->ts.u.derived->attr.defined_assign_comp)
 	generate_component_assignments (, ns);
 
+	  if (code->op == EXEC_ASSIGN)
+	code->expr1->must_finalize = 1;
+
 	  break;
 
 	case EXEC_LABEL_ASSIGN:
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 4bd4db877bd..8ac6b9e88fb 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -8661,7 +8661,7 @@ static gfc_actual_arglist *pdt_param_list;
 static tree
 structure_alloc_comps (gfc_symbol * der_type, tree decl,
 		   tree dest, int rank, int purpose, int caf_mode,
-		   gfc_co_subroutines_args *args)
+		   gfc_co_subroutines_args *args, bool no_finalization)
 {
   gfc_component *c;
   gfc_loopinfo loop;
@@ -8749,11 +8749,12 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	 gfc_conv_array_data (dest));
 	  dref = gfc_build_array_ref (tmp, index, NULL);
 	  tmp = structure_alloc_comps (der_type, vref, dref, rank,
-   COPY_ALLOC_COMP, caf_mode, args);
+   COPY_ALLOC_COMP, caf_mode, args,
+   no_finalization);
 	}
   else
 	tmp = structure_alloc_comps (der_type, vref, NULL_TREE, rank, purpose,
- caf_mode, args);
+ caf_mode, args, no_finalization);
 
   gfc_add_expr_to_block (, tmp);
 
@@ -8787,13 +8788,15 @@