Hi all, by accident I patched this pr. For short, when a structure constructor for a structure with an allocatable component or a function returning a type with an allocatable component is passed as actual argument to a function, then gfortran ICEs. This patch fixes, both the ICE and a segfault at runtime.
I was pointed to the patch in comment #44 of pr61831 which seemingly fixes the
#3 comment of pr58586, too, but causes a memory leak. I therefore like to point
out, that adding the a->expr.expr_type != EXPR_STRUCTURE of Mikael's patch in
pr61831 should not be added to trans-expr.c::gfc_conv_procedure_call (), when
this patch for 58586 is applied.
Bootstraps and regtests ok on x86_64-linux-gnu/F21.
Ok, for trunk 6.0, when open again?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
pr58586_1.clog
Description: Binary data
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9e6432f..80dfed1 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5344,8 +5344,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& (e->expr_type != EXPR_VARIABLE && !e->rank))
{
int parm_rank;
- tmp = build_fold_indirect_ref_loc (input_location,
- parmse.expr);
+ /* It is known the e returns a structure type with at least one
+ allocatable component. When e is a function, ensure that the
+ function is called once only by using a temporary variable. */
+ if (e->expr_type == EXPR_FUNCTION)
+ parmse.expr = gfc_evaluate_now_loc (input_location,
+ parmse.expr, &se->pre);
+
+ if (POINTER_TYPE_P (TREE_TYPE (parmse.expr)))
+ tmp = build_fold_indirect_ref_loc (input_location,
+ parmse.expr);
+ else
+ tmp = parmse.expr;
+
parm_rank = e->rank;
switch (parm_kind)
{
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f90
new file mode 100644
index 0000000..297fae1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! Check that pr58586 is fixed now.
+! Based on a contribution by Vladimir Fuka
+! Contibuted by Andre Vehreschild
+
+program test_pr58586
+ implicit none
+
+ type :: a
+ end type
+
+ type :: c
+ type(a), allocatable :: a
+ end type
+
+ type :: b
+ integer, allocatable :: a
+ end type
+
+ ! These two are merely to check, if compilation works
+ call add(b())
+ call add(b(null()))
+
+ ! This needs to execute, to see whether the segfault at runtime is resolved
+ call add_c(c_init())
+
+contains
+
+ subroutine add (d)
+ type(b), value :: d
+ end subroutine
+
+ subroutine add_c (d)
+ type(c), value :: d
+ end subroutine
+
+ type(c) function c_init()
+ end function
+end program test_pr58586
+
