[Patch, Fortran, PR58586, v1] ICE with derived type with allocatable component passed by value

[Patch, Fortran, PR58586, v1] ICE with derived type with allocatable component passed by value

[Andre Vehreschild]

[-- Attachment #1: Type: text/plain, Size: 817 bytes --]

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 

[-- Attachment #2: pr58586_1.clog --]
[-- Type: application/octet-stream, Size: 393 bytes --]

gcc/testsuite/ChangeLog:

2015-04-15  Andre Vehreschild  <vehre@gmx.de>

	* gfortran.dg/alloc_comp_class_3.f90: New test.


gcc/fortran/ChangeLog:

2015-04-15  Andre Vehreschild  <vehre@gmx.de>

	* trans-expr.c (gfc_conv_procedure_call): For EXPR_STRUCTURE
	hand the tree without indirect ref. And for EXPR_FUNCTIONs
	add a temporary variable to prevent calling the function
	multiple times.


[-- Attachment #3: pr58586_1.patch --]
[-- Type: text/x-patch, Size: 1951 bytes --]

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
+

Re: [Patch, Fortran, PR58586, v1] ICE with derived type with allocatable component passed by value

[Mikael Morin]

Hello,

Le 15/04/2015 20:03, Andre Vehreschild a écrit :
> 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.
Note that I plan to submit the pr61831 patch soon, and that the comment
#44 patch doesn't have the a->expr.expr_type != EXPR_STRUCTURE (in
opposition to precedent patches).
I hope that means the patches are compatible. ;-)


> 
> 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);
You need not limit this to functions only.
I think you can even do this without condition.

> +
> +	  if (POINTER_TYPE_P (TREE_TYPE (parmse.expr)))
This distinguishes arguments with/without value attribute, right?
I think it's better to use the frontend information here (fsym->attr.value).


> +	    tmp = build_fold_indirect_ref_loc (input_location,
> +					       parmse.expr);
> +	  else
> +	    tmp = parmse.expr;
> +
>  	  parm_rank = e->rank;
>  	  switch (parm_kind)
>  	    {

Otherwise, this looks good.  Can you post an updated patch taking the
above comments into account?
Ah, and don't forget to provide a ChangeLog entry with it.

Mikael

Re: [Patch, Fortran, PR58586, v2] ICE with derived type with allocatable component passed by value

[Andre Vehreschild]

[-- Attachment #1: Type: text/plain, Size: 3163 bytes --]

Hi Mikael, hi all,

thanks for the review. I have made some changes. Answers to your questions are
inline below.

On Sun, 19 Apr 2015 12:01:23 +0200
Mikael Morin <mikael.morin@sfr.fr> wrote:

<snip>
> > 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.
> Note that I plan to submit the pr61831 patch soon, and that the comment
> #44 patch doesn't have the a->expr.expr_type != EXPR_STRUCTURE (in
> opposition to precedent patches).
> I hope that means the patches are compatible. ;-)

I have tested the code in the comments of pr61831 with v2 of this patch and got
no issues.

> > 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);
> You need not limit this to functions only.
> I think you can even do this without condition.

Yes, one could do that, but then an unnecessary temporary variable in the - for
my taste - already too clobbered pseudo code is introduced. Furthermore, is the
penalty on doing the check for a function negligible. I therefore have not
changed that.

> > +	  if (POINTER_TYPE_P (TREE_TYPE (parmse.expr)))
> This distinguishes arguments with/without value attribute, right?
> I think it's better to use the frontend information here (fsym->attr.value).

Changed to check for value.

> Ah, and don't forget to provide a ChangeLog entry with it.

The Changelog entry comes in an additional attachment. 

Version 2 of this patch adds a chunk to resolve.c, where results of
functions that are defined in a module, but are not referenced there, are
now marked referenced when they use allocatable or pointer components.
Furthermore, does the chunk prevent duplicate pseudo code generation. The
former code adds a EXPR_INIT_ASSIGN and then gfc_generate_function_code ()
does nearly the same again. I fixed this in both place. I also have added a
test to check this. 

The chunks in trans-decl.c take care to have variable/result declaration and
initialize it properly. For this I had to make gfc_trans_structure_assign ()
public to the trans-stage.

Bootstraps and regtests ok on x86_64-linux-gnu/F21.

Ok, for trunk?

Regards,
	Andre
-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: pr58586_2.clog --]
[-- Type: application/octet-stream, Size: 1126 bytes --]

gcc/testsuite/ChangeLog:

2015-04-23  Andre Vehreschild  <vehre@gmx.de>

	* gfortran.dg/alloc_comp_class_3.f03: New test.
	* gfortran.dg/alloc_comp_class_4.f03: New test.


gcc/fortran/ChangeLog:

2015-04-23  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/58586
	* resolve.c (resolve_symbol): Non-private functions in modules
	with allocatable or pointer components are marked referenced
	now. Furthermore is the default init especially for those
	components now done in gfc_conf_procedure_call preventing
	duplicate code.
	* trans-decl.c (build_function_decl): Set the result decl when
	the function symbol and the result symbol are equal.
	(gfc_generate_function_code): Generate a fake result decl for
	functions returning an object with allocatable components and
	initialize them.
	* trans-expr.c (gfc_conv_procedure_call): For value typed trees
	use the tree without indirect ref. And for function calls
	add a temporary variable to prevent calling the function
	multiple times.
	* trans.h: Made gfc_trans_structure_assign () protoype
	available, which is now needed by trans-decl.c:gfc_generate_
	function_code(), too.


[-- Attachment #3: pr58586_2.patch --]
[-- Type: text/x-patch, Size: 8242 bytes --]

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 76afd72..a43396c 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -14063,10 +14063,15 @@ resolve_symbol (gfc_symbol *sym)
 
       if ((!a->save && !a->dummy && !a->pointer
 	   && !a->in_common && !a->use_assoc
-	   && (a->referenced || a->result)
-	   && !(a->function && sym != sym->result))
+	   && !a->result && !a->function)
 	  || (a->dummy && a->intent == INTENT_OUT && !a->pointer))
 	apply_default_init (sym);
+      else if (a->function && sym->result && a->access != ACCESS_PRIVATE
+	       && (sym->ts.u.derived->attr.alloc_comp
+		   || sym->ts.u.derived->attr.pointer_comp))
+	/* Mark the result symbol to be referenced, when it has allocatable
+	   components.  */
+	sym->result->attr.referenced = 1;
     }
 
   if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 4c18920..0b63175 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2158,6 +2158,8 @@ build_function_decl (gfc_symbol * sym, bool global)
     gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id (sym));
 
   sym->backend_decl = fndecl;
+  if (sym == sym->result && !sym->result->backend_decl)
+    sym->result->backend_decl = result_decl;
 }
 
 
@@ -5898,8 +5900,21 @@ gfc_generate_function_code (gfc_namespace * ns)
 
   if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node)
     {
+      bool artificial_result_decl = false;
       tree result = get_proc_result (sym);
 
+      /* Make sure that a function returning an object with
+	 alloc/pointer_components always has a result, where at least
+	 the allocatable/pointer components are set to zero.  */
+      if (result == NULL_TREE && sym->attr.function
+	  && sym->ts.type == BT_DERIVED
+	  && (sym->ts.u.derived->attr.alloc_comp
+	      || sym->ts.u.derived->attr.pointer_comp))
+	{
+	  artificial_result_decl = true;
+	  result = gfc_get_fake_result_decl (sym, 0);
+	}
+
       if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer)
 	{
 	  if (sym->attr.allocatable && sym->attr.dimension == 0
@@ -5918,16 +5933,26 @@ gfc_generate_function_code (gfc_namespace * ns)
 							null_pointer_node));
 	    }
 	  else if (sym->ts.type == BT_DERIVED
-		   && sym->ts.u.derived->attr.alloc_comp
 		   && !sym->attr.allocatable)
 	    {
-	      rank = sym->as ? sym->as->rank : 0;
-	      tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
-	      gfc_add_expr_to_block (&init, tmp);
+	      gfc_expr *init_exp;
+	      init_exp = gfc_default_initializer (&sym->ts);
+	      if (init_exp)
+		{
+		  tmp = gfc_trans_structure_assign (result, init_exp, 0);
+		  gfc_free_expr (init_exp);
+		  gfc_add_expr_to_block (&init, tmp);
+		}
+	      else if (sym->ts.u.derived->attr.alloc_comp)
+		{
+		  rank = sym->as ? sym->as->rank : 0;
+		  tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
+		  gfc_add_expr_to_block (&init, tmp);
+		}
 	    }
 	}
 
-      if (result == NULL_TREE)
+      if (result == NULL_TREE || artificial_result_decl)
 	{
 	  /* TODO: move to the appropriate place in resolve.c.  */
 	  if (warn_return_type && sym == sym->result)
@@ -5937,7 +5962,7 @@ gfc_generate_function_code (gfc_namespace * ns)
 	  if (warn_return_type)
 	    TREE_NO_WARNING(sym->backend_decl) = 1;
 	}
-      else
+      if (result != NULL_TREE)
 	gfc_add_expr_to_block (&body, gfc_generate_return ());
     }
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9e6432f..2db7524 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1472,7 +1472,6 @@ realloc_lhs_warning (bt type, bool array, locus *where)
 }
 
 
-static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init);
 static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *,
 						 gfc_expr *);
 
@@ -5344,8 +5343,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 (fsym->attr.value)
+	    tmp = parmse.expr;
+	  else
+	    tmp = build_fold_indirect_ref_loc (input_location,
+					       parmse.expr);
+
 	  parm_rank = e->rank;
 	  switch (parm_kind)
 	    {
@@ -7136,7 +7146,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
 
 /* Assign a derived type constructor to a variable.  */
 
-static tree
+tree
 gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init)
 {
   gfc_constructor *c;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index e2a1fea..3198c55 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -666,6 +666,9 @@ tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespe
 /* Generate code to call realloc().  */
 tree gfc_call_realloc (stmtblock_t *, tree, tree);
 
+/* Assign a derived type constructor to a variable.  */
+tree gfc_trans_structure_assign (tree, gfc_expr *, bool);
+
 /* Generate code for an assignment, includes scalarization.  */
 tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool);
 
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
new file mode 100644
index 0000000..28c0beb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
@@ -0,0 +1,42 @@
+! { dg-do run }
+! { dg-options "-Wreturn-type" }
+!
+! 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()  ! { dg-warning "not set" }
+  end function
+end program test_pr58586
+
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
new file mode 100644
index 0000000..578df83
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
@@ -0,0 +1,74 @@
+! { dg-do run }
+! { dg-options "-Wreturn-type" }
+!
+! Check that pr58586 is fixed now.
+! Based on a contribution by Vladimir Fuka
+! Contibuted by Andre Vehreschild
+
+module test_pr58586_mod
+  implicit none
+
+  type :: a
+  end type
+
+  type :: c
+     type(a), allocatable :: a
+  end type
+
+  type :: d
+  contains
+     procedure :: init => d_init
+  end type
+
+  type, extends(d) :: e
+  contains
+     procedure :: init => e_init
+  end type
+
+  type :: b
+     integer, allocatable :: a
+  end type
+
+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() ! { dg-warning "not set" }
+  end function
+
+  type(c) function d_init(this) ! { dg-warning "not set" }
+    class(d) :: this
+  end function
+
+  type(c) function e_init(this)
+    class(e) :: this
+    allocate (e_init%a)
+  end function
+end module test_pr58586_mod
+
+program test_pr58586
+  use test_pr58586_mod
+
+  class(d), allocatable :: od
+  class(e), allocatable :: oe
+  ! 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())
+
+  allocate(od)
+  call add_c(od%init())
+  deallocate(od)
+  allocate(oe)
+  call add_c(oe%init())
+  deallocate(oe)
+end program
+

