[Patch, Fortran, 66035, v1] [5/6 Regression] gfortran ICE segfault

[Patch, Fortran, 66035, v1] [5/6 Regression] gfortran ICE segfault

[Andre Vehreschild]

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

Hi all,

please find attached a patch for 66035. An ICE occurred when in a structure
constructor an allocatable component of type class was initialized with an
existing class object. This was caused by 

- the size of the memory to allocate for the component was miscalculated,
- the vptr was not set correctly, and
- when the class object to be used for init was allocatable already, it was
  copied wasting some memory instead of a view_convert inserted.

All of the above are fixed by the attached patch.

Bootstraps and regtests ok on x86_64-linux-gnu/f21 for trunk and gcc-5-trunk.

Ok for trunk and gcc-5-trunk?

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

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

gcc/fortran/ChangeLog:

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

	PR fortran/66035
	* trans-expr.c (alloc_scalar_allocatable_for_subcomponent_assignment):
	Compute the size to allocate for class and derived type objects
	correclty.
	(gfc_trans_subcomponent_assign): Only allocate memory for the
	component when the object to assign is not a allocatable class
	object. Furthermore use copy_class_to_class for assigning
	the rhs to the component (may happen for dummy class objects on
	the rhs).

gcc/testsuite/ChangeLog:

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

	PR fortran/66035
	* gfortran.dg/structure_constructor_13.f03: New test.



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

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index cf607d0..402d9b9 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6881,6 +6881,30 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block,
 				       TREE_TYPE (tmp), tmp,
 				       fold_convert (TREE_TYPE (tmp), size));
     }
+  else if (cm->ts.type == BT_CLASS)
+    {
+      gcc_assert (expr2->ts.type == BT_CLASS || expr2->ts.type == BT_DERIVED);
+      if (expr2->ts.type == BT_DERIVED)
+	{
+	  tmp = gfc_get_symbol_decl (gfc_find_vtab (&expr2->ts));
+	  tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+	  size = fold_convert (size_type_node, gfc_vptr_size_get (tmp));
+	}
+      else
+	{
+	  gfc_expr *e2vtab;
+	  gfc_se se;
+	  e2vtab = gfc_find_and_cut_at_last_class_ref (expr2);
+	  gfc_add_vptr_component (e2vtab);
+	  gfc_add_size_component (e2vtab);
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr (&se, e2vtab);
+	  gfc_add_block_to_block (block, &se.pre);
+	  size = fold_convert (size_type_node, se.expr);
+	  gfc_free_expr (e2vtab);
+	}
+      size_in_bytes = size;
+    }
   else
     {
       /* Otherwise use the length in bytes of the rhs.  */
@@ -7008,7 +7032,9 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
       gfc_add_expr_to_block (&block, tmp);
     }
   else if (init && (cm->attr.allocatable
-	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable)))
+	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
+	       && (expr->ts.type != BT_CLASS
+		   || CLASS_DATA (expr)->attr.allocatable))))
     {
       /* Take care about non-array allocatable components here.  The alloc_*
 	 routine below is motivated by the alloc_scalar_allocatable_for_
@@ -7052,6 +7078,14 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
 	  tmp = gfc_build_memcpy_call (tmp, se.expr, size);
 	  gfc_add_expr_to_block (&block, tmp);
 	}
+      else if (cm->ts.type == BT_CLASS && expr->ts.type == BT_CLASS)
+	{
+	  tmp = gfc_copy_class_to_class (se.expr, dest, integer_one_node,
+				   CLASS_DATA (cm)->attr.unlimited_polymorphic);
+	  gfc_add_expr_to_block (&block, tmp);
+	  gfc_add_modify (&block, gfc_class_vptr_get (dest),
+			  gfc_class_vptr_get (se.expr));
+	}
       else
 	gfc_add_modify (&block, tmp,
 			fold_convert (TREE_TYPE (tmp), se.expr));
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_13.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_13.f03
new file mode 100644
index 0000000..c74e325
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_13.f03
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Contributed by Melven Roehrig-Zoellner  <Melven.Roehrig-Zoellner@DLR.de>
+! PR fortran/66035
+
+program test_pr66035
+  type t
+  end type t
+  type w
+    class(t), allocatable :: c
+  end type w
+
+  type(t) :: o
+
+  call test(o)
+contains
+  subroutine test(o)
+    class(t), intent(inout) :: o
+    type(w), dimension(:), allocatable :: list
+
+    select type (o)
+      class is (t)
+        list = [w(o)] ! This caused an ICE
+      class default
+        call abort()
+    end select
+  end subroutine
+end program

Re: [Patch, Fortran, 66035, v1] [5/6 Regression] gfortran ICE segfault

[Mikael Morin]

Le 08/05/2015 15:29, Andre Vehreschild a écrit :
> Hi all,
> 
> please find attached a patch for 66035. An ICE occurred when in a structure
> constructor an allocatable component of type class was initialized with an
> existing class object. This was caused by 
> 
> - the size of the memory to allocate for the component was miscalculated,
> - the vptr was not set correctly, and
> - when the class object to be used for init was allocatable already, it was
>   copied wasting some memory instead of a view_convert inserted.
> 
> All of the above are fixed by the attached patch.
> 
> Bootstraps and regtests ok on x86_64-linux-gnu/f21 for trunk and gcc-5-trunk.
> 
> Ok for trunk and gcc-5-trunk?
> 
> Regards,
> 	Andre
> 
> 
> pr66035_1.patch
> 
> diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
> index cf607d0..402d9b9 100644
> --- a/gcc/fortran/trans-expr.c
> +++ b/gcc/fortran/trans-expr.c
> @@ -6881,6 +6881,30 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block,
>  				       TREE_TYPE (tmp), tmp,
>  				       fold_convert (TREE_TYPE (tmp), size));
>      }
> +  else if (cm->ts.type == BT_CLASS)
> +    {
> +      gcc_assert (expr2->ts.type == BT_CLASS || expr2->ts.type == BT_DERIVED);
> +      if (expr2->ts.type == BT_DERIVED)
> +	{
> +	  tmp = gfc_get_symbol_decl (gfc_find_vtab (&expr2->ts));
> +	  tmp = gfc_build_addr_expr (NULL_TREE, tmp);
> +	  size = fold_convert (size_type_node, gfc_vptr_size_get (tmp));
> +	}
Use TYPE_SIZE_UNIT of the rhs in this case, in the same way as in the
else branch further below.

> +      else
> +	{
> +	  gfc_expr *e2vtab;
> +	  gfc_se se;
> +	  e2vtab = gfc_find_and_cut_at_last_class_ref (expr2);
> +	  gfc_add_vptr_component (e2vtab);
> +	  gfc_add_size_component (e2vtab);
> +	  gfc_init_se (&se, NULL);
> +	  gfc_conv_expr (&se, e2vtab);
> +	  gfc_add_block_to_block (block, &se.pre);
> +	  size = fold_convert (size_type_node, se.expr);
> +	  gfc_free_expr (e2vtab);
> +	}
> +      size_in_bytes = size;
> +    }
>    else
>      {
>        /* Otherwise use the length in bytes of the rhs.  */
> @@ -7008,7 +7032,9 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
>        gfc_add_expr_to_block (&block, tmp);
>      }
>    else if (init && (cm->attr.allocatable
> -	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable)))
> +	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
> +	       && (expr->ts.type != BT_CLASS
> +		   || CLASS_DATA (expr)->attr.allocatable))))
maybe:             || !CLASS_DATA (expr)->attr.allocatable
(with a '!')?

