diff mbox

[Fortran,4.9] Minor FINAL preparation patch

Message ID 51405455.4090705@net-b.de
State New
Headers show

Commit Message

Tobias Burnus March 13, 2013, 10:26 a.m. UTC 
Dear all,

this small patch fixes some small issues with the current FINAL 
implementation, which is still disabled. Namely:

(a) class.c: TRANSFER has an optional size= argument; if one doesn't has 
an actual-argument (which can be expr == NULL), it segfaults.
(b) class.c: SIZE needs to return an index-size-kind integer not a 
default-kind integer (tree checking error, but potentially also wrong code)
(c) trans.c: Scalar coarrays (with -fcoarray=lib) were mishandled - they 
also use an array descriptor

Build and regtested on x86-64-gnu-linux.
OK?

(I target 4.9 with this patch; in principle, it could also be applied to 
4.8: The code is not used, yet, and thus it shouldn't harm on 4.8 but 
there is also no benefit.)


The full patch, which enables finalization and regtests is available at: 
https://userpage.physik.fu-berlin.de/~tburnus/final/ – The patch still 
requires some clean up. In addition, finalization (with a user FINAL 
subroutine) is mishandled for allocatable INTENT(OUT) as gfortran 
handles it (at least partially) in the caller (trans-expr.c's 
gfc_conv_procedure_call) and not in the callee (trans-decl.c). That will 
lead to not finalizing and segfaults at run time. There are more issues, 
but for an experimental implementation, fixing this issue should be 
enough. (Note: the .mod version should be bumped to force recompilation, 
which is required due to the ABI change of the vtable.)

Tobias

Comments

Tobias Burnus March 21, 2013, 8:56 a.m. UTC | #1 
*ping *

Tobias Burnus wrote:
> Dear all,
>
> this small patch fixes some small issues with the current FINAL 
> implementation, which is still disabled. Namely:
>
> (a) class.c: TRANSFER has an optional size= argument; if one doesn't 
> has an actual-argument (which can be expr == NULL), it segfaults.
> (b) class.c: SIZE needs to return an index-size-kind integer not a 
> default-kind integer (tree checking error, but potentially also wrong 
> code)
> (c) trans.c: Scalar coarrays (with -fcoarray=lib) were mishandled - 
> they also use an array descriptor
>
> Build and regtested on x86-64-gnu-linux.
> OK?
>
> (I target 4.9 with this patch; in principle, it could also be applied 
> to 4.8: The code is not used, yet, and thus it shouldn't harm on 4.8 
> but there is also no benefit.)
>
>
> The full patch, which enables finalization and regtests is available 
> at: https://userpage.physik.fu-berlin.de/~tburnus/final/ – The patch 
> still requires some clean up. In addition, finalization (with a user 
> FINAL subroutine) is mishandled for allocatable INTENT(OUT) as 
> gfortran handles it (at least partially) in the caller (trans-expr.c's 
> gfc_conv_procedure_call) and not in the callee (trans-decl.c). That 
> will lead to not finalizing and segfaults at run time. There are more 
> issues, but for an experimental implementation, fixing this issue 
> should be enough. (Note: the .mod version should be bumped to force 
> recompilation, which is required due to the ABI change of the vtable.)
>
> Tobias
diff mbox

Patch

2013-03-13  Tobias Burnus  <burnus@net-b.de>

	* class.c (finalization_scalarizer, finalizer_insert_packed_call,
	generate_finalization_wrapper): Avoid segfault with absent SIZE=
	argment to TRANSFER and use correct result kind for SIZE.
	* trans.c (gfc_build_final_call): Handle coarrays.

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index d8e7b6d..db9a094 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -965,6 +965,7 @@  finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr,
   block->ext.actual->next = gfc_get_actual_arglist ();
   block->ext.actual->next->expr = gfc_get_int_expr (gfc_index_integer_kind,
 						    NULL, 0);
+  block->ext.actual->next->next = gfc_get_actual_arglist (); /* SIZE. */
 
   /* The <addr> part: TRANSFER (C_LOC (array), c_intptr_t).  */
 