Re: [Patch, Fortran, PR58586, v2] ICE with derived type with allocatable component passed by value

[Andre Vehreschild]

Hi all,

Just to clear things up, with

> I have tested the code in the comments of pr61831 with v2 of this patch and
> got no issues.

I meant, that I have checked the code in comment #28 of pr61831. With only
this patch, there still is an illegal free() of unallocated memory.
With this patch and the one of Mikael in comment 44 I get no issues anymore.

Regards,
	Andre
-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

Re: [Patch, Fortran, PR58586, v2] ICE with derived type with allocatable component passed by value

[Mikael Morin]

Hello,

I'm reviewing the original patch only for now.
The added bits in v2 will have to wait.

Le 23/04/2015 20:00, Andre Vehreschild a écrit :
>>> 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);
>> You need not limit this to functions only.
>> I think you can even do this without condition.
> 
> Yes, one could do that, but then an unnecessary temporary variable in the - for
> my taste - already too clobbered pseudo code is introduced. Furthermore, is the
> penalty on doing the check for a function negligible. I therefore have not
> changed that.

All right; would you mind writing it either
	if (e->expr_type != EXPR_VARIABLE)
or
	if (!DECL_P (parmse.expr))
or
	if (!VAR_P (parmse.expr))
instead?

> 
>>> +	  if (POINTER_TYPE_P (TREE_TYPE (parmse.expr)))
>> This distinguishes arguments with/without value attribute, right?
>> I think it's better to use the frontend information here (fsym->attr.value).
> 
> Changed to check for value.

Please check fsym && fsym->attr.value
and add the following testcase (it fails with the patch).


module m
  type :: t
    integer, allocatable :: comp
  end type
  type :: u
    type(t), allocatable :: comp
  end type
end module m

  use m
  call sub(u())
end


OK with these changes.

> 
>> Ah, and don't forget to provide a ChangeLog entry with it.
> 
> The Changelog entry comes in an additional attachment. 
> 
It doesn't appear inline in my mailer as its content type is
application/octet-stream, so I missed it.  Sorry.

Thanks for the patch.  I will review the rest later.

Mikael

Re: [Patch, Fortran, PR58586, v3] ICE with derived type with allocatable component passed by value

[Andre Vehreschild]

[-- Attachment #1: Type: text/plain, Size: 3213 bytes --]

Hi Mikael, hi all,

Mikael, thanks for the review so far. I have inserted the changes requested and
updated this patch to trunk. For the e->expr_type == EXPR_FUNCTION I have
choose !DECL_P(parmse.expr) to not only prevent VAR_DECLs aliasing, but also
prevent aliasing for PARM_DECLs and similar.

Bootstraps and regtests ok on x86_64-linux-gnu/F21. 

Note, this patch also fixes the regression in alloc_comp_constructor_1.f90
introduced by my patch for pr44672, v4. The memory loss is also fixed again.

Ok for trunk?

Regards,
	Andre

On Sun, 26 Apr 2015 12:22:56 +0200
Mikael Morin <mikael.morin@sfr.fr> wrote:

> Hello,
> 
> I'm reviewing the original patch only for now.
> The added bits in v2 will have to wait.
> 
> Le 23/04/2015 20:00, Andre Vehreschild a écrit :
> >>> 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);
> >> You need not limit this to functions only.
> >> I think you can even do this without condition.
> > 
> > Yes, one could do that, but then an unnecessary temporary variable in the -
> > for my taste - already too clobbered pseudo code is introduced.
> > Furthermore, is the penalty on doing the check for a function negligible. I
> > therefore have not changed that.
> 
> All right; would you mind writing it either
> 	if (e->expr_type != EXPR_VARIABLE)
> or
> 	if (!DECL_P (parmse.expr))
> or
> 	if (!VAR_P (parmse.expr))
> instead?
> 
> > 
> >>> +	  if (POINTER_TYPE_P (TREE_TYPE (parmse.expr)))
> >> This distinguishes arguments with/without value attribute, right?
> >> I think it's better to use the frontend information here
> >> (fsym->attr.value).
> > 
> > Changed to check for value.
> 
> Please check fsym && fsym->attr.value
> and add the following testcase (it fails with the patch).
> 
> 
> module m
>   type :: t
>     integer, allocatable :: comp
>   end type
>   type :: u
>     type(t), allocatable :: comp
>   end type
> end module m
> 
>   use m
>   call sub(u())
> end
> 
> 
> OK with these changes.
> 
> > 
> >> Ah, and don't forget to provide a ChangeLog entry with it.
> > 
> > The Changelog entry comes in an additional attachment. 
> > 
> It doesn't appear inline in my mailer as its content type is
> application/octet-stream, so I missed it.  Sorry.
> 
> Thanks for the patch.  I will review the rest later.
> 
> Mikael


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: pr58586_3.clog --]
[-- Type: text/plain, Size: 1393 bytes --]

gcc/testsuite/ChangeLog:

2015-05-05  Andre Vehreschild  <vehre@gmx.de>

	* gfortran.dg/alloc_comp_class_3.f03: New test.
	* gfortran.dg/alloc_comp_class_4.f03: New test.


gcc/fortran/ChangeLog:

2015-04-23  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/58586
	* resolve.c (resolve_symbol): Non-private functions in modules
	with allocatable or pointer components are marked referenced
	now. Furthermore is the default init especially for those
	components now done in gfc_conf_procedure_call preventing
	duplicate code.
	* trans-decl.c (build_function_decl): Set the result decl when
	the function symbol and the result symbol are equal.
	(gfc_generate_function_code): Generate a fake result decl for
	functions returning an object with allocatable components and
	initialize them.
	* trans-expr.c (gfc_conv_procedure_call): For value typed trees
	use the tree without indirect ref. And for non-decl trees
	add a temporary variable to prevent evaluating the tree
	multiple times (prevent multiple function evaluations).
	* trans.h: Made gfc_trans_structure_assign () protoype
	available, which is now needed by trans-decl.c:gfc_generate_
	function_code(), too.

gcc/fortran/ChangeLog:

2015-05-05  Andre Vehreschild  <vehre@gmx.de>

	* resolve.c (resolve_symbol):
	* trans-decl.c (build_function_decl):
	(gfc_generate_function_code):
	* trans-expr.c (gfc_conv_procedure_call):
	* trans.h:


[-- Attachment #3: pr58586_3.patch --]
[-- Type: text/x-patch, Size: 8707 bytes --]

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2ac4689..72df35e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -14093,10 +14093,15 @@ resolve_symbol (gfc_symbol *sym)
 
       if ((!a->save && !a->dummy && !a->pointer
 	   && !a->in_common && !a->use_assoc
-	   && (a->referenced || a->result)
-	   && !(a->function && sym != sym->result))
+	   && !a->result && !a->function)
 	  || (a->dummy && a->intent == INTENT_OUT && !a->pointer))
 	apply_default_init (sym);
+      else if (a->function && sym->result && a->access != ACCESS_PRIVATE
+	       && (sym->ts.u.derived->attr.alloc_comp
+		   || sym->ts.u.derived->attr.pointer_comp))
+	/* Mark the result symbol to be referenced, when it has allocatable
+	   components.  */
+	sym->result->attr.referenced = 1;
     }
 
   if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 4c18920..0b63175 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2158,6 +2158,8 @@ build_function_decl (gfc_symbol * sym, bool global)
     gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id (sym));
 
   sym->backend_decl = fndecl;
+  if (sym == sym->result && !sym->result->backend_decl)
+    sym->result->backend_decl = result_decl;
 }
 
 
@@ -5898,8 +5900,21 @@ gfc_generate_function_code (gfc_namespace * ns)
 
   if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node)
     {
+      bool artificial_result_decl = false;
       tree result = get_proc_result (sym);
 
+      /* Make sure that a function returning an object with
+	 alloc/pointer_components always has a result, where at least
+	 the allocatable/pointer components are set to zero.  */
+      if (result == NULL_TREE && sym->attr.function
+	  && sym->ts.type == BT_DERIVED
+	  && (sym->ts.u.derived->attr.alloc_comp
+	      || sym->ts.u.derived->attr.pointer_comp))
+	{
+	  artificial_result_decl = true;
+	  result = gfc_get_fake_result_decl (sym, 0);
+	}
+
       if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer)
 	{
 	  if (sym->attr.allocatable && sym->attr.dimension == 0
@@ -5918,16 +5933,26 @@ gfc_generate_function_code (gfc_namespace * ns)
 							null_pointer_node));
 	    }
 	  else if (sym->ts.type == BT_DERIVED
-		   && sym->ts.u.derived->attr.alloc_comp
 		   && !sym->attr.allocatable)
 	    {
-	      rank = sym->as ? sym->as->rank : 0;
-	      tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
-	      gfc_add_expr_to_block (&init, tmp);
+	      gfc_expr *init_exp;
+	      init_exp = gfc_default_initializer (&sym->ts);
+	      if (init_exp)
+		{
+		  tmp = gfc_trans_structure_assign (result, init_exp, 0);
+		  gfc_free_expr (init_exp);
+		  gfc_add_expr_to_block (&init, tmp);
+		}
+	      else if (sym->ts.u.derived->attr.alloc_comp)
+		{
+		  rank = sym->as ? sym->as->rank : 0;
+		  tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
+		  gfc_add_expr_to_block (&init, tmp);
+		}
 	    }
 	}
 
-      if (result == NULL_TREE)
+      if (result == NULL_TREE || artificial_result_decl)
 	{
 	  /* TODO: move to the appropriate place in resolve.c.  */
 	  if (warn_return_type && sym == sym->result)
@@ -5937,7 +5962,7 @@ gfc_generate_function_code (gfc_namespace * ns)
 	  if (warn_return_type)
 	    TREE_NO_WARNING(sym->backend_decl) = 1;
 	}
-      else
+      if (result != NULL_TREE)
 	gfc_add_expr_to_block (&body, gfc_generate_return ());
     }
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 4bbd685..16e584a 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1472,7 +1472,6 @@ realloc_lhs_warning (bt type, bool array, locus *where)
 }
 
 
-static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init);
 static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *,
 						 gfc_expr *);
 
@@ -5341,12 +5340,22 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS)
 	    && e->ts.u.derived->attr.alloc_comp
 	    && !(e->symtree && e->symtree->n.sym->attr.pointer)