Mikael

Re: [Patch, Fortran, 66035, v1] [5/6 Regression] gfortran ICE segfault

[Andre Vehreschild]

Hi Mikael,

> > diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
> > index cf607d0..402d9b9 100644
> > --- a/gcc/fortran/trans-expr.c
> > +++ b/gcc/fortran/trans-expr.c
> > @@ -6881,6 +6881,30 @@ alloc_scalar_allocatable_for_subcomponent_assignment
> > (stmtblock_t *block, TREE_TYPE (tmp), tmp,
> >  				       fold_convert (TREE_TYPE (tmp),
> > size)); }
> > +  else if (cm->ts.type == BT_CLASS)
> > +    {
> > +      gcc_assert (expr2->ts.type == BT_CLASS || expr2->ts.type ==
> > BT_DERIVED);
> > +      if (expr2->ts.type == BT_DERIVED)
> > +	{
> > +	  tmp = gfc_get_symbol_decl (gfc_find_vtab (&expr2->ts));
> > +	  tmp = gfc_build_addr_expr (NULL_TREE, tmp);
> > +	  size = fold_convert (size_type_node, gfc_vptr_size_get (tmp));
> > +	}
> Use TYPE_SIZE_UNIT of the rhs in this case, in the same way as in the
> else branch further below.

Er, but when I get TYPE_SIZE_UNIT () correctly, then it will grab the size
needed to store the %_vptr%size component. Do you really intent that? I need to
alloc the size of the polymorphic type of expr2 here.

<snipp>

> > @@ -7008,7 +7032,9 @@ gfc_trans_subcomponent_assign (tree dest,
> > gfc_component * cm, gfc_expr * expr, gfc_add_expr_to_block (&block, tmp);
> >      }
> >    else if (init && (cm->attr.allocatable
> > -	   || (cm->ts.type == BT_CLASS && CLASS_DATA
> > (cm)->attr.allocatable)))
> > +	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
> > +	       && (expr->ts.type != BT_CLASS
> > +		   || CLASS_DATA (expr)->attr.allocatable))))
> maybe:             || !CLASS_DATA (expr)->attr.allocatable
> (with a '!')?

No, I only want to copy the rhs to new memory, when it is allocatable. For all
other cases, one should not do this, to prevent a memory leak. Furthermore, is
the data copied to freshly allocated memory anyway. Have a look at the pseudo
code generated for the testcase in the patch.

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

Re: [Patch, Fortran, 66035, v2] [5/6 Regression] gfortran ICE segfault

[Andre Vehreschild]

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

Hi all,

please find attached the next version of the patch for pr66035 fixing an ICE.
Scope (copied from first submit):

An ICE occurred when in a structure constructor an allocatable component of
type class was initialized with an existing class object. This was caused by 

- the size of the memory to allocate for the component was miscalculated,
- the vptr was not set correctly, and
- when the class object to be used for init was allocatable already, it was
  copied wasting some memory instead of a view_convert inserted.

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

Ok for trunk?

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

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

gcc/fortran/ChangeLog:

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

	PR fortran/66035
	* trans-expr.c (alloc_scalar_allocatable_for_subcomponent_assignment):
	Compute the size to allocate for class and derived type objects
	correclty.
	(gfc_trans_subcomponent_assign): Only allocate memory for a
	component when the object to assign is not an allocatable class
	object (the memory is already present for allocatable class objects).
	Furthermore use copy_class_to_class for assigning the rhs to the
	component (may happen for dummy class objects on the rhs).


gcc/testsuite/ChangeLog:

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

	PR fortran/66035
	* gfortran.dg/structure_constructor_13.f03: New test.



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

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 195f7a4..74af725 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6903,6 +6903,29 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block,
 				       TREE_TYPE (tmp), tmp,
 				       fold_convert (TREE_TYPE (tmp), size));
     }
