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

[Andre Vehreschild <vehre@gmx.de>]

[-- 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.