-	    && e->expr_type != EXPR_VARIABLE && !e->rank
-	    && e->expr_type != EXPR_STRUCTURE)
+	    && 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 (!DECL_P (parmse.expr))
+	    parmse.expr = gfc_evaluate_now_loc (input_location,
+						parmse.expr, &se->pre);
+
+	  if (fsym && fsym->attr.value)
+	    tmp = parmse.expr;
+	  else
+	    tmp = build_fold_indirect_ref_loc (input_location,
+					       parmse.expr);
+
 	  parm_rank = e->rank;
 	  switch (parm_kind)
 	    {
@@ -7137,7 +7146,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
 
 /* Assign a derived type constructor to a variable.  */
 
-static tree
+tree
 gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init)
 {
   gfc_constructor *c;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index e2a1fea..3198c55 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -666,6 +666,9 @@ tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespe
 /* Generate code to call realloc().  */
 tree gfc_call_realloc (stmtblock_t *, tree, tree);
 
+/* Assign a derived type constructor to a variable.  */
+tree gfc_trans_structure_assign (tree, gfc_expr *, bool);
+
 /* Generate code for an assignment, includes scalarization.  */
 tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool);
 
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
new file mode 100644
index 0000000..0753e33
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-options "-Wreturn-type" }
+!
+! 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
+
+  type :: t
+    integer, allocatable :: comp
+  end type
+  type :: u
+    type(t), allocatable :: comp
+  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())
+
+  call sub(u())
+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()  ! { dg-warning "not set" }
+  end function
+
+  subroutine sub(d)
+    type(u), value :: d
+  end subroutine
+end program test_pr58586
+
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
new file mode 100644
index 0000000..578df83
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
@@ -0,0 +1,74 @@
+! { dg-do run }
+! { dg-options "-Wreturn-type" }
+!
+! Check that pr58586 is fixed now.
+! Based on a contribution by Vladimir Fuka
+! Contibuted by Andre Vehreschild
+
+module test_pr58586_mod
+  implicit none
+
+  type :: a
+  end type
+
+  type :: c
+     type(a), allocatable :: a
+  end type
+
+  type :: d
+  contains
+     procedure :: init => d_init
+  end type
+
+  type, extends(d) :: e
+  contains
+     procedure :: init => e_init
+  end type
+
+  type :: b
+     integer, allocatable :: a
+  end type
+
+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() ! { dg-warning "not set" }
+  end function
+
+  type(c) function d_init(this) ! { dg-warning "not set" }
+    class(d) :: this
+  end function
+
+  type(c) function e_init(this)
+    class(e) :: this
+    allocate (e_init%a)
+  end function
+end module test_pr58586_mod
+
+program test_pr58586
+  use test_pr58586_mod
+
+  class(d), allocatable :: od
+  class(e), allocatable :: oe
+  ! 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())
+
+  allocate(od)
+  call add_c(od%init())
+  deallocate(od)
+  allocate(oe)
+  call add_c(oe%init())
+  deallocate(oe)
+end program
+

Re: [Patch, Fortran, PR58586, v3] ICE with derived type with allocatable component passed by value

[Mikael Morin]

Hello,

Le 05/05/2015 11:00, Andre Vehreschild a écrit :
> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
> index 4c18920..0b63175 100644
> --- a/gcc/fortran/trans-decl.c
> +++ b/gcc/fortran/trans-decl.c
> @@ -2158,6 +2158,8 @@ build_function_decl (gfc_symbol * sym, bool global)
>      gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id (sym));
>  
>    sym->backend_decl = fndecl;
> +  if (sym == sym->result && !sym->result->backend_decl)
> +    sym->result->backend_decl = result_decl;

Something is seriously misbehaving if the condition is true, and setting
sym->backend_decl to result_decl doesn't seem any better than keeping it
NULL.
So, please remove this change

>  }
>  
>  
> @@ -5898,8 +5900,21 @@ gfc_generate_function_code (gfc_namespace * ns)
>  
>    if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node)
>      {
> +      bool artificial_result_decl = false;
>        tree result = get_proc_result (sym);
>  
> +      /* Make sure that a function returning an object with
> +	 alloc/pointer_components always has a result, where at least
> +	 the allocatable/pointer components are set to zero.  */
> +      if (result == NULL_TREE && sym->attr.function
> +	  && sym->ts.type == BT_DERIVED
> +	  && (sym->ts.u.derived->attr.alloc_comp
> +	      || sym->ts.u.derived->attr.pointer_comp))
> +	{
> +	  artificial_result_decl = true;
> +	  result = gfc_get_fake_result_decl (sym, 0);
> +	}

I expect the "fake" result decl to be needed in more cases.
For example, if type is BT_CLASS.
Here is a variant of alloc_comp_class_4.f03:c_init for such a case.

  class(c) function c_init2()
    allocatable :: c_init2
  end function

or even without class:

  type(t) function t_init()
    allocatable :: t_init
  end function

for some any type t.

So, remove the check for alloc_comp/pointer_comp and permit BT_CLASS.
One minor thing, check sym->result's type and attribute instead of sym's
here.  It should not make a difference, but I think it's more correct.


The rest looks good.
The patch is OK with the suggested changes above.  Thanks.
I don't think the test functions above work well enough to be
incorporated in a testcase for now.

Mikael

Re: [Patch, Fortran, PR58586, v3] ICE with derived type with allocatable component passed by value

[Andre Vehreschild]

[-- Attachment #1: Type: text/plain, Size: 4908 bytes --]

Hi Mikael,

thanks for the review. I still have some questions/remarks before commiting:

On Thu, 07 May 2015 12:14:59 +0200
Mikael Morin <mikael.morin@sfr.fr> wrote:
<snip>
> > @@ -2158,6 +2158,8 @@ build_function_decl (gfc_symbol * sym, bool global)
> >      gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id
> > (sym)); 
> >    sym->backend_decl = fndecl;
> > +  if (sym == sym->result && !sym->result->backend_decl)
> > +    sym->result->backend_decl = result_decl;
> 
> Something is seriously misbehaving if the condition is true, and setting
> sym->backend_decl to result_decl doesn't seem any better than keeping it
> NULL.
> So, please remove this change

Did that. I think this was a relic from the start of me trying to understand
what was the issue and how to fix it. Later I didn't check, if it was still
necessary. Sorry for that.

> > @@ -5898,8 +5900,21 @@ gfc_generate_function_code (gfc_namespace * ns)
> >  
> >    if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node)
> >      {
> > +      bool artificial_result_decl = false;
> >        tree result = get_proc_result (sym);
> >  
> > +      /* Make sure that a function returning an object with
> > +	 alloc/pointer_components always has a result, where at least
> > +	 the allocatable/pointer components are set to zero.  */
> > +      if (result == NULL_TREE && sym->attr.function
> > +	  && sym->ts.type == BT_DERIVED
> > +	  && (sym->ts.u.derived->attr.alloc_comp
> > +	      || sym->ts.u.derived->attr.pointer_comp))
> > +	{
> > +	  artificial_result_decl = true;
> > +	  result = gfc_get_fake_result_decl (sym, 0);
> > +	}
> 
> I expect the "fake" result decl to be needed in more cases.
> For example, if type is BT_CLASS.
> Here is a variant of alloc_comp_class_4.f03:c_init for such a case.
> 
>   class(c) function c_init2()
>     allocatable :: c_init2
>   end function
> 
> or even without class:
> 
>   type(t) function t_init()
>     allocatable :: t_init
>   end function
> 
> for some any type t.
> 
> So, remove the check for alloc_comp/pointer_comp and permit BT_CLASS.
> One minor thing, check sym->result's type and attribute instead of sym's
> here.  It should not make a difference, but I think it's more correct.

I am d'accord with checking sym->result, but I am not happy with removing the
checks for alloc_comp|pointer_comp. When I got you right there, you propose the
if to be like this:

      if (result == NULL_TREE && sym->attr.function
	  && (sym->result->ts.type == BT_DERIVED
	      || sym->result->ts.type == BT_CLASS))

Removing the attribute checks means to initialize every derived/class type
result, which may change the semantics of the code more than intented. Look for
example at this code

  type t
    integer :: i = 5
  end type

  type(t) function static_t_init()
  end function

When one compiles this code with -Wreturn-type, then the warning of an
uninitialized return value is issued at the function declaration. Nevertheless
the result of static_t_init is validly initialized and i is 5. This may
confuse users.

I therefore came to the very ugly solution to make this:

      if (result == NULL_TREE && sym->attr.function
	  && ((sym->result->ts.type == BT_DERIVED
	       && (sym->results->attr.allocatable
		   || sym->result->ts.u.derived->attr.alloc_comp
		   || sym->result->ts.u.derived->attr.pointer_comp))
	      || (sym->result->ts.type == BT_CLASS
		  && (CLASS_DATA (sym->result)->attr.allocatable
		      || CLASS_DATA (sym->result)->attr.alloc_comp
		      || CLASS_DATA (sym->result)->attr.pointer_comp))))

(I am not yet sure, whether the pointer attribute needs to be added to.) With
the code above the result of static_t_init is not initialized with all the
consequences. 

So what do you propose to do here?

Btw, I think I found an additional bug during testing: 
  type(t) function t_init()
    allocatable :: t_init
  end function
 
when called by:
  type(t), allocatable :: temp
  temp = t_init()

a segfault occurs, because the result of t_init() is NULL, which is
dereferenced by the caller in this pseudo-code:

  if (temp != 0B) goto L.12;
  temp = (struct t *) __builtin_malloc (4);
L.12:;
  *temp = *t_init (); <-- This obviously is problematic.

> The rest looks good.
> The patch is OK with the suggested changes above.  Thanks.
> I don't think the test functions above work well enough to be
> incorporated in a testcase for now.

?? I don't get you there? What do you mean? Do you think the
alloc_comp_class_3/4.* are not correctly testing the issue? Any idea of how to
test this better? I mean the pr is about this artificial constructs. I merely
struck it in search of a pr about allocatable components. 

Attached is a version of the patch that I currently use. Note the testcase
alloc_comp_class_4.f03 fails currently, because of the error noted above in
line 94.

Regards,
	Andre
-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: pr58586_4.patch --]
[-- Type: text/x-patch, Size: 9368 bytes --]

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2ac4689..72df35e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -14093,10 +14093,15 @@ resolve_symbol (gfc_symbol *sym)
 
       if ((!a->save && !a->dummy && !a->pointer
 	   && !a->in_common && !a->use_assoc
-	   && (a->referenced || a->result)
-	   && !(a->function && sym != sym->result))
+	   && !a->result && !a->function)
 	  || (a->dummy && a->intent == INTENT_OUT && !a->pointer))
 	apply_default_init (sym);