+  else if (cm->ts.type == BT_CLASS)
+    {
+      gcc_assert (expr2->ts.type == BT_CLASS || expr2->ts.type == BT_DERIVED);
+      if (expr2->ts.type == BT_DERIVED)
+	{
+	  tmp = gfc_get_symbol_decl (expr2->ts.u.derived);
+	  size = TYPE_SIZE_UNIT (tmp);
+	}
+      else
+	{
+	  gfc_expr *e2vtab;
+	  gfc_se se;
+	  e2vtab = gfc_find_and_cut_at_last_class_ref (expr2);
+	  gfc_add_vptr_component (e2vtab);
+	  gfc_add_size_component (e2vtab);
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr (&se, e2vtab);
+	  gfc_add_block_to_block (block, &se.pre);
+	  size = fold_convert (size_type_node, se.expr);
+	  gfc_free_expr (e2vtab);
+	}
+      size_in_bytes = size;
+    }
   else
     {
       /* Otherwise use the length in bytes of the rhs.  */
@@ -7030,7 +7053,8 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
       gfc_add_expr_to_block (&block, tmp);
     }
   else if (init && (cm->attr.allocatable
-	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable)))
+	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
+	       && expr->ts.type != BT_CLASS)))
     {
       /* Take care about non-array allocatable components here.  The alloc_*
 	 routine below is motivated by the alloc_scalar_allocatable_for_
@@ -7074,6 +7098,14 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
 	  tmp = gfc_build_memcpy_call (tmp, se.expr, size);
 	  gfc_add_expr_to_block (&block, tmp);
 	}
+      else if (cm->ts.type == BT_CLASS && expr->ts.type == BT_CLASS)
+	{
+	  tmp = gfc_copy_class_to_class (se.expr, dest, integer_one_node,
+				   CLASS_DATA (cm)->attr.unlimited_polymorphic);
+	  gfc_add_expr_to_block (&block, tmp);
+	  gfc_add_modify (&block, gfc_class_vptr_get (dest),
+			  gfc_class_vptr_get (se.expr));
+	}
       else
 	gfc_add_modify (&block, tmp,
 			fold_convert (TREE_TYPE (tmp), se.expr));
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_13.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_13.f03
new file mode 100644
index 0000000..c74e325
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_13.f03
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Contributed by Melven Roehrig-Zoellner  <Melven.Roehrig-Zoellner@DLR.de>
+! PR fortran/66035
+
+program test_pr66035
+  type t
+  end type t
+  type w
+    class(t), allocatable :: c
+  end type w
+
+  type(t) :: o
+
+  call test(o)
+contains
+  subroutine test(o)
+    class(t), intent(inout) :: o
+    type(w), dimension(:), allocatable :: list
+
+    select type (o)
+      class is (t)
+        list = [w(o)] ! This caused an ICE
+      class default
+        call abort()
+    end select
+  end subroutine
+end program

Re: [Patch, Fortran, 66035, v2] [5/6 Regression] gfortran ICE segfault

[Mikael Morin]

hello Andre.

Le 06/07/2015 13:54, Andre Vehreschild a écrit :
> Hi all,
> 
> please find attached the next version of the patch for pr66035 fixing an ICE.
> Scope (copied from first submit):
> 
> An ICE occurred when in a structure constructor an allocatable component of
> type class was initialized with an existing class object. This was caused by 
> 
> - the size of the memory to allocate for the component was miscalculated,
> - the vptr was not set correctly, and
> - when the class object to be used for init was allocatable already, it was
>   copied wasting some memory instead of a view_convert inserted.
> 
> Bootstraps and regtests fine on x86_64-linux-gnu/f21.
> 
> Ok for trunk?
> 
> Regards,
> 	Andre
> 
> 
> pr66035_2.patch
> 
> diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
> index 195f7a4..74af725 100644
> --- a/gcc/fortran/trans-expr.c
> +++ b/gcc/fortran/trans-expr.c
> @@ -6903,6 +6903,29 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block,
>  				       TREE_TYPE (tmp), tmp,
>  				       fold_convert (TREE_TYPE (tmp), size));
>      }
> +  else if (cm->ts.type == BT_CLASS)
> +    {
> +      gcc_assert (expr2->ts.type == BT_CLASS || expr2->ts.type == BT_DERIVED);
> +      if (expr2->ts.type == BT_DERIVED)
> +	{
> +	  tmp = gfc_get_symbol_decl (expr2->ts.u.derived);
> +	  size = TYPE_SIZE_UNIT (tmp);
> +	}
> +      else
> +	{
> +	  gfc_expr *e2vtab;
> +	  gfc_se se;
> +	  e2vtab = gfc_find_and_cut_at_last_class_ref (expr2);
> +	  gfc_add_vptr_component (e2vtab);
> +	  gfc_add_size_component (e2vtab);
> +	  gfc_init_se (&se, NULL);
> +	  gfc_conv_expr (&se, e2vtab);
> +	  gfc_add_block_to_block (block, &se.pre);
> +	  size = fold_convert (size_type_node, se.expr);
> +	  gfc_free_expr (e2vtab);
> +	}
> +      size_in_bytes = size;
> +    }
>    else
>      {
>        /* Otherwise use the length in bytes of the rhs.  */
That part is OK.

> @@ -7030,7 +7053,8 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
>        gfc_add_expr_to_block (&block, tmp);
>      }
>    else if (init && (cm->attr.allocatable
> -	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable)))
> +	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
> +	       && expr->ts.type != BT_CLASS)))
>      {
>        /* Take care about non-array allocatable components here.  The alloc_*
>  	 routine below is motivated by the alloc_scalar_allocatable_for_
> @@ -7074,6 +7098,14 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
>  	  tmp = gfc_build_memcpy_call (tmp, se.expr, size);
>  	  gfc_add_expr_to_block (&block, tmp);
>  	}
> +      else if (cm->ts.type == BT_CLASS && expr->ts.type == BT_CLASS)
> +	{
> +	  tmp = gfc_copy_class_to_class (se.expr, dest, integer_one_node,
> +				   CLASS_DATA (cm)->attr.unlimited_polymorphic);
> +	  gfc_add_expr_to_block (&block, tmp);
> +	  gfc_add_modify (&block, gfc_class_vptr_get (dest),
> +			  gfc_class_vptr_get (se.expr));
> +	}
>        else
>  	gfc_add_modify (&block, tmp,
>  			fold_convert (TREE_TYPE (tmp), se.expr));
But this hunk is canceled by the one before, isn't it?
I mean, If the condition here is true, the condition before was false?

Mikael

Re: [Patch, Fortran, 66035, v2] [5/6 Regression] gfortran ICE segfault

[Andre Vehreschild]

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

Hi Mikael,

> > @@ -7030,7 +7053,8 @@ gfc_trans_subcomponent_assign (tree dest,
> > gfc_component * cm, gfc_expr * expr, gfc_add_expr_to_block (&block, tmp);
> >      }
> >    else if (init && (cm->attr.allocatable
> > -	   || (cm->ts.type == BT_CLASS && CLASS_DATA
> > (cm)->attr.allocatable)))
> > +	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
> > +	       && expr->ts.type != BT_CLASS)))
> >      {
> >        /* Take care about non-array allocatable components here.  The
> > alloc_* routine below is motivated by the alloc_scalar_allocatable_for_
> > @@ -7074,6 +7098,14 @@ gfc_trans_subcomponent_assign (tree dest,
> > gfc_component * cm, gfc_expr * expr, tmp = gfc_build_memcpy_call (tmp,
> > se.expr, size); gfc_add_expr_to_block (&block, tmp);
> >  	}
> > +      else if (cm->ts.type == BT_CLASS && expr->ts.type == BT_CLASS)
> > +	{
> > +	  tmp = gfc_copy_class_to_class (se.expr, dest, integer_one_node,
> > +				   CLASS_DATA
> > (cm)->attr.unlimited_polymorphic);
> > +	  gfc_add_expr_to_block (&block, tmp);
> > +	  gfc_add_modify (&block, gfc_class_vptr_get (dest),
> > +			  gfc_class_vptr_get (se.expr));
> > +	}
> >        else
> >  	gfc_add_modify (&block, tmp,
> >  			fold_convert (TREE_TYPE (tmp), se.expr));
> But this hunk is canceled by the one before, isn't it?
> I mean, If the condition here is true, the condition before was false?

You are absolutely right. The second hunk is dead code and removed in the
attached patch. That must have been the first attempt to address the issue and
later on I did not perceive that it was useless. Sorry for that.

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

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

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index adc5c0a..bab1cce 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6902,6 +6902,29 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block,
 				       TREE_TYPE (tmp), tmp,
 				       fold_convert (TREE_TYPE (tmp), size));
     }
+  else if (cm->ts.type == BT_CLASS)
+    {
+      gcc_assert (expr2->ts.type == BT_CLASS || expr2->ts.type == BT_DERIVED);
+      if (expr2->ts.type == BT_DERIVED)
+	{
+	  tmp = gfc_get_symbol_decl (expr2->ts.u.derived);
+	  size = TYPE_SIZE_UNIT (tmp);
+	}
+      else
+	{
+	  gfc_expr *e2vtab;
+	  gfc_se se;
+	  e2vtab = gfc_find_and_cut_at_last_class_ref (expr2);
+	  gfc_add_vptr_component (e2vtab);
+	  gfc_add_size_component (e2vtab);
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr (&se, e2vtab);
+	  gfc_add_block_to_block (block, &se.pre);
+	  size = fold_convert (size_type_node, se.expr);
+	  gfc_free_expr (e2vtab);
+	}
+      size_in_bytes = size;
+    }
   else
     {
       /* Otherwise use the length in bytes of the rhs.  */
@@ -7029,7 +7052,8 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
       gfc_add_expr_to_block (&block, tmp);
     }
   else if (init && (cm->attr.allocatable
-	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable)))
+	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
+	       && expr->ts.type != BT_CLASS)))
     {
       /* Take care about non-array allocatable components here.  The alloc_*
 	 routine below is motivated by the alloc_scalar_allocatable_for_
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_13.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_13.f03
new file mode 100644
index 0000000..c74e325
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_13.f03
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Contributed by Melven Roehrig-Zoellner  <Melven.Roehrig-Zoellner@DLR.de>
+! PR fortran/66035
+
+program test_pr66035
+  type t
+  end type t
+  type w
+    class(t), allocatable :: c
+  end type w
+
+  type(t) :: o
+
+  call test(o)
+contains
+  subroutine test(o)
+    class(t), intent(inout) :: o
+    type(w), dimension(:), allocatable :: list
+
+    select type (o)
+      class is (t)
+        list = [w(o)] ! This caused an ICE
+      class default
+        call abort()
+    end select
+  end subroutine
+end program

Re: [Patch, Fortran, 66035, v2] [5/6 Regression] gfortran ICE segfault

[Paul Richard Thomas]

Dear Andre,

I am still in the bizarre situation that the testcase compiles and
runs correctly on a clean trunk!

That said, the patch applies cleanly and, at very least from my point
of view, does not do any harm :-)

OK for trunk

Thanks for the patch

Paul

On 11 July 2015 at 14:08, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi Mikael,
>
>> > @@ -7030,7 +7053,8 @@ gfc_trans_subcomponent_assign (tree dest,
>> > gfc_component * cm, gfc_expr * expr, gfc_add_expr_to_block (&block, tmp);
>> >      }
>> >    else if (init && (cm->attr.allocatable
>> > -      || (cm->ts.type == BT_CLASS && CLASS_DATA
>> > (cm)->attr.allocatable)))
>> > +      || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
>> > +          && expr->ts.type != BT_CLASS)))
>> >      {
>> >        /* Take care about non-array allocatable components here.  The
>> > alloc_* routine below is motivated by the alloc_scalar_allocatable_for_
>> > @@ -7074,6 +7098,14 @@ gfc_trans_subcomponent_assign (tree dest,
>> > gfc_component * cm, gfc_expr * expr, tmp = gfc_build_memcpy_call (tmp,
>> > se.expr, size); gfc_add_expr_to_block (&block, tmp);
>> >     }
>> > +      else if (cm->ts.type == BT_CLASS && expr->ts.type == BT_CLASS)
>> > +   {
>> > +     tmp = gfc_copy_class_to_class (se.expr, dest, integer_one_node,
>> > +                              CLASS_DATA
>> > (cm)->attr.unlimited_polymorphic);
>> > +     gfc_add_expr_to_block (&block, tmp);
>> > +     gfc_add_modify (&block, gfc_class_vptr_get (dest),
>> > +                     gfc_class_vptr_get (se.expr));
>> > +   }
>> >        else
>> >     gfc_add_modify (&block, tmp,
>> >                     fold_convert (TREE_TYPE (tmp), se.expr));
>> But this hunk is canceled by the one before, isn't it?
>> I mean, If the condition here is true, the condition before was false?
>
> You are absolutely right. The second hunk is dead code and removed in the
> attached patch. That must have been the first attempt to address the issue and
> later on I did not perceive that it was useless. Sorry for that.
>
> Regards,
>         Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de



-- 
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: [Patch, Fortran, 66035, v2] [5/6 Regression] gfortran ICE segfault

[Andre Vehreschild]

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

Hi Paul, 

thanks for the review, commited as r225928.

Regards,
	Andre

On Wed, 15 Jul 2015 13:40:29 +0200
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:

> Dear Andre,
> 
> I am still in the bizarre situation that the testcase compiles and
> runs correctly on a clean trunk!
> 
> That said, the patch applies cleanly and, at very least from my point
> of view, does not do any harm :-)
> 
> OK for trunk
> 
> Thanks for the patch
> 
> Paul
> 
> On 11 July 2015 at 14:08, Andre Vehreschild <vehre@gmx.de> wrote:
> > Hi Mikael,
> >
> >> > @@ -7030,7 +7053,8 @@ gfc_trans_subcomponent_assign (tree dest,
> >> > gfc_component * cm, gfc_expr * expr, gfc_add_expr_to_block (&block, tmp);
> >> >      }
> >> >    else if (init && (cm->attr.allocatable
> >> > -      || (cm->ts.type == BT_CLASS && CLASS_DATA
> >> > (cm)->attr.allocatable)))
> >> > +      || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
> >> > +          && expr->ts.type != BT_CLASS)))
> >> >      {
> >> >        /* Take care about non-array allocatable components here.  The
> >> > alloc_* routine below is motivated by the alloc_scalar_allocatable_for_
> >> > @@ -7074,6 +7098,14 @@ gfc_trans_subcomponent_assign (tree dest,
> >> > gfc_component * cm, gfc_expr * expr, tmp = gfc_build_memcpy_call (tmp,
> >> > se.expr, size); gfc_add_expr_to_block (&block, tmp);
> >> >     }
> >> > +      else if (cm->ts.type == BT_CLASS && expr->ts.type == BT_CLASS)
> >> > +   {
> >> > +     tmp = gfc_copy_class_to_class (se.expr, dest, integer_one_node,
> >> > +                              CLASS_DATA
> >> > (cm)->attr.unlimited_polymorphic);
> >> > +     gfc_add_expr_to_block (&block, tmp);
> >> > +     gfc_add_modify (&block, gfc_class_vptr_get (dest),
> >> > +                     gfc_class_vptr_get (se.expr));
> >> > +   }
> >> >        else
> >> >     gfc_add_modify (&block, tmp,
> >> >                     fold_convert (TREE_TYPE (tmp), se.expr));
> >> But this hunk is canceled by the one before, isn't it?
> >> I mean, If the condition here is true, the condition before was false?
> >
> > You are absolutely right. The second hunk is dead code and removed in the
> > attached patch. That must have been the first attempt to address the issue
> > and later on I did not perceive that it was useless. Sorry for that.
> >
> > Regards,
> >         Andre
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
> 
> 
> 


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

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

Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 225927)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,15 @@
+2015-07-17  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	PR fortran/66035
+	* trans-expr.c (alloc_scalar_allocatable_for_subcomponent_assignment):
+	Compute the size to allocate for class and derived type objects
+	correclty.
+	(gfc_trans_subcomponent_assign): Only allocate memory for a
+	component when the object to assign is not an allocatable class
+	object (the memory is already present for allocatable class objects).
+	Furthermore use copy_class_to_class for assigning the rhs to the
+	component (may happen for dummy class objects on the rhs).
+
 2015-07-17  Mikael Morin  <mikael@gcc.gnu.org>
 	    Dominique d'Humieres  <dominiq@lps.ens.fr>
 
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(Revision 225927)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -6969,6 +6969,29 @@
 				       TREE_TYPE (tmp), tmp,
 				       fold_convert (TREE_TYPE (tmp), size));
     }
+  else if (cm->ts.type == BT_CLASS)
+    {
+      gcc_assert (expr2->ts.type == BT_CLASS || expr2->ts.type == BT_DERIVED);
+      if (expr2->ts.type == BT_DERIVED)
+	{
+	  tmp = gfc_get_symbol_decl (expr2->ts.u.derived);
+	  size = TYPE_SIZE_UNIT (tmp);
+	}
+      else
+	{
+	  gfc_expr *e2vtab;
+	  gfc_se se;
+	  e2vtab = gfc_find_and_cut_at_last_class_ref (expr2);
+	  gfc_add_vptr_component (e2vtab);
+	  gfc_add_size_component (e2vtab);
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr (&se, e2vtab);
+	  gfc_add_block_to_block (block, &se.pre);
+	  size = fold_convert (size_type_node, se.expr);
+	  gfc_free_expr (e2vtab);
+	}
+      size_in_bytes = size;
+    }
   else
     {
       /* Otherwise use the length in bytes of the rhs.  */
@@ -7096,7 +7119,8 @@
       gfc_add_expr_to_block (&block, tmp);
     }
   else if (init && (cm->attr.allocatable
-	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable)))
+	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
+	       && expr->ts.type != BT_CLASS)))
     {
       /* Take care about non-array allocatable components here.  The alloc_*
 	 routine below is motivated by the alloc_scalar_allocatable_for_
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 225927)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,8 @@
+2015-07-17  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	PR fortran/66035
+	* gfortran.dg/structure_constructor_13.f03: New test.
+
 2015-07-17  Mikael Morin  <mikael@gcc.gnu.org>
 
 	PR fortran/61831
Index: gcc/testsuite/gfortran.dg/structure_constructor_13.f03
===================================================================
--- gcc/testsuite/gfortran.dg/structure_constructor_13.f03	(Revision 0)
+++ gcc/testsuite/gfortran.dg/structure_constructor_13.f03	(Arbeitskopie)
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Contributed by Melven Roehrig-Zoellner  <Melven.Roehrig-Zoellner@DLR.de>
+! PR fortran/66035
+
+program test_pr66035
+  type t
+  end type t
+  type w
+    class(t), allocatable :: c
+  end type w
+
+  type(t) :: o
+
+  call test(o)
+contains
+  subroutine test(o)
+    class(t), intent(inout) :: o
+    type(w), dimension(:), allocatable :: list
+
+    select type (o)
+      class is (t)
+        list = [w(o)] ! This caused an ICE
+      class default
+        call abort()
+    end select
+  end subroutine
+end program

Re: [Patch, Fortran-5, 66035, v2] [5/6 Regression] gfortran ICE segfault

[Andre Vehreschild]

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

Hi all,

as this is a 5/6 regression and the patch now lived for some time in the 6
branch without any complaints, I like to propose the same patch for the
5-branch. 

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

Ok for trunk-5 (aka gcc-5-branch)?

Regards,
	Andre

On Fri, 17 Jul 2015 12:17:07 +0200
Andre Vehreschild <vehre@gmx.de> wrote:

> Hi Paul, 
> 
> thanks for the review, commited as r225928.
> 
> Regards,
> 	Andre
> 
> On Wed, 15 Jul 2015 13:40:29 +0200
> Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:
> 
> > Dear Andre,
> > 
> > I am still in the bizarre situation that the testcase compiles and
> > runs correctly on a clean trunk!
> > 
> > That said, the patch applies cleanly and, at very least from my point
> > of view, does not do any harm :-)
> > 
> > OK for trunk
> > 
> > Thanks for the patch
> > 
> > Paul
> > 
> > On 11 July 2015 at 14:08, Andre Vehreschild <vehre@gmx.de> wrote:
> > > Hi Mikael,
> > >
> > >> > @@ -7030,7 +7053,8 @@ gfc_trans_subcomponent_assign (tree dest,
> > >> > gfc_component * cm, gfc_expr * expr, gfc_add_expr_to_block (&block,
> > >> > tmp); }
> > >> >    else if (init && (cm->attr.allocatable
> > >> > -      || (cm->ts.type == BT_CLASS && CLASS_DATA
> > >> > (cm)->attr.allocatable)))
> > >> > +      || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
> > >> > +          && expr->ts.type != BT_CLASS)))
> > >> >      {
> > >> >        /* Take care about non-array allocatable components here.  The
> > >> > alloc_* routine below is motivated by the alloc_scalar_allocatable_for_
> > >> > @@ -7074,6 +7098,14 @@ gfc_trans_subcomponent_assign (tree dest,
> > >> > gfc_component * cm, gfc_expr * expr, tmp = gfc_build_memcpy_call (tmp,
> > >> > se.expr, size); gfc_add_expr_to_block (&block, tmp);
> > >> >     }
> > >> > +      else if (cm->ts.type == BT_CLASS && expr->ts.type == BT_CLASS)
> > >> > +   {
> > >> > +     tmp = gfc_copy_class_to_class (se.expr, dest, integer_one_node,
> > >> > +                              CLASS_DATA
> > >> > (cm)->attr.unlimited_polymorphic);
> > >> > +     gfc_add_expr_to_block (&block, tmp);
> > >> > +     gfc_add_modify (&block, gfc_class_vptr_get (dest),
> > >> > +                     gfc_class_vptr_get (se.expr));
> > >> > +   }
> > >> >        else
> > >> >     gfc_add_modify (&block, tmp,
> > >> >                     fold_convert (TREE_TYPE (tmp), se.expr));
> > >> But this hunk is canceled by the one before, isn't it?
> > >> I mean, If the condition here is true, the condition before was false?
> > >
> > > You are absolutely right. The second hunk is dead code and removed in the
> > > attached patch. That must have been the first attempt to address the issue
> > > and later on I did not perceive that it was useless. Sorry for that.
> > >
> > > Regards,
> > >         Andre
> > > --
> > > Andre Vehreschild * Email: vehre ad gmx dot de
> > 
> > 
> > 
> 
> 


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

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

gcc/fortran/ChangeLog:

2015-07-21  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/66035
	* trans-expr.c (alloc_scalar_allocatable_for_subcomponent_assignment):
	Compute the size to allocate for class and derived type objects
	correclty.
	(gfc_trans_subcomponent_assign): Only allocate memory for a
	component when the object to assign is not an allocatable class
	object (the memory is already present for allocatable class objects).
	Furthermore use copy_class_to_class for assigning the rhs to the
	component (may happen for dummy class objects on the rhs).


gcc/testsuite/ChangeLog:

2015-07-21  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/66035
	* gfortran.dg/structure_constructor_13.f03: New test.



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

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 88f1af8..e7f9caa 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6732,6 +6732,29 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block,
 				       TREE_TYPE (tmp), tmp,
 				       fold_convert (TREE_TYPE (tmp), size));
     }
+  else if (cm->ts.type == BT_CLASS)
+    {
+      gcc_assert (expr2->ts.type == BT_CLASS || expr2->ts.type == BT_DERIVED);
+      if (expr2->ts.type == BT_DERIVED)
+	{
+	  tmp = gfc_get_symbol_decl (expr2->ts.u.derived);
+	  size = TYPE_SIZE_UNIT (tmp);
+	}
+      else
+	{
+	  gfc_expr *e2vtab;
+	  gfc_se se;
+	  e2vtab = gfc_find_and_cut_at_last_class_ref (expr2);
+	  gfc_add_vptr_component (e2vtab);
+	  gfc_add_size_component (e2vtab);
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr (&se, e2vtab);
+	  gfc_add_block_to_block (block, &se.pre);
+	  size = fold_convert (size_type_node, se.expr);
+	  gfc_free_expr (e2vtab);
+	}
+      size_in_bytes = size;
+    }
   else
     {
       /* Otherwise use the length in bytes of the rhs.  */
@@ -6859,7 +6882,8 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
       gfc_add_expr_to_block (&block, tmp);
     }
   else if (init && (cm->attr.allocatable
-	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable)))
+	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
+	       && expr->ts.type != BT_CLASS)))
     {
       /* Take care about non-array allocatable components here.  The alloc_*
 	 routine below is motivated by the alloc_scalar_allocatable_for_
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_13.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_13.f03
new file mode 100644
index 0000000..c74e325
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_13.f03
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Contributed by Melven Roehrig-Zoellner  <Melven.Roehrig-Zoellner@DLR.de>
+! PR fortran/66035
+
+program test_pr66035
+  type t
+  end type t
+  type w
+    class(t), allocatable :: c
+  end type w
+
+  type(t) :: o
+
+  call test(o)
+contains
+  subroutine test(o)
+    class(t), intent(inout) :: o
+    type(w), dimension(:), allocatable :: list
+
+    select type (o)
+      class is (t)
+        list = [w(o)] ! This caused an ICE
+      class default
+        call abort()
+    end select
+  end subroutine
+end program

Re: [Patch, Fortran-5, 66035, v2] [5/6 Regression] gfortran ICE segfault

[Paul Richard Thomas]

Good plan, Andre - OK for gcc-5.x

Thanks

Paul

On 21 July 2015 at 10:05, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi all,
>
> as this is a 5/6 regression and the patch now lived for some time in the 6
> branch without any complaints, I like to propose the same patch for the
> 5-branch.
>
> Bootstraps and regtests fine on x86_64-linux-gnu/f21.
>
> Ok for trunk-5 (aka gcc-5-branch)?
>
> Regards,
>         Andre
>
> On Fri, 17 Jul 2015 12:17:07 +0200
> Andre Vehreschild <vehre@gmx.de> wrote:
>
>> Hi Paul,
>>
>> thanks for the review, commited as r225928.
>>
>> Regards,
>>       Andre
>>
>> On Wed, 15 Jul 2015 13:40:29 +0200
>> Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:
>>
>> > Dear Andre,
>> >
>> > I am still in the bizarre situation that the testcase compiles and
>> > runs correctly on a clean trunk!
>> >
>> > That said, the patch applies cleanly and, at very least from my point
>> > of view, does not do any harm :-)
>> >
>> > OK for trunk
>> >
>> > Thanks for the patch
>> >
>> > Paul
>> >
>> > On 11 July 2015 at 14:08, Andre Vehreschild <vehre@gmx.de> wrote:
>> > > Hi Mikael,
>> > >
>> > >> > @@ -7030,7 +7053,8 @@ gfc_trans_subcomponent_assign (tree dest,
>> > >> > gfc_component * cm, gfc_expr * expr, gfc_add_expr_to_block (&block,
>> > >> > tmp); }
>> > >> >    else if (init && (cm->attr.allocatable
>> > >> > -      || (cm->ts.type == BT_CLASS && CLASS_DATA
>> > >> > (cm)->attr.allocatable)))
>> > >> > +      || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
>> > >> > +          && expr->ts.type != BT_CLASS)))
>> > >> >      {
>> > >> >        /* Take care about non-array allocatable components here.  The
>> > >> > alloc_* routine below is motivated by the alloc_scalar_allocatable_for_
>> > >> > @@ -7074,6 +7098,14 @@ gfc_trans_subcomponent_assign (tree dest,
>> > >> > gfc_component * cm, gfc_expr * expr, tmp = gfc_build_memcpy_call (tmp,
>> > >> > se.expr, size); gfc_add_expr_to_block (&block, tmp);
>> > >> >     }
>> > >> > +      else if (cm->ts.type == BT_CLASS && expr->ts.type == BT_CLASS)
>> > >> > +   {
>> > >> > +     tmp = gfc_copy_class_to_class (se.expr, dest, integer_one_node,
>> > >> > +                              CLASS_DATA
>> > >> > (cm)->attr.unlimited_polymorphic);
>> > >> > +     gfc_add_expr_to_block (&block, tmp);
>> > >> > +     gfc_add_modify (&block, gfc_class_vptr_get (dest),
>> > >> > +                     gfc_class_vptr_get (se.expr));
>> > >> > +   }
>> > >> >        else
>> > >> >     gfc_add_modify (&block, tmp,
>> > >> >                     fold_convert (TREE_TYPE (tmp), se.expr));
>> > >> But this hunk is canceled by the one before, isn't it?
>> > >> I mean, If the condition here is true, the condition before was false?
>> > >
>> > > You are absolutely right. The second hunk is dead code and removed in the
>> > > attached patch. That must have been the first attempt to address the issue
>> > > and later on I did not perceive that it was useless. Sorry for that.
>> > >
>> > > Regards,
>> > >         Andre
>> > > --
>> > > Andre Vehreschild * Email: vehre ad gmx dot de
>> >
>> >
>> >
>>
>>
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de



-- 
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: [Patch, Fortran-5, 66035, v2] [5/6 Regression] gfortran ICE segfault

[Andre Vehreschild]

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

Hi Paul, hi all,

thanks for the quick response. Commited as r226037.

Regards,
	Andre

On Tue, 21 Jul 2015 11:09:29 +0200
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:

> Good plan, Andre - OK for gcc-5.x
> 
> Thanks
> 
> Paul
> 
-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

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

Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 226036)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,15 @@
+2015-07-21  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	PR fortran/66035
+	* trans-expr.c (alloc_scalar_allocatable_for_subcomponent_assignment):
+	Compute the size to allocate for class and derived type objects
+	correclty.
+	(gfc_trans_subcomponent_assign): Only allocate memory for a
+	component when the object to assign is not an allocatable class
+	object (the memory is already present for allocatable class objects).
+	Furthermore use copy_class_to_class for assigning the rhs to the
+	component (may happen for dummy class objects on the rhs).
+
 2015-07-17  Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>
 
 	* trans-intrinsic.c (conv_co_collective): Remove redundant address
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(Revision 226036)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -6732,6 +6732,29 @@
 				       TREE_TYPE (tmp), tmp,
 				       fold_convert (TREE_TYPE (tmp), size));
     }
+  else if (cm->ts.type == BT_CLASS)
+    {
+      gcc_assert (expr2->ts.type == BT_CLASS || expr2->ts.type == BT_DERIVED);
+      if (expr2->ts.type == BT_DERIVED)
+	{
+	  tmp = gfc_get_symbol_decl (expr2->ts.u.derived);
+	  size = TYPE_SIZE_UNIT (tmp);
+	}
+      else
+	{
+	  gfc_expr *e2vtab;
+	  gfc_se se;
+	  e2vtab = gfc_find_and_cut_at_last_class_ref (expr2);
+	  gfc_add_vptr_component (e2vtab);
+	  gfc_add_size_component (e2vtab);
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr (&se, e2vtab);
+	  gfc_add_block_to_block (block, &se.pre);
+	  size = fold_convert (size_type_node, se.expr);
+	  gfc_free_expr (e2vtab);
+	}
+      size_in_bytes = size;
+    }
   else
     {
       /* Otherwise use the length in bytes of the rhs.  */
@@ -6859,7 +6882,8 @@
       gfc_add_expr_to_block (&block, tmp);
     }
   else if (init && (cm->attr.allocatable
-	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable)))
+	   || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
+	       && expr->ts.type != BT_CLASS)))
     {
       /* Take care about non-array allocatable components here.  The alloc_*
 	 routine below is motivated by the alloc_scalar_allocatable_for_
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 226036)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,8 @@
+2015-07-21  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	PR fortran/66035
+	* gfortran.dg/structure_constructor_13.f03: New test.
+
 2015-07-21  Alex Velenko  <Alex.Velenko@arm.com>
 
 	Backport from mainline:
Index: gcc/testsuite/gfortran.dg/structure_constructor_13.f03
===================================================================
--- gcc/testsuite/gfortran.dg/structure_constructor_13.f03	(Revision 0)
+++ gcc/testsuite/gfortran.dg/structure_constructor_13.f03	(Arbeitskopie)
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Contributed by Melven Roehrig-Zoellner  <Melven.Roehrig-Zoellner@DLR.de>
+! PR fortran/66035
+
+program test_pr66035
+  type t
+  end type t
+  type w
+    class(t), allocatable :: c
+  end type w
+
+  type(t) :: o
+
+  call test(o)
+contains
+  subroutine test(o)
+    class(t), intent(inout) :: o
+    type(w), dimension(:), allocatable :: list
+
+    select type (o)
+      class is (t)
+        list = [w(o)] ! This caused an ICE
+      class default
+        call abort()
+    end select
+  end subroutine
+end program