@@ -987,9 +988,9 @@  finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr,
 
   /* TRANSFER.  */
   expr2 = gfc_build_intrinsic_call (sub_ns, GFC_ISYM_TRANSFER, "transfer",
-				    gfc_current_locus, 2, expr,
+				    gfc_current_locus, 3, expr,
 				    gfc_get_int_expr (gfc_index_integer_kind,
-						      NULL, 0));
+						      NULL, 0), NULL);
   expr2->ts.type = BT_INTEGER;
   expr2->ts.kind = gfc_index_integer_kind;
 
@@ -1315,7 +1316,7 @@  finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
       gfc_expr *shape_expr;
       tmp_array->as->lower[i] = gfc_get_int_expr (gfc_default_integer_kind,
 						  NULL, 1);
-      /* SIZE (array, dim=i+1, kind=default_kind).  */
+      /* SIZE (array, dim=i+1, kind=gfc_index_integer_kind).  */
       shape_expr
 	= gfc_build_intrinsic_call (sub_ns, GFC_ISYM_SIZE, "size",
 				    gfc_current_locus, 3,
@@ -1323,7 +1324,9 @@  finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
 				    gfc_get_int_expr (gfc_default_integer_kind,
 						      NULL, i+1),
 				    gfc_get_int_expr (gfc_default_integer_kind,
-						      NULL, 0));
+						      NULL,
+						      gfc_index_integer_kind));
+      shape_expr->ts.kind = gfc_index_integer_kind;
       tmp_array->as->upper[i] = shape_expr;
     }
   gfc_set_sym_referenced (tmp_array);
@@ -1799,7 +1802,9 @@  generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
 				    gfc_lval_expr_from_sym (array),
 				    gfc_lval_expr_from_sym (idx),
 				    gfc_get_int_expr (gfc_index_integer_kind,
-						      NULL, 0));
+						      NULL,
+						      gfc_index_integer_kind));
+  block->expr2->value.op.op2->ts.kind = gfc_index_integer_kind;
   block->expr2->ts = idx->ts;
 
   /* if (strides(idx) /= sizes(idx-1)) is_contiguous = .false.  */
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index d7bdf26..4bccb32 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1052,8 +1052,12 @@  gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
 
       gfc_init_se (&se, NULL);
       se.want_pointer = 1;
-      if (var->rank || gfc_expr_attr (var).dimension)
+      if (var->rank || gfc_expr_attr (var).dimension
+	  || (gfc_expr_attr (var).codimension
+	      && gfc_option.coarray == GFC_FCOARRAY_LIB))
 	{
+	  if (var->rank == 0)
+	    se.want_coarray = 1;
 	  se.descriptor_only = 1;
 	  gfc_conv_expr_descriptor (&se, var);
 	  array = se.expr;
@@ -1087,13 +1091,17 @@  gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
       size = se.expr;
 
       array_expr = gfc_copy_expr (var);
-      gfc_add_data_component (array_expr);
       gfc_init_se (&se, NULL);
       se.want_pointer = 1;
-      if (array_expr->rank || gfc_expr_attr (array_expr).dimension)
+      if (array_expr->rank || gfc_expr_attr (array_expr).dimension
+	  || (gfc_expr_attr (array_expr).codimension
+	      && gfc_option.coarray == GFC_FCOARRAY_LIB))
 	{
+	  gfc_add_class_array_ref (array_expr);
+	  if (array_expr->rank == 0)
+	    se.want_coarray = 1;
 	  se.descriptor_only = 1;
-	  gfc_conv_expr_descriptor (&se, var);
+	  gfc_conv_expr_descriptor (&se, array_expr);
 	  array = se.expr;
 	  if (! POINTER_TYPE_P (TREE_TYPE (array)))
 	    array = gfc_build_addr_expr (NULL, array);
@@ -1103,6 +1111,7 @@  gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
 	  symbol_attribute attr;
 
 	  gfc_clear_attr (&attr);
+	  gfc_add_data_component (array_expr);
 	  gfc_conv_expr (&se, array_expr);
 	  gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
 	  array = se.expr;