+      else if (a->function && sym->result && a->access != ACCESS_PRIVATE
+	       && (sym->ts.u.derived->attr.alloc_comp
+		   || sym->ts.u.derived->attr.pointer_comp))
+	/* Mark the result symbol to be referenced, when it has allocatable
+	   components.  */
+	sym->result->attr.referenced = 1;
     }
 
   if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 4c18920..bcafd8c5 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -5898,8 +5898,26 @@ gfc_generate_function_code (gfc_namespace * ns)
 
   if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node)
     {
+      bool artificial_result_decl = false;
       tree result = get_proc_result (sym);
 
+      /* Make sure that a function returning an object with
+	 alloc/pointer_components always has a result, where at least
+	 the allocatable/pointer components are set to zero.  */
+      if (result == NULL_TREE && sym->attr.function
+	  && ((sym->result->ts.type == BT_DERIVED
+	       && (sym->result->attr.allocatable
+		   || sym->result->ts.u.derived->attr.alloc_comp
+		   || sym->result->ts.u.derived->attr.pointer_comp))
+	      || (sym->result->ts.type == BT_CLASS
+		  && (CLASS_DATA (sym->result)->attr.allocatable
+		      || CLASS_DATA (sym->result)->attr.alloc_comp
+		      || CLASS_DATA (sym->result)->attr.pointer_comp))))
+	{
+	  artificial_result_decl = true;
+	  result = gfc_get_fake_result_decl (sym, 0);
+	}
+
       if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer)
 	{
 	  if (sym->attr.allocatable && sym->attr.dimension == 0
@@ -5918,16 +5936,26 @@ gfc_generate_function_code (gfc_namespace * ns)
 							null_pointer_node));
 	    }
 	  else if (sym->ts.type == BT_DERIVED
-		   && sym->ts.u.derived->attr.alloc_comp
 		   && !sym->attr.allocatable)
 	    {
-	      rank = sym->as ? sym->as->rank : 0;
-	      tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
-	      gfc_add_expr_to_block (&init, tmp);
+	      gfc_expr *init_exp;
+	      init_exp = gfc_default_initializer (&sym->ts);
+	      if (init_exp)
+		{
+		  tmp = gfc_trans_structure_assign (result, init_exp, 0);
+		  gfc_free_expr (init_exp);
+		  gfc_add_expr_to_block (&init, tmp);
+		}
+	      else if (sym->ts.u.derived->attr.alloc_comp)
+		{
+		  rank = sym->as ? sym->as->rank : 0;
+		  tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
+		  gfc_add_expr_to_block (&init, tmp);
+		}
 	    }
 	}
 
-      if (result == NULL_TREE)
+      if (result == NULL_TREE || artificial_result_decl)
 	{
 	  /* TODO: move to the appropriate place in resolve.c.  */
 	  if (warn_return_type && sym == sym->result)
@@ -5937,7 +5965,7 @@ gfc_generate_function_code (gfc_namespace * ns)
 	  if (warn_return_type)
 	    TREE_NO_WARNING(sym->backend_decl) = 1;
 	}
-      else
+      if (result != NULL_TREE)
 	gfc_add_expr_to_block (&body, gfc_generate_return ());
     }
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 4bbd685..16e584a 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1472,7 +1472,6 @@ realloc_lhs_warning (bt type, bool array, locus *where)
 }
 
 
-static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init);
 static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *,
 						 gfc_expr *);
 
@@ -5341,12 +5340,22 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS)
 	    && e->ts.u.derived->attr.alloc_comp
 	    && !(e->symtree && e->symtree->n.sym->attr.pointer)
-	    && e->expr_type != EXPR_VARIABLE && !e->rank
-	    && e->expr_type != EXPR_STRUCTURE)
+	    && 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 (!DECL_P (parmse.expr))
+	    parmse.expr = gfc_evaluate_now_loc (input_location,
+						parmse.expr, &se->pre);
+
+	  if (fsym && fsym->attr.value)
+	    tmp = parmse.expr;
+	  else
+	    tmp = build_fold_indirect_ref_loc (input_location,
+					       parmse.expr);
+
 	  parm_rank = e->rank;
 	  switch (parm_kind)
 	    {
@@ -7137,7 +7146,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
 
 /* Assign a derived type constructor to a variable.  */
 
-static tree
+tree
 gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init)
 {
   gfc_constructor *c;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index e2a1fea..3198c55 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -666,6 +666,9 @@ tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespe
 /* Generate code to call realloc().  */
 tree gfc_call_realloc (stmtblock_t *, tree, tree);
 
+/* Assign a derived type constructor to a variable.  */
+tree gfc_trans_structure_assign (tree, gfc_expr *, bool);
+
 /* Generate code for an assignment, includes scalarization.  */
 tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool);
 
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
new file mode 100644
index 0000000..0753e33
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-options "-Wreturn-type" }
+!
+! 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
+
+  type :: t
+    integer, allocatable :: comp
+  end type
+  type :: u
+    type(t), allocatable :: comp
+  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())
+
+  call sub(u())
+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()  ! { dg-warning "not set" }
+  end function
+
+  subroutine sub(d)
+    type(u), value :: d
+  end subroutine
+end program test_pr58586
+
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
new file mode 100644
index 0000000..e4c796e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
@@ -0,0 +1,104 @@
+! { dg-do run }
+! { dg-options "-Wreturn-type" }
+!
+! Check that pr58586 is fixed now.
+! Based on a contribution by Vladimir Fuka
+! Contibuted by Andre Vehreschild
+
+module test_pr58586_mod
+  implicit none
+
+  type :: a
+  end type
+
+  type :: c
+     type(a), allocatable :: a
+  end type
+
+  type :: d
+  contains
+     procedure :: init => d_init
+  end type
+
+  type, extends(d) :: e
+  contains
+     procedure :: init => e_init
+  end type
+
+  type :: b
+     integer, allocatable :: a
+  end type
+
+  type t
+    integer :: i = 5
+  end type
+
+contains
+
+  subroutine add (d)
+    type(b), value :: d
+  end subroutine
+
+  subroutine add_c (d)
+    type(c), value :: d
+  end subroutine
+
+  subroutine add_class_c (d)
+    class(c), value :: d
+  end subroutine
+
+  subroutine add_t (d)
+    type(t), value :: d
+  end subroutine
+
+  type(c) function c_init() ! { dg-warning "not set" }
+  end function
+
+  class(c) function c_init2() ! { dg-warning "not set" }
+    allocatable :: c_init2
+  end function
+
+  type(c) function d_init(this) ! { dg-warning "not set" }
+    class(d) :: this
+  end function
+
+  type(c) function e_init(this)
+    class(e) :: this
+    allocate (e_init%a)
+  end function
+
+  type(t) function t_init() ! { dg-warning "not set" }
+    allocatable :: t_init
+  end function
+
+  type(t) function static_t_init() ! { dg-warning "not set" }
+  end function
+end module test_pr58586_mod
+
+program test_pr58586
+  use test_pr58586_mod
+
+  class(d), allocatable :: od
+  class(e), allocatable :: oe
+  type(t), allocatable :: temp
+
+  ! 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())
+  call add_class_c(c_init2())
+
+  call add_t(static_t_init())
+  temp = t_init() ! <-- This derefs a null-pointer currently
+  if (allocated (temp)) call abort()
+
+  allocate(od)
+  call add_c(od%init())
+  deallocate(od)
+  allocate(oe)
+  call add_c(oe%init())
+  deallocate(oe)
+end program
+

Re: [Patch, Fortran, PR58586, v3] ICE with derived type with allocatable component passed by value

[Mikael Morin]

Le 08/05/2015 12:54, Andre Vehreschild a écrit :
> Hi Mikael,
> 
> thanks for the review. I still have some questions/remarks before commiting:
> 
>>> @@ -5898,8 +5900,21 @@ gfc_generate_function_code (gfc_namespace * ns)
>>>  
>>>    if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node)
>>>      {
>>> +      bool artificial_result_decl = false;
>>>        tree result = get_proc_result (sym);
>>>  
>>> +      /* Make sure that a function returning an object with
>>> +	 alloc/pointer_components always has a result, where at least
>>> +	 the allocatable/pointer components are set to zero.  */
>>> +      if (result == NULL_TREE && sym->attr.function
>>> +	  && sym->ts.type == BT_DERIVED
>>> +	  && (sym->ts.u.derived->attr.alloc_comp
>>> +	      || sym->ts.u.derived->attr.pointer_comp))
>>> +	{
>>> +	  artificial_result_decl = true;
>>> +	  result = gfc_get_fake_result_decl (sym, 0);
>>> +	}
>>
>> I expect the "fake" result decl to be needed in more cases.
>> For example, if type is BT_CLASS.
>> Here is a variant of alloc_comp_class_4.f03:c_init for such a case.
>>
>>   class(c) function c_init2()
>>     allocatable :: c_init2
>>   end function
>>
>> or even without class:
>>
>>   type(t) function t_init()
>>     allocatable :: t_init
>>   end function
>>
>> for some any type t.
>>
>> So, remove the check for alloc_comp/pointer_comp and permit BT_CLASS.
>> One minor thing, check sym->result's type and attribute instead of sym's
>> here.  It should not make a difference, but I think it's more correct.
> 
> I am d'accord with checking sym->result, but I am not happy with removing the
> checks for alloc_comp|pointer_comp. When I got you right there, you propose the
> if to be like this:
> 
>       if (result == NULL_TREE && sym->attr.function
> 	  && (sym->result->ts.type == BT_DERIVED
> 	      || sym->result->ts.type == BT_CLASS))
> 
> Removing the attribute checks means to initialize every derived/class type
> result, which may change the semantics of the code more than intented. Look for
> example at this code
> 
>   type t
>     integer :: i = 5
>   end type
> 
>   type(t) function static_t_init()
>   end function
> 
> When one compiles this code with -Wreturn-type, then the warning of an
> uninitialized return value is issued at the function declaration. Nevertheless
> the result of static_t_init is validly initialized and i is 5. This may
> confuse users.
> 
> I therefore came to the very ugly solution to make this:
> 
>       if (result == NULL_TREE && sym->attr.function
> 	  && ((sym->result->ts.type == BT_DERIVED
> 	       && (sym->results->attr.allocatable
> 		   || sym->result->ts.u.derived->attr.alloc_comp
> 		   || sym->result->ts.u.derived->attr.pointer_comp))
> 	      || (sym->result->ts.type == BT_CLASS
> 		  && (CLASS_DATA (sym->result)->attr.allocatable
> 		      || CLASS_DATA (sym->result)->attr.alloc_comp
> 		      || CLASS_DATA (sym->result)->attr.pointer_comp))))
> 
> (I am not yet sure, whether the pointer attribute needs to be added to.) With
> the code above the result of static_t_init is not initialized with all the
> consequences. 
> 
> So what do you propose to do here?

To be honest, I don't know this part of the code very well.
I'll think about it some more.

> Btw, I think I found an additional bug during testing: 
>   type(t) function t_init()
>     allocatable :: t_init
>   end function
>  
> when called by:
>   type(t), allocatable :: temp
>   temp = t_init()
> 
> a segfault occurs, because the result of t_init() is NULL, which is
> dereferenced by the caller in this pseudo-code:
> 
>   if (temp != 0B) goto L.12;
>   temp = (struct t *) __builtin_malloc (4);
> L.12:;
>   *temp = *t_init (); <-- This obviously is problematic.
> 
>> The rest looks good.
>> The patch is OK with the suggested changes above.  Thanks.
>> I don't think the test functions above work well enough to be
>> incorporated in a testcase for now.
> 
> ?? I don't get you there? What do you mean? Do you think the
> alloc_comp_class_3/4.* are not correctly testing the issue? Any idea of how to
> test this better? I mean the pr is about this artificial constructs. I merely
> struck it in search of a pr about allocatable components. 

I was talking about the bug you found with t_init above.  :-)
the compiler is not ready to accept that function in a testcase.
The alloc_omp_class_3/4 are fine.

Mikael

Re: [Patch, Fortran, PR58586, v3] ICE with derived type with allocatable component passed by value

[Andre Vehreschild]

Hi Mikael,

> > ?? I don't get you there? What do you mean? Do you think the
> > alloc_comp_class_3/4.* are not correctly testing the issue? Any idea of how
> > to test this better? I mean the pr is about this artificial constructs. I
> > merely struck it in search of a pr about allocatable components. 
> 
> I was talking about the bug you found with t_init above.  :-)
> the compiler is not ready to accept that function in a testcase.
> The alloc_omp_class_3/4 are fine.

Oh, sorry, I misunderstood you there. Now let's see, where that one is hiding.

- Andre
-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

Re: [Patch, Fortran, PR58586, v3] ICE with derived type with allocatable component passed by value

[Andre Vehreschild]

[-- Attachment #1: Type: text/plain, Size: 996 bytes --]

Hi,

so attached is a quick and dirty solution for the allocatable return value
problem. I personally don't like it. It is making a special case from the
assign a function result to a variable. May be you have a better idea how to do
this in gfortran style.

- Andre


On Fri, 8 May 2015 15:31:46 +0200
Andre Vehreschild <vehre@gmx.de> wrote:

> Hi Mikael,
> 
> > > ?? I don't get you there? What do you mean? Do you think the
> > > alloc_comp_class_3/4.* are not correctly testing the issue? Any idea of
> > > how to test this better? I mean the pr is about this artificial
> > > constructs. I merely struck it in search of a pr about allocatable
> > > components. 
> > 
> > I was talking about the bug you found with t_init above.  :-)
> > the compiler is not ready to accept that function in a testcase.
> > The alloc_omp_class_3/4 are fine.
> 
> Oh, sorry, I misunderstood you there. Now let's see, where that one is hiding.
> 
> - Andre


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: alloc_func_result.patch --]
[-- Type: text/x-patch, Size: 1633 bytes --]

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 402d9b9..87e2cde 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -9043,6 +9043,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
   stmtblock_t body;
   bool l_is_temp;
   bool scalar_to_array;
+  bool alloc_to_alloc;
   tree string_length;
   int n;
 
@@ -9156,6 +9157,18 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
   else
     gfc_conv_expr (&lse, expr1);
 
+  alloc_to_alloc = expr1->expr_type == EXPR_VARIABLE
+      && expr1->symtree->n.sym->ts.type == BT_DERIVED
+      && expr1->symtree->n.sym->attr.allocatable
+      && expr2->expr_type == EXPR_FUNCTION
+      && expr2->ts.type == BT_DERIVED
+      && expr2->value.function.esym->attr.allocatable;
+  if (alloc_to_alloc)
+    {
+      rse.expr = gfc_build_addr_expr (NULL_TREE, rse.expr);
+      lse.expr = gfc_build_addr_expr (NULL_TREE, lse.expr);;
+    }
+
   /* Assignments of scalar derived types with allocatable components
      to arrays must be done with a deep copy and the rhs temporary
      must have its components deallocated afterwards.  */
@@ -9208,7 +9221,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
   if (lss == gfc_ss_terminator)
     {
       /* F2003: Add the code for reallocation on assignment.  */
-      if (flag_realloc_lhs && is_scalar_reallocatable_lhs (expr1))
+      if (flag_realloc_lhs && !alloc_to_alloc
+	  && is_scalar_reallocatable_lhs (expr1))
 	alloc_scalar_allocatable_for_assignment (&block, string_length,
 						 expr1, expr2);
 

Re: [Patch, Fortran, PR58586, v4] ICE with derived type with allocatable component passed by value

[Andre Vehreschild]

[-- Attachment #1: Type: text/plain, Size: 1411 bytes --]

Hi,

attached is the most recent version of the patch for 58586. It adapts to
recent trunk and addresses the caveats so far, i.e. the testcases in the
comments now compile and run again w/o errors.

Bootstraps and regtests fine on x86_64-linux-gnu/f21.

Comments?

- Andre

On Fri, 8 May 2015 16:11:11 +0200
Andre Vehreschild <vehre@gmx.de> wrote:

> Hi,
> 
> so attached is a quick and dirty solution for the allocatable return value
> problem. I personally don't like it. It is making a special case from the
> assign a function result to a variable. May be you have a better idea how to
> do this in gfortran style.
> 
> - Andre
> 
> 
> On Fri, 8 May 2015 15:31:46 +0200
> Andre Vehreschild <vehre@gmx.de> wrote:
> 
> > Hi Mikael,
> > 
> > > > ?? I don't get you there? What do you mean? Do you think the
> > > > alloc_comp_class_3/4.* are not correctly testing the issue? Any idea of
> > > > how to test this better? I mean the pr is about this artificial
> > > > constructs. I merely struck it in search of a pr about allocatable
> > > > components. 
> > > 
> > > I was talking about the bug you found with t_init above.  :-)
> > > the compiler is not ready to accept that function in a testcase.
> > > The alloc_omp_class_3/4 are fine.
> > 
> > Oh, sorry, I misunderstood you there. Now let's see, where that one is
> > hiding.
> > 
> > - Andre
> 
> 


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: pr58586_4.clog --]
[-- Type: text/plain, Size: 1062 bytes --]

gcc/testsuite/ChangeLog:

2015-05-19  Andre Vehreschild  <vehre@gmx.de>

	* gfortran.dg/alloc_comp_class_3.f03: New test.
	* gfortran.dg/alloc_comp_class_4.f03: New test.


gcc/fortran/ChangeLog:

2015-05-19  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/58586
	* resolve.c (resolve_symbol): Non-private functions in modules
	with allocatable or pointer components are marked referenced
	now. Furthermore is the default init especially for those
	components now done in gfc_conf_procedure_call preventing
	duplicate code.
	* trans-decl.c (gfc_generate_function_code): Generate a fake
	result decl for	functions returning an object with allocatable
	components and initialize them.
	* trans-expr.c (gfc_conv_procedure_call): For value typed trees
	use the tree without indirect ref. And for non-decl trees
	add a temporary variable to prevent evaluating the tree
	multiple times (prevent multiple function evaluations).
	* trans.h: Made gfc_trans_structure_assign () protoype
	available, which is now needed by trans-decl.c:gfc_generate_
	function_code(), too.


[-- Attachment #3: pr58586_4.patch --]
[-- Type: text/x-patch, Size: 10216 bytes --]

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index fc11d23..e1b5762 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -14094,10 +14094,15 @@ resolve_symbol (gfc_symbol *sym)
 
       if ((!a->save && !a->dummy && !a->pointer
 	   && !a->in_common && !a->use_assoc
-	   && (a->referenced || a->result)
-	   && !(a->function && sym != sym->result))
+	   && !a->result && !a->function)
 	  || (a->dummy && a->intent == INTENT_OUT && !a->pointer))
 	apply_default_init (sym);
+      else if (a->function && sym->result && a->access != ACCESS_PRIVATE
+	       && (sym->ts.u.derived->attr.alloc_comp
+		   || sym->ts.u.derived->attr.pointer_comp))
+	/* Mark the result symbol to be referenced, when it has allocatable
+	   components.  */
+	sym->result->attr.referenced = 1;
     }
 
   if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 4c18920..f9a91c6 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -5896,9 +5896,33 @@ gfc_generate_function_code (gfc_namespace * ns)
   tmp = gfc_trans_code (ns->code);
   gfc_add_expr_to_block (&body, tmp);
 
-  if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node)
+  if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
+      || (sym->result && sym->result != sym
+	  && sym->result->ts.type == BT_DERIVED
+	  && sym->result->ts.u.derived->attr.alloc_comp))
     {
+      bool artificial_result_decl = false;
       tree result = get_proc_result (sym);
+      gfc_symbol *rsym = sym == sym->result ? sym : sym->result;
+
+      /* Make sure that a function returning an object with
+	 alloc/pointer_components always has a result, where at least
+	 the allocatable/pointer components are set to zero.  */
+      if (result == NULL_TREE && sym->attr.function
+	  && ((sym->result->ts.type == BT_DERIVED
+	       && (sym->attr.allocatable
+		   || sym->attr.pointer
+		   || sym->result->ts.u.derived->attr.alloc_comp
+		   || sym->result->ts.u.derived->attr.pointer_comp))
+	      || (sym->result->ts.type == BT_CLASS
+		  && (CLASS_DATA (sym)->attr.allocatable
+		      || CLASS_DATA (sym)->attr.class_pointer
+		      || CLASS_DATA (sym->result)->attr.alloc_comp
+		      || CLASS_DATA (sym->result)->attr.pointer_comp))))
+	{
+	  artificial_result_decl = true;
+	  result = gfc_get_fake_result_decl (sym, 0);
+	}
 
       if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer)
 	{
@@ -5918,16 +5942,30 @@ gfc_generate_function_code (gfc_namespace * ns)
 							null_pointer_node));
 	    }
 	  else if (sym->ts.type == BT_DERIVED
-		   && sym->ts.u.derived->attr.alloc_comp
 		   && !sym->attr.allocatable)
 	    {
-	      rank = sym->as ? sym->as->rank : 0;
-	      tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
-	      gfc_add_expr_to_block (&init, tmp);
+	      gfc_expr *init_exp;
+	      /* Arrays are not initialized using the default initializer of
+		 their elements.  Therefore only check if a default
+		 initializer is available when the result is scalar.  */
+	      init_exp = rsym->as ? NULL : gfc_default_initializer (&rsym->ts);
+	      if (init_exp)
+		{
+		  tmp = gfc_trans_structure_assign (result, init_exp, 0);
+		  gfc_free_expr (init_exp);
+		  gfc_add_expr_to_block (&init, tmp);
+		}
+	      else if (rsym->ts.u.derived->attr.alloc_comp)
+		{
+		  rank = rsym->as ? rsym->as->rank : 0;
+		  tmp = gfc_nullify_alloc_comp (rsym->ts.u.derived, result,
+						rank);
+		  gfc_prepend_expr_to_block (&body, tmp);
+		}
 	    }
 	}
 
-      if (result == NULL_TREE)
+      if (result == NULL_TREE || artificial_result_decl)
 	{
 	  /* TODO: move to the appropriate place in resolve.c.  */
 	  if (warn_return_type && sym == sym->result)
@@ -5937,7 +5975,7 @@ gfc_generate_function_code (gfc_namespace * ns)
 	  if (warn_return_type)
 	    TREE_NO_WARNING(sym->backend_decl) = 1;
 	}
-      else
+      if (result != NULL_TREE)
 	gfc_add_expr_to_block (&body, gfc_generate_return ());
     }
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 710bdcf..048d16e 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1472,7 +1472,6 @@ realloc_lhs_warning (bt type, bool array, locus *where)
 }
 
 
-static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init);
 static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *,
 						 gfc_expr *);
 
@@ -5329,12 +5328,22 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS)
 	    && e->ts.u.derived->attr.alloc_comp
 	    && !(e->symtree && e->symtree->n.sym->attr.pointer)
-	    && e->expr_type != EXPR_VARIABLE && !e->rank
-	    && e->expr_type != EXPR_STRUCTURE)
+	    && 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 (!DECL_P (parmse.expr))
+	    parmse.expr = gfc_evaluate_now_loc (input_location,
+						parmse.expr, &se->pre);
+
+	  if (fsym && fsym->attr.value)
+	    tmp = parmse.expr;
+	  else
+	    tmp = build_fold_indirect_ref_loc (input_location,
+					       parmse.expr);
+
 	  parm_rank = e->rank;
 	  switch (parm_kind)
 	    {
@@ -7137,7 +7146,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
 
 /* Assign a derived type constructor to a variable.  */
 
-static tree
+tree
 gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init)
 {
   gfc_constructor *c;
@@ -7450,7 +7459,7 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
       if (expr->ts.type == BT_CHARACTER
 	  && expr->expr_type != EXPR_FUNCTION)
 	gfc_conv_string_parameter (se);
-      else
+     else
 	se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
 
       return;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 570b5b8..f5d4d20 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -669,6 +669,9 @@ tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespe
 /* Generate code to call realloc().  */
 tree gfc_call_realloc (stmtblock_t *, tree, tree);
 
+/* Assign a derived type constructor to a variable.  */
+tree gfc_trans_structure_assign (tree, gfc_expr *, bool);
+
 /* Generate code for an assignment, includes scalarization.  */
 tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool);
 
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
new file mode 100644
index 0000000..0753e33
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-options "-Wreturn-type" }
+!
+! 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
+
+  type :: t
+    integer, allocatable :: comp
+  end type
+  type :: u
+    type(t), allocatable :: comp
+  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())
+
+  call sub(u())
+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()  ! { dg-warning "not set" }
+  end function
+
+  subroutine sub(d)
+    type(u), value :: d
+  end subroutine
+end program test_pr58586
+
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
new file mode 100644
index 0000000..e4c796e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
@@ -0,0 +1,104 @@
+! { dg-do run }
+! { dg-options "-Wreturn-type" }
+!
+! Check that pr58586 is fixed now.
+! Based on a contribution by Vladimir Fuka
+! Contibuted by Andre Vehreschild
+
+module test_pr58586_mod
+  implicit none
+
+  type :: a
+  end type
+
+  type :: c
+     type(a), allocatable :: a
+  end type
+
+  type :: d
+  contains
+     procedure :: init => d_init
+  end type
+
+  type, extends(d) :: e
+  contains
+     procedure :: init => e_init
+  end type
+
+  type :: b
+     integer, allocatable :: a
+  end type
+
+  type t
+    integer :: i = 5
+  end type
+
+contains
+
+  subroutine add (d)
+    type(b), value :: d
+  end subroutine
+
+  subroutine add_c (d)
+    type(c), value :: d
+  end subroutine
+
+  subroutine add_class_c (d)
+    class(c), value :: d
+  end subroutine
+
+  subroutine add_t (d)
+    type(t), value :: d
+  end subroutine
+
+  type(c) function c_init() ! { dg-warning "not set" }
+  end function
+
+  class(c) function c_init2() ! { dg-warning "not set" }
+    allocatable :: c_init2
+  end function
+
+  type(c) function d_init(this) ! { dg-warning "not set" }
+    class(d) :: this
+  end function
+
+  type(c) function e_init(this)
+    class(e) :: this
+    allocate (e_init%a)
+  end function
+
+  type(t) function t_init() ! { dg-warning "not set" }
+    allocatable :: t_init
+  end function
+
+  type(t) function static_t_init() ! { dg-warning "not set" }
+  end function
+end module test_pr58586_mod
+
+program test_pr58586
+  use test_pr58586_mod
+
+  class(d), allocatable :: od
+  class(e), allocatable :: oe
+  type(t), allocatable :: temp
+
+  ! 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())
+  call add_class_c(c_init2())
+
+  call add_t(static_t_init())
+  temp = t_init() ! <-- This derefs a null-pointer currently
+  if (allocated (temp)) call abort()
+
+  allocate(od)
+  call add_c(od%init())
+  deallocate(od)
+  allocate(oe)
+  call add_c(oe%init())
+  deallocate(oe)
+end program
+

Re: [Ping, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value

[Andre Vehreschild]

[-- Attachment #1: Type: text/plain, Size: 984 bytes --]

Ping!

Version increment only to reflect rebasing on current trunk.

Bootstraps and regtests fine on x86_64-linux-gnu/f21.

I am tempted to follow Paul's method of setting a deadline for objections. Else
I will commit the patch next Friday (just kidding). I am more interested in
a review. The patch now lives in my code base for several months and is used to
compile a rather sophisticated fortran code without issues. So I expect no big
trouble in trunk given that the patch addresses a rather seldomly (;-)) used
construct. 

Ok for trunk?

Regards,
	Andre

On Tue, 19 May 2015 16:01:37 +0200
Andre Vehreschild <vehre@gmx.de> wrote:

> Hi,
> 
> attached is the most recent version of the patch for 58586. It adapts to
> recent trunk and addresses the caveats so far, i.e. the testcases in the
> comments now compile and run again w/o errors.
> 
> Bootstraps and regtests fine on x86_64-linux-gnu/f21.
> 
> Comments?
> 
> - Andre
-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: pr58586_5.clog --]
[-- Type: application/octet-stream, Size: 1062 bytes --]

gcc/testsuite/ChangeLog:

2015-07-03  Andre Vehreschild  <vehre@gmx.de>

	* gfortran.dg/alloc_comp_class_3.f03: New test.
	* gfortran.dg/alloc_comp_class_4.f03: New test.


gcc/fortran/ChangeLog:

2015-07-03  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/58586
	* resolve.c (resolve_symbol): Non-private functions in modules
	with allocatable or pointer components are marked referenced
	now. Furthermore is the default init especially for those
	components now done in gfc_conf_procedure_call preventing
	duplicate code.
	* trans-decl.c (gfc_generate_function_code): Generate a fake
	result decl for	functions returning an object with allocatable
	components and initialize them.
	* trans-expr.c (gfc_conv_procedure_call): For value typed trees
	use the tree without indirect ref. And for non-decl trees
	add a temporary variable to prevent evaluating the tree
	multiple times (prevent multiple function evaluations).
	* trans.h: Made gfc_trans_structure_assign () protoype
	available, which is now needed by trans-decl.c:gfc_generate_
	function_code(), too.


[-- Attachment #3: pr58586_5.patch --]
[-- Type: text/x-patch, Size: 9954 bytes --]

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index efafabc..d16bf13 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -14083,10 +14083,15 @@ resolve_symbol (gfc_symbol *sym)
 
       if ((!a->save && !a->dummy && !a->pointer
 	   && !a->in_common && !a->use_assoc
-	   && (a->referenced || a->result)
-	   && !(a->function && sym != sym->result))
+	   && !a->result && !a->function)
 	  || (a->dummy && a->intent == INTENT_OUT && !a->pointer))
 	apply_default_init (sym);
+      else if (a->function && sym->result && a->access != ACCESS_PRIVATE
+	       && (sym->ts.u.derived->attr.alloc_comp
+		   || sym->ts.u.derived->attr.pointer_comp))
+	/* Mark the result symbol to be referenced, when it has allocatable
+	   components.  */
+	sym->result->attr.referenced = 1;
     }
 
   if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index b4f75ba..aec2018 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -5885,9 +5885,33 @@ gfc_generate_function_code (gfc_namespace * ns)
   tmp = gfc_trans_code (ns->code);
   gfc_add_expr_to_block (&body, tmp);
 
-  if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node)
+  if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
+      || (sym->result && sym->result != sym
+	  && sym->result->ts.type == BT_DERIVED
+	  && sym->result->ts.u.derived->attr.alloc_comp))
     {
+      bool artificial_result_decl = false;
       tree result = get_proc_result (sym);
+      gfc_symbol *rsym = sym == sym->result ? sym : sym->result;
+
+      /* Make sure that a function returning an object with
+	 alloc/pointer_components always has a result, where at least
+	 the allocatable/pointer components are set to zero.  */
+      if (result == NULL_TREE && sym->attr.function
+	  && ((sym->result->ts.type == BT_DERIVED
+	       && (sym->attr.allocatable
+		   || sym->attr.pointer
+		   || sym->result->ts.u.derived->attr.alloc_comp
+		   || sym->result->ts.u.derived->attr.pointer_comp))
+	      || (sym->result->ts.type == BT_CLASS
+		  && (CLASS_DATA (sym)->attr.allocatable
+		      || CLASS_DATA (sym)->attr.class_pointer
+		      || CLASS_DATA (sym->result)->attr.alloc_comp
+		      || CLASS_DATA (sym->result)->attr.pointer_comp))))
+	{
+	  artificial_result_decl = true;
+	  result = gfc_get_fake_result_decl (sym, 0);
+	}
 
       if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer)
 	{
@@ -5907,16 +5931,30 @@ gfc_generate_function_code (gfc_namespace * ns)
 							null_pointer_node));
 	    }
 	  else if (sym->ts.type == BT_DERIVED
-		   && sym->ts.u.derived->attr.alloc_comp
 		   && !sym->attr.allocatable)
 	    {
-	      rank = sym->as ? sym->as->rank : 0;
-	      tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
-	      gfc_add_expr_to_block (&init, tmp);
+	      gfc_expr *init_exp;
+	      /* Arrays are not initialized using the default initializer of
+		 their elements.  Therefore only check if a default
+		 initializer is available when the result is scalar.  */
+	      init_exp = rsym->as ? NULL : gfc_default_initializer (&rsym->ts);
+	      if (init_exp)
+		{
+		  tmp = gfc_trans_structure_assign (result, init_exp, 0);
+		  gfc_free_expr (init_exp);
+		  gfc_add_expr_to_block (&init, tmp);
+		}
+	      else if (rsym->ts.u.derived->attr.alloc_comp)
+		{
+		  rank = rsym->as ? rsym->as->rank : 0;
+		  tmp = gfc_nullify_alloc_comp (rsym->ts.u.derived, result,
+						rank);
+		  gfc_prepend_expr_to_block (&body, tmp);
+		}
 	    }
 	}
 
-      if (result == NULL_TREE)
+      if (result == NULL_TREE || artificial_result_decl)
 	{
 	  /* TODO: move to the appropriate place in resolve.c.  */
 	  if (warn_return_type && sym == sym->result)
@@ -5926,7 +5964,7 @@ gfc_generate_function_code (gfc_namespace * ns)
 	  if (warn_return_type)
 	    TREE_NO_WARNING(sym->backend_decl) = 1;
 	}
-      else
+      if (result != NULL_TREE)
 	gfc_add_expr_to_block (&body, gfc_generate_return ());
     }
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 7747a67..195f7a4 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1465,7 +1465,6 @@ realloc_lhs_warning (bt type, bool array, locus *where)
 }
 
 
-static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init);
 static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *,
 						 gfc_expr *);
 
@@ -5340,8 +5339,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 (!DECL_P (parmse.expr))
+	    parmse.expr = gfc_evaluate_now_loc (input_location,
+						parmse.expr, &se->pre);
+
+	  if (fsym && fsym->attr.value)
+	    tmp = parmse.expr;
+	  else
+	    tmp = build_fold_indirect_ref_loc (input_location,
+					       parmse.expr);
+
 	  parm_rank = e->rank;
 	  switch (parm_kind)
 	    {
@@ -7158,7 +7168,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
 
 /* Assign a derived type constructor to a variable.  */
 
-static tree
+tree
 gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init)
 {
   gfc_constructor *c;
@@ -7471,7 +7481,7 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
       if (expr->ts.type == BT_CHARACTER
 	  && expr->expr_type != EXPR_FUNCTION)
 	gfc_conv_string_parameter (se);
-      else
+     else
 	se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
 
       return;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index e618088..f7cf5f0 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -669,6 +669,9 @@ tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespe
 /* Generate code to call realloc().  */
 tree gfc_call_realloc (stmtblock_t *, tree, tree);
 
+/* Assign a derived type constructor to a variable.  */
+tree gfc_trans_structure_assign (tree, gfc_expr *, bool);
+
 /* Generate code for an assignment, includes scalarization.  */
 tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool);
 
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
new file mode 100644
index 0000000..0753e33
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-options "-Wreturn-type" }
+!
+! 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
+
+  type :: t
+    integer, allocatable :: comp
+  end type
+  type :: u
+    type(t), allocatable :: comp
+  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())
+
+  call sub(u())
+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()  ! { dg-warning "not set" }
+  end function
+
+  subroutine sub(d)
+    type(u), value :: d
+  end subroutine
+end program test_pr58586
+
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
new file mode 100644
index 0000000..e4c796e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
@@ -0,0 +1,104 @@
+! { dg-do run }
+! { dg-options "-Wreturn-type" }
+!
+! Check that pr58586 is fixed now.
+! Based on a contribution by Vladimir Fuka
+! Contibuted by Andre Vehreschild
+
+module test_pr58586_mod
+  implicit none
+
+  type :: a
+  end type
+
+  type :: c
+     type(a), allocatable :: a
+  end type
+
+  type :: d
+  contains
+     procedure :: init => d_init
+  end type
+
+  type, extends(d) :: e
+  contains
+     procedure :: init => e_init
+  end type
+
+  type :: b
+     integer, allocatable :: a
+  end type
+
+  type t
+    integer :: i = 5
+  end type
+
+contains
+
+  subroutine add (d)
+    type(b), value :: d
+  end subroutine
+
+  subroutine add_c (d)
+    type(c), value :: d
+  end subroutine
+
+  subroutine add_class_c (d)
+    class(c), value :: d
+  end subroutine
+
+  subroutine add_t (d)
+    type(t), value :: d
+  end subroutine
+
+  type(c) function c_init() ! { dg-warning "not set" }
+  end function
+
+  class(c) function c_init2() ! { dg-warning "not set" }
+    allocatable :: c_init2
+  end function
+
+  type(c) function d_init(this) ! { dg-warning "not set" }
+    class(d) :: this
+  end function
+
+  type(c) function e_init(this)
+    class(e) :: this
+    allocate (e_init%a)
+  end function
+
+  type(t) function t_init() ! { dg-warning "not set" }
+    allocatable :: t_init
+  end function
+
+  type(t) function static_t_init() ! { dg-warning "not set" }
+  end function
+end module test_pr58586_mod
+
+program test_pr58586
+  use test_pr58586_mod
+
+  class(d), allocatable :: od
+  class(e), allocatable :: oe
+  type(t), allocatable :: temp
+
+  ! 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())
+  call add_class_c(c_init2())
+
+  call add_t(static_t_init())
+  temp = t_init() ! <-- This derefs a null-pointer currently
+  if (allocated (temp)) call abort()
+
+  allocate(od)
+  call add_c(od%init())
+  deallocate(od)
+  allocate(oe)
+  call add_c(oe%init())
+  deallocate(oe)
+end program
+

Re: [Ping, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value

[Steve Kargl]

On Fri, Jul 03, 2015 at 11:29:00AM +0200, Andre Vehreschild wrote:
> Ping!
> 

(Un)fortnuately you're working on an area of Fortran
that I don't know and in parts of the tree that takes
me a long time to decipher (aka, trans-*.c files).

I applied your patch and see several failures.  I'll 
note that I did not start from a clean obj/.  So, there
is the possibility that some *.o file needed to get
rebuilt but didn't.  Anyhow,

laptop-kargl:kargl[300] gfc -o z alloc_comp_class_4.f03 && ./z

Program received signal SIGSEGV: Segmentation fault - invalid memory reference.

Backtrace for this error:
#0  0x2808B9A6
#1  0x2808AB19
#2  0xBFBFF003
#3  0x8048DEA
#4  0x8049097
#5  0x8048779
Segmentation fault (core dumped)

Hmmm, Ok, I just looked at the source for alloc_comp_class_4.f03
and found line 94.

  temp = t_init() ! <-- This derefs a null-pointer currently

Not sure what to make of this.

-- 
Steve

Re: [Ping, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value

[Andre Vehreschild]

Hi Steve,

Thanks for looking at the code. The error you experience is known to me. The bug is present in gfortran and only exposed by this patch. Unfortunately is the pr58586 not addressing this specific error. It may be in the bugtracker under a different number already. Furthermore did I not want to extend the patch for 58586 any further, because I have learned that the more complicated a patch gets the longer review takes. For making the testcase run fine we also simply can comment the line.

Regards,
Andre

Am 4. Juli 2015 18:24:59 MESZ, schrieb Steve Kargl <sgk@troutmask.apl.washington.edu>:
>On Fri, Jul 03, 2015 at 11:29:00AM +0200, Andre Vehreschild wrote:
>> Ping!
>> 
>
>(Un)fortnuately you're working on an area of Fortran
>that I don't know and in parts of the tree that takes
>me a long time to decipher (aka, trans-*.c files).
>
>I applied your patch and see several failures.  I'll 
>note that I did not start from a clean obj/.  So, there
>is the possibility that some *.o file needed to get
>rebuilt but didn't.  Anyhow,
>
>laptop-kargl:kargl[300] gfc -o z alloc_comp_class_4.f03 && ./z
>
>Program received signal SIGSEGV: Segmentation fault - invalid memory
>reference.
>
>Backtrace for this error:
>#0  0x2808B9A6
>#1  0x2808AB19
>#2  0xBFBFF003
>#3  0x8048DEA
>#4  0x8049097
>#5  0x8048779
>Segmentation fault (core dumped)
>
>Hmmm, Ok, I just looked at the source for alloc_comp_class_4.f03
>and found line 94.
>
>  temp = t_init() ! <-- This derefs a null-pointer currently
>
>Not sure what to make of this.

-- 
Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
Mail: vehre@gmx.de * Tel.: +49 241 9291018

Re: [Ping, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value

[Steve Kargl]

On Sat, Jul 04, 2015 at 09:20:39PM +0200, Andre Vehreschild wrote:
> 
> Thanks for looking at the code. The error you experience is known
> to me. The bug is present in gfortran and only exposed by this patch.
> Unfortunately is the pr58586 not addressing this specific error. It
> may be in the bugtracker under a different number already. Furthermore
> did I not want to extend the patch for 58586 any further, because I
> have learned that the more complicated a patch gets the longer review
> takes. For making the testcase run fine we also simply can comment the line.
> 

I can appreciate the problem of fixing one bug may expose another,
and I agree that holding up a patch for 58586 due to a latent bug
seems unreasonable.  I reviewed the email history and it appears
that you've addressed Mikael's concerns.  My only comment would
be to comment out the problematic statement in alloc_comp_class_4.f03,
and open a new bug report to record the issue.  Ok to commit with
my suggested change.

-- 
Steve

Re: [Ping, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value

[Paul Richard Thomas]

Dear Andre,

I agree with Steve's recommendation that you comment out the line and
open a PR for the problem.

The patch looks fine to me and applied cleanly, apart from trailing
CRs in the testcases.

OK by me too.

Cheers

Paul

PS I felt safe in setting a deadline for the submodule patch because:
(i) It was obvious that nobody would review it because of its size;
and (ii) It is safely ring-fenced by the need for very specific
procedure attributes and declarations. I would not dream of doing the
same for other patches more integrated in parts of the compiler that
are frequented by commonly used code. For example, the patch to
encompass the use of private entities with submodules will be just
such a patch.... when I figure out how to do it! I can sympathize with
you though; you have often had to wait an excessively long time for
reviews.


On 5 July 2015 at 18:14, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
> On Sat, Jul 04, 2015 at 09:20:39PM +0200, Andre Vehreschild wrote:
>>
>> Thanks for looking at the code. The error you experience is known
>> to me. The bug is present in gfortran and only exposed by this patch.
>> Unfortunately is the pr58586 not addressing this specific error. It
>> may be in the bugtracker under a different number already. Furthermore
>> did I not want to extend the patch for 58586 any further, because I
>> have learned that the more complicated a patch gets the longer review
>> takes. For making the testcase run fine we also simply can comment the line.
>>
>
> I can appreciate the problem of fixing one bug may expose another,
> and I agree that holding up a patch for 58586 due to a latent bug
> seems unreasonable.  I reviewed the email history and it appears
> that you've addressed Mikael's concerns.  My only comment would
> be to comment out the problematic statement in alloc_comp_class_4.f03,
> and open a new bug report to record the issue.  Ok to commit with
> my suggested change.
>
> --
> Steve



-- 
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.

Groucho Marx

Re: [Ping, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value

[Steve Kargl]

On Sun, Jul 05, 2015 at 07:48:13PM +0200, Paul Richard Thomas wrote:
> Dear Andre,
> 
> I agree with Steve's recommendation that you comment out the line and
> open a PR for the problem.
> 
> The patch looks fine to me and applied cleanly, apart from trailing
> CRs in the testcases.
> 
> OK by me too.
> 
> Cheers
> 
> Paul
> 
> PS I felt safe in setting a deadline for the submodule patch because:
> (i) It was obvious that nobody would review it because of its size;
> and (ii) It is safely ring-fenced by the need for very specific
> procedure attributes and declarations. I would not dream of doing the
> same for other patches more integrated in parts of the compiler that
> are frequented by commonly used code. For example, the patch to
> encompass the use of private entities with submodules will be just
> such a patch.... when I figure out how to do it! I can sympathize with
> you though; you have often had to wait an excessively long time for
> reviews.
> 

Fortunately (or unfortunately depends how one looks at the situation)
Andre is working in an area that I feel very uncomfortable reviewing.
I haven't ventured into OOP Fortran, and I'm still recovering from my
last encounter with allocate/deallocate code.  I also agree that 
waiting 6+ weeks for approval is a bit long time.  Unfortunately, it
seems evident that we're all too busy with Real Life(tm) at the moment.

PS: Are you going to announce your submodule milestone on c.l.f?

-- 
Steve

Re: [commited, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value

[Andre Vehreschild]

[-- Attachment #1: Type: text/plain, Size: 2581 bytes --]

Hi Steve, hi Paul, hi all,

Steve and Paul, thank you very much for the reviews. Committed with the
requested changes as r225447 and r225448. The last commit adds the Changelog
entry in the testsuite I forgot. Sorry for that.

For the open issue in the testcase I have opened the pr:

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=66775

Regards,
	Andre

On Sun, 5 Jul 2015 19:48:13 +0200
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:

> Dear Andre,
> 
> I agree with Steve's recommendation that you comment out the line and
> open a PR for the problem.
> 
> The patch looks fine to me and applied cleanly, apart from trailing
> CRs in the testcases.
> 
> OK by me too.
> 
> Cheers
> 
> Paul
> 
> PS I felt safe in setting a deadline for the submodule patch because:
> (i) It was obvious that nobody would review it because of its size;
> and (ii) It is safely ring-fenced by the need for very specific
> procedure attributes and declarations. I would not dream of doing the
> same for other patches more integrated in parts of the compiler that
> are frequented by commonly used code. For example, the patch to
> encompass the use of private entities with submodules will be just
> such a patch.... when I figure out how to do it! I can sympathize with
> you though; you have often had to wait an excessively long time for
> reviews.
> 
> 
> On 5 July 2015 at 18:14, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
> > On Sat, Jul 04, 2015 at 09:20:39PM +0200, Andre Vehreschild wrote:
> >>
> >> Thanks for looking at the code. The error you experience is known
> >> to me. The bug is present in gfortran and only exposed by this patch.
> >> Unfortunately is the pr58586 not addressing this specific error. It
> >> may be in the bugtracker under a different number already. Furthermore
> >> did I not want to extend the patch for 58586 any further, because I
> >> have learned that the more complicated a patch gets the longer review
> >> takes. For making the testcase run fine we also simply can comment the
> >> line.
> >>
> >
> > I can appreciate the problem of fixing one bug may expose another,
> > and I agree that holding up a patch for 58586 due to a latent bug
> > seems unreasonable.  I reviewed the email history and it appears
> > that you've addressed Mikael's concerns.  My only comment would
> > be to comment out the problematic statement in alloc_comp_class_4.f03,
> > and open a new bug report to record the issue.  Ok to commit with
> > my suggested change.
> >
> > --
> > Steve
> 
> 
> 


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 11376 bytes --]

Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 225446)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,22 @@
+2015-07-06  Andre Vehreschild  <vehre@gmx.de>
+
+	PR fortran/58586
+	* resolve.c (resolve_symbol): Non-private functions in modules
+	with allocatable or pointer components are marked referenced
+	now. Furthermore is the default init especially for those
+	components now done in gfc_conf_procedure_call preventing
+	duplicate code.
+	* trans-decl.c (gfc_generate_function_code): Generate a fake
+	result decl for	functions returning an object with allocatable
+	components and initialize them.
+	* trans-expr.c (gfc_conv_procedure_call): For value typed trees
+	use the tree without indirect ref. And for non-decl trees
+	add a temporary variable to prevent evaluating the tree
+	multiple times (prevent multiple function evaluations).
+	* trans.h: Made gfc_trans_structure_assign () protoype
+	available, which is now needed by trans-decl.c:gfc_generate_
+	function_code(), too.
+
 2015-07-04  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/66725
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(Revision 225446)
+++ gcc/fortran/trans-decl.c	(Arbeitskopie)
@@ -5885,10 +5885,34 @@
   tmp = gfc_trans_code (ns->code);
   gfc_add_expr_to_block (&body, tmp);
 
-  if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node)
+  if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
+      || (sym->result && sym->result != sym
+	  && sym->result->ts.type == BT_DERIVED
+	  && sym->result->ts.u.derived->attr.alloc_comp))
     {
+      bool artificial_result_decl = false;
       tree result = get_proc_result (sym);
+      gfc_symbol *rsym = sym == sym->result ? sym : sym->result;
 
+      /* Make sure that a function returning an object with
+	 alloc/pointer_components always has a result, where at least
+	 the allocatable/pointer components are set to zero.  */
+      if (result == NULL_TREE && sym->attr.function
+	  && ((sym->result->ts.type == BT_DERIVED
+	       && (sym->attr.allocatable
+		   || sym->attr.pointer
+		   || sym->result->ts.u.derived->attr.alloc_comp
+		   || sym->result->ts.u.derived->attr.pointer_comp))
+	      || (sym->result->ts.type == BT_CLASS
+		  && (CLASS_DATA (sym)->attr.allocatable
+		      || CLASS_DATA (sym)->attr.class_pointer
+		      || CLASS_DATA (sym->result)->attr.alloc_comp
+		      || CLASS_DATA (sym->result)->attr.pointer_comp))))
+	{
+	  artificial_result_decl = true;
+	  result = gfc_get_fake_result_decl (sym, 0);
+	}
+
       if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer)
 	{
 	  if (sym->attr.allocatable && sym->attr.dimension == 0
@@ -5907,16 +5931,30 @@
 							null_pointer_node));
 	    }
 	  else if (sym->ts.type == BT_DERIVED
-		   && sym->ts.u.derived->attr.alloc_comp
 		   && !sym->attr.allocatable)
 	    {
-	      rank = sym->as ? sym->as->rank : 0;
-	      tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
-	      gfc_add_expr_to_block (&init, tmp);
+	      gfc_expr *init_exp;
+	      /* Arrays are not initialized using the default initializer of
+		 their elements.  Therefore only check if a default
+		 initializer is available when the result is scalar.  */
+	      init_exp = rsym->as ? NULL : gfc_default_initializer (&rsym->ts);
+	      if (init_exp)
+		{
+		  tmp = gfc_trans_structure_assign (result, init_exp, 0);
+		  gfc_free_expr (init_exp);
+		  gfc_add_expr_to_block (&init, tmp);
+		}
+	      else if (rsym->ts.u.derived->attr.alloc_comp)
+		{
+		  rank = rsym->as ? rsym->as->rank : 0;
+		  tmp = gfc_nullify_alloc_comp (rsym->ts.u.derived, result,
+						rank);
+		  gfc_prepend_expr_to_block (&body, tmp);
+		}
 	    }
 	}
 
-      if (result == NULL_TREE)
+      if (result == NULL_TREE || artificial_result_decl)
 	{
 	  /* TODO: move to the appropriate place in resolve.c.  */
 	  if (warn_return_type && sym == sym->result)
@@ -5926,7 +5964,7 @@
 	  if (warn_return_type)
 	    TREE_NO_WARNING(sym->backend_decl) = 1;
 	}
-      else
+      if (result != NULL_TREE)
 	gfc_add_expr_to_block (&body, gfc_generate_return ());
     }
 
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 225446)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -14083,10 +14083,15 @@
 
       if ((!a->save && !a->dummy && !a->pointer
 	   && !a->in_common && !a->use_assoc
-	   && (a->referenced || a->result)
-	   && !(a->function && sym != sym->result))
+	   && !a->result && !a->function)
 	  || (a->dummy && a->intent == INTENT_OUT && !a->pointer))
 	apply_default_init (sym);
+      else if (a->function && sym->result && a->access != ACCESS_PRIVATE
+	       && (sym->ts.u.derived->attr.alloc_comp
+		   || sym->ts.u.derived->attr.pointer_comp))
+	/* Mark the result symbol to be referenced, when it has allocatable
+	   components.  */
+	sym->result->attr.referenced = 1;
     }
 
   if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(Revision 225446)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -1465,7 +1465,6 @@
 }
 
 
-static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init);
 static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *,
 						 gfc_expr *);
 
@@ -5340,8 +5339,19 @@
 	    && 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 (!DECL_P (parmse.expr))
+	    parmse.expr = gfc_evaluate_now_loc (input_location,
+						parmse.expr, &se->pre);
+
+	  if (fsym && fsym->attr.value)
+	    tmp = parmse.expr;
+	  else
+	    tmp = build_fold_indirect_ref_loc (input_location,
+					       parmse.expr);
+
 	  parm_rank = e->rank;
 	  switch (parm_kind)
 	    {
@@ -7158,7 +7168,7 @@
 
 /* Assign a derived type constructor to a variable.  */
 
-static tree
+tree
 gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init)
 {
   gfc_constructor *c;
@@ -7471,7 +7481,7 @@
       if (expr->ts.type == BT_CHARACTER
 	  && expr->expr_type != EXPR_FUNCTION)
 	gfc_conv_string_parameter (se);
-      else
+     else
 	se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
 
       return;
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h	(Revision 225446)
+++ gcc/fortran/trans.h	(Arbeitskopie)
@@ -669,6 +669,9 @@
 /* Generate code to call realloc().  */
 tree gfc_call_realloc (stmtblock_t *, tree, tree);
 
+/* Assign a derived type constructor to a variable.  */
+tree gfc_trans_structure_assign (tree, gfc_expr *, bool);
+
 /* Generate code for an assignment, includes scalarization.  */
 tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool);
 
Index: gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
===================================================================
--- gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03	(Revision 0)
+++ gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03	(Revision 225447)
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-options "-Wreturn-type" }
+!
+! 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
+
+  type :: t
+    integer, allocatable :: comp
+  end type
+  type :: u
+    type(t), allocatable :: comp
+  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())
+
+  call sub(u())
+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()  ! { dg-warning "not set" }
+  end function
+
+  subroutine sub(d)
+    type(u), value :: d
+  end subroutine
+end program test_pr58586
+
Index: gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
===================================================================
--- gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03	(Revision 0)
+++ gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03	(Revision 225447)
@@ -0,0 +1,105 @@
+! { dg-do run }
+! { dg-options "-Wreturn-type" }
+!
+! Check that pr58586 is fixed now.
+! Based on a contribution by Vladimir Fuka
+! Contibuted by Andre Vehreschild
+
+module test_pr58586_mod
+  implicit none
+
+  type :: a
+  end type
+
+  type :: c
+     type(a), allocatable :: a
+  end type
+
+  type :: d
+  contains
+     procedure :: init => d_init
+  end type
+
+  type, extends(d) :: e
+  contains
+     procedure :: init => e_init
+  end type
+
+  type :: b
+     integer, allocatable :: a
+  end type
+
+  type t
+    integer :: i = 5
+  end type
+
+contains
+
+  subroutine add (d)
+    type(b), value :: d
+  end subroutine
+
+  subroutine add_c (d)
+    type(c), value :: d
+  end subroutine
+
+  subroutine add_class_c (d)
+    class(c), value :: d
+  end subroutine
+
+  subroutine add_t (d)
+    type(t), value :: d
+  end subroutine
+
+  type(c) function c_init() ! { dg-warning "not set" }
+  end function
+
+  class(c) function c_init2() ! { dg-warning "not set" }
+    allocatable :: c_init2
+  end function
+
+  type(c) function d_init(this) ! { dg-warning "not set" }
+    class(d) :: this
+  end function
+
+  type(c) function e_init(this)
+    class(e) :: this
+    allocate (e_init%a)
+  end function
+
+  type(t) function t_init() ! { dg-warning "not set" }
+    allocatable :: t_init
+  end function
+
+  type(t) function static_t_init() ! { dg-warning "not set" }
+  end function
+end module test_pr58586_mod
+
+program test_pr58586
+  use test_pr58586_mod
+
+  class(d), allocatable :: od
+  class(e), allocatable :: oe
+  type(t), allocatable :: temp
+
+  ! 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())
+  call add_class_c(c_init2())
+
+  call add_t(static_t_init())
+  ! temp = t_init() ! <-- This derefs a null-pointer currently
+  ! Filed as pr66775
+  if (allocated (temp)) call abort()
+
+  allocate(od)
+  call add_c(od%init())
+  deallocate(od)
+  allocate(oe)
+  call add_c(oe%init())
+  deallocate(oe)
+end program
+
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 225446)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,9 @@
+2015-07-06  Andre Vehreschild  <vehre@gmx.de>
+
+	PR fortran/58586
+	* gfortran.dg/alloc_comp_class_3.f03: New test.
+	* gfortran.dg/alloc_comp_class_4.f03: New test.
+
 2015-07-06  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc.c-torture/execute/pr66757.c: New test.