[Patch, Fortran, 66927, v1] [6 Regression] ICE in gfc_conf_procedure_call

[Patch, Fortran, 66927, v1] [6 Regression] ICE in gfc_conf_procedure_call

[Andre Vehreschild]

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

Dear all,

the attached patch fixes a regression introduced by my patches for the
F2008-style allocate(). In this case a function returning an array of BT_CLASS
objects can not be conv'ed using conv_expr_descriptor, but needs to be
conv_expr_reference()'ed, because the _data component has the descriptor already
and just needs to be addressed correctly.

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: pr66927_1.clog --]
[-- Type: text/plain, Size: 346 bytes --]

gcc/fortran/ChangeLog:

2015-08-06  Andre Vehreschild  <vehre@gcc.gnu.org>

	* trans-stmt.c (gfc_trans_allocate): Do not conv_expr_descriptor
	for functions returning	a class object. Get the reference
	instead.

gcc/testsuite/ChangeLog:

2015-08-06  Andre Vehreschild  <vehre@gcc.gnu.org>

	* gfortran.dg/allocate_with_source_10.f08: New test.



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

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 6409f7f..3f90b76 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5187,9 +5187,14 @@ gfc_trans_allocate (gfc_code * code)
 	  /* In all other cases evaluate the expr3.  */
 	  symbol_attribute attr;
 	  /* Get the descriptor for all arrays, that are not allocatable or
-	     pointer, because the latter are descriptors already.  */
+	     pointer, because the latter are descriptors already.
+	     The exception are function calls returning a class object:
+	     For those conv_expr_descriptor does not work.  */
 	  attr = gfc_expr_attr (code->expr3);
-	  if (code->expr3->rank != 0 && !attr.allocatable && !attr.pointer)
+	  if (code->expr3->rank != 0
+	      && ((!attr.allocatable && !attr.pointer)
+		  || (code->expr3->expr_type == EXPR_FUNCTION
+		      && code->expr3->ts.type != BT_CLASS)))
 	    gfc_conv_expr_descriptor (&se, code->expr3);
 	  else
 	    gfc_conv_expr_reference (&se, code->expr3);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_10.f08 b/gcc/testsuite/gfortran.dg/allocate_with_source_10.f08
new file mode 100644
index 0000000..88962c1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_10.f08
@@ -0,0 +1,52 @@
+!{ dg-do run }
+!
+! Testcase for pr66927
+! Contributed by Juergen Reuter <juergen.reuter@desy.de>
+
+module processes
+  implicit none
+  private
+
+  type :: t1_t
+     real :: p = 0.0
+  end type t1_t
+  
+  type :: t2_t
+     private
+     type(t1_t), dimension(:), allocatable :: p
+   contains
+     procedure :: func => t2_func
+  end type t2_t
+  
+  type, public :: t3_t
+    type(t2_t), public :: int_born
+  end type t3_t
+
+  public :: evaluate
+
+contains
+
+  function t2_func (int) result (p)
+    class(t2_t), intent(in) :: int
+    type(t1_t), dimension(:), allocatable :: p
+    allocate(p(5))
+  end function t2_func
+  
+  subroutine evaluate (t3)
+    class(t3_t), intent(inout) :: t3
+    type(t1_t), dimension(:), allocatable :: p_born    
+    allocate (p_born(1:size(t3%int_born%func ())), &
+         source = t3%int_born%func ())
+    if (.not. allocated(p_born)) call abort()
+    if (size(p_born) /= 5) call abort()
+  end subroutine evaluate
+
+end module processes
+
+program pr66927
+use processes
+type(t3_t) :: o
+call evaluate(o)
+end
+
+

Re: [Patch, Fortran, 66927, v1] [6 Regression] ICE in gfc_conf_procedure_call

[Mikael Morin]

Le 06/08/2015 12:53, Andre Vehreschild a écrit :
> Dear all,
>
> the attached patch fixes a regression introduced by my patches for the
> F2008-style allocate(). In this case a function returning an array of BT_CLASS
> objects can not be conv'ed using conv_expr_descriptor, but needs to be
> conv_expr_reference()'ed, because the _data component has the descriptor already
> and just needs to be addressed correctly.
>
> Bootstraps and regtests ok on x86_64-linux-gnu/f21.
>
> Ok for trunk?
>
> Regards,
> 	Andre
>
> pr66927_1.patch
>
> diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
> index 6409f7f..3f90b76 100644
> --- a/gcc/fortran/trans-stmt.c
> +++ b/gcc/fortran/trans-stmt.c
> @@ -5187,9 +5187,14 @@ gfc_trans_allocate (gfc_code * code)
>  	  /* In all other cases evaluate the expr3.  */
>  	  symbol_attribute attr;
>  	  /* Get the descriptor for all arrays, that are not allocatable or
> -	     pointer, because the latter are descriptors already.  */
> +	     pointer, because the latter are descriptors already.
> +	     The exception are function calls returning a class object:
> +	     For those conv_expr_descriptor does not work.  */

So, it is gfc_conv_expr_descriptor that should be fixed?
Let me have a look at it.

Mikael

Re: [Patch, Fortran, 66927, v1] [6 Regression] ICE in gfc_conf_procedure_call

[Andre Vehreschild]

On Thu, 6 Aug 2015 14:00:56 +0200
Mikael Morin <mikael.morin@sfr.fr> wrote:

> Le 06/08/2015 12:53, Andre Vehreschild a écrit :
> > Dear all,
> >
> > the attached patch fixes a regression introduced by my patches for the
> > F2008-style allocate(). In this case a function returning an array of
> > BT_CLASS objects can not be conv'ed using conv_expr_descriptor, but needs
> > to be conv_expr_reference()'ed, because the _data component has the
> > descriptor already and just needs to be addressed correctly.
> >
> > Bootstraps and regtests ok on x86_64-linux-gnu/f21.
> >
> > Ok for trunk?
> >
> > Regards,
> > 	Andre
> >
> > pr66927_1.patch
> >
> > diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
> > index 6409f7f..3f90b76 100644
> > --- a/gcc/fortran/trans-stmt.c
> > +++ b/gcc/fortran/trans-stmt.c
> > @@ -5187,9 +5187,14 @@ gfc_trans_allocate (gfc_code * code)
> >  	  /* In all other cases evaluate the expr3.  */
> >  	  symbol_attribute attr;
> >  	  /* Get the descriptor for all arrays, that are not allocatable or
> > -	     pointer, because the latter are descriptors already.  */
> > +	     pointer, because the latter are descriptors already.
> > +	     The exception are function calls returning a class object:
> > +	     For those conv_expr_descriptor does not work.  */
> 
> So, it is gfc_conv_expr_descriptor that should be fixed?
> Let me have a look at it.

Er, yes, and now. gfc_conv_expr_descriptor would need a fix, but that fix is
only needed for allocate() all other callers must not be affected. That's why I
did not try to fix it in gfc_conv_expr_descriptor().

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

Re: [Patch, Fortran, 66927, v1] [6 Regression] ICE in gfc_conf_procedure_call

[Mikael Morin]

Le 06/08/2015 14:00, Mikael Morin a écrit :
> Let me have a look at it.
>
So, I've had a look at it.
This is a pandora box that I don't want to open.
So your change is OK.
However, could you clarify the comment?
Function calls returning a class object are either pointer or 
allocatable, so they don't call gfc_conv_expr_descriptor already, they 
aren't an exception...

Mikael

Re: [Patch, Fortran, 66927, v2] [6 Regression] ICE in gfc_conf_procedure_call

[Andre Vehreschild]

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

Hi Mikael, hi all,

sorry for the late reply, but I was a bit busy lately and the patch was
not as easy as expected. 

Mikael, I addressed your question about clarifying the comment and while
doing so the question arose "what happens when the function returns a
class object?" You have one guess; correct: ICE! This extended patch
now addresses the ICE and furthermore more consequently makes use of
the temporary created for the source= expression. I.e., when the
temporary is a class-object, it's vtab is more often retrieved from the
temporary and no longer generated from the gfc_expr's typespec. 

To efficiently copy - in the class/derived cases - the data, I had to
drill open the gfc_copy_class_to_class() routine a little bit, in that
it accepts the destination object to be a BT_DERIVED, too. 

I provide two testcases now and had to fix class_array_15, which was
expecting one too many calls to __builtin_free. With this patch the
creation of an unnecessary temporary object is prevented, which in the
consequence leads to one less calls to __builtin_free to free the
allocatable component of the temporary object.

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

Ok, for trunk?

Regards,
	Andre

On Sun, 9 Aug 2015 14:37:03 +0200
Mikael Morin <mikael.morin@sfr.fr> wrote:

> Le 06/08/2015 14:00, Mikael Morin a écrit :
> > Let me have a look at it.
> >
> So, I've had a look at it.
> This is a pandora box that I don't want to open.
> So your change is OK.
> However, could you clarify the comment?
> Function calls returning a class object are either pointer or 
> allocatable, so they don't call gfc_conv_expr_descriptor already, they 
> aren't an exception...
> 
> Mikael


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

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

gcc/fortran/ChangeLog:

2015-09-29  Andre Vehreschild  <vehre@gcc.gnu.org>

	* trans-array.c (build_array_ref): Modified call to 
	gfc_get_class_array_ref to adhere to new interface.
	(gfc_conv_expr_descriptor): For one-based arrays that
	are filled by a loop starting at one the start index of the
	source array has to be mangled into the offset.
	* trans-expr.c (gfc_get_class_array_ref): When the tree to get
	the _data component is present already, add a way to supply it.
	(gfc_copy_class_to_class): Allow to copy to a derived type also.
	* trans-stmt.c (gfc_trans_allocate): Do not conv_expr_descriptor
	for functions returning	a class or derived object. Get the
	reference instead.
	* trans.h: Interface change of gfc_get_class_array_ref.

gcc/testsuite/ChangeLog:

2015-09-29  Andre Vehreschild  <vehre@gmx.de>

	* gfortran.dg/allocate_with_source_10.f08: New test.
	* gfortran.dg/allocate_with_source_11.f08: New test.
	* gfortran.dg/class_array_15.f03: Changed count of expected
	_builtin_frees to 11. One step of temporaries is spared, therefore
	the allocatable component of that temporary is not to be freeed.


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

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a6b761b..504b08a 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3222,7 +3222,7 @@ build_array_ref (tree desc, tree offset, tree decl, tree vptr)
     {
       type = gfc_get_element_type (type);
       tmp = TREE_OPERAND (cdecl, 0);
-      tmp = gfc_get_class_array_ref (offset, tmp);
+      tmp = gfc_get_class_array_ref (offset, tmp, NULL_TREE);
       tmp = fold_convert (build_pointer_type (type), tmp);
       tmp = build_fold_indirect_ref_loc (input_location, tmp);
       return tmp;
@@ -7079,9 +7079,20 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	    }
 	  else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)) || se->use_offset)
 	    {
+	      bool toonebased;
 	      tmp = gfc_conv_array_lbound (desc, n);
+	      toonebased = integer_onep (tmp);
+	      // lb(arr) - from (- start + 1)
 	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
 				     TREE_TYPE (base), tmp, from);
+	      if (onebased && toonebased)
+		{
+		  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+					 TREE_TYPE (base), tmp, start);
+		  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+					 TREE_TYPE (base), tmp,
+					 gfc_index_one_node);
+		}
 	      tmp = fold_build2_loc (input_location, MULT_EXPR,
 				     TREE_TYPE (base), tmp,
 				     gfc_conv_array_stride (desc, n));
@@ -7155,12 +7166,13 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   /* For class arrays add the class tree into the saved descriptor to
      enable getting of _vptr and the like.  */
   if (expr->expr_type == EXPR_VARIABLE && VAR_P (desc)
-      && IS_CLASS_ARRAY (expr->symtree->n.sym)
-      && DECL_LANG_SPECIFIC (expr->symtree->n.sym->backend_decl))
+      && IS_CLASS_ARRAY (expr->symtree->n.sym))
     {
       gfc_allocate_lang_decl (desc);
       GFC_DECL_SAVED_DESCRIPTOR (desc) =
-	  GFC_DECL_SAVED_DESCRIPTOR (expr->symtree->n.sym->backend_decl);
+	  DECL_LANG_SPECIFIC (expr->symtree->n.sym->backend_decl) ?
+	    GFC_DECL_SAVED_DESCRIPTOR (expr->symtree->n.sym->backend_decl)
+	  : expr->symtree->n.sym->backend_decl;
     }
   if (!se->direct_byref || se->byref_noassign)
     {
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index e086fe3..90b5140 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1039,9 +1039,10 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
    of the referenced element.  */
 
 tree
-gfc_get_class_array_ref (tree index, tree class_decl)
+gfc_get_class_array_ref (tree index, tree class_decl, tree data_comp)
 {
-  tree data = gfc_class_data_get (class_decl);
+  tree data = data_comp != NULL_TREE ? data_comp :
+				       gfc_class_data_get (class_decl);
   tree size = gfc_class_vtab_size_get (class_decl);
   tree offset = fold_build2_loc (input_location, MULT_EXPR,
 				 gfc_array_index_type,
@@ -1075,6 +1076,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
   tree stdcopy;
   tree extcopy;
   tree index;
+  bool is_from_desc = false, is_to_class = false;
 
   args = NULL;
   /* To prevent warnings on uninitialized variables.  */
@@ -1088,7 +1090,19 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
   fcn_type = TREE_TYPE (TREE_TYPE (fcn));
 
   if (from != NULL_TREE)
-    from_data = gfc_class_data_get (from);
+    {
+      is_from_desc = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from));
+      if (is_from_desc)
+	{
+	  from_data = from;
+	  from = GFC_DECL_SAVED_DESCRIPTOR (from);
+	}
+      else
+	{
+	  from_data = gfc_class_data_get (from);
+	  is_from_desc = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data));
+	}
+     }
   else
     from_data = gfc_class_vtab_def_init_get (to);
 
@@ -1100,9 +1114,16 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
 	from_len = integer_zero_node;
     }
 
-  to_data = gfc_class_data_get (to);
-  if (unlimited)
-    to_len = gfc_class_len_get (to);
+  if (GFC_CLASS_TYPE_P (TREE_TYPE (to)))
+    {
+      is_to_class = true;
+      to_data = gfc_class_data_get (to);
+      if (unlimited)
+	to_len = gfc_class_len_get (to);
+    }
+  else
+    /* When to is a BT_DERIVED and not a BT_CLASS, then to_data == to.  */
+    to_data = to;
 
   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (to_data)))
     {
@@ -1118,15 +1139,23 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
       nelems = gfc_evaluate_now (tmp, &body);
       index = gfc_create_var (gfc_array_index_type, "S");
 
-      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data)))
+      if (is_from_desc)
 	{
-	  from_ref = gfc_get_class_array_ref (index, from);
+	  from_ref = gfc_get_class_array_ref (index, from, from_data);
 	  vec_safe_push (args, from_ref);
 	}
       else
         vec_safe_push (args, from_data);
 
-      to_ref = gfc_get_class_array_ref (index, to);
+      if (is_to_class)
+	to_ref = gfc_get_class_array_ref (index, to, to_data);
+      else
+	{
+	  tmp = gfc_conv_array_data (to);
+	  tmp = build_fold_indirect_ref_loc (input_location, tmp);
+	  to_ref = gfc_build_addr_expr (NULL_TREE,
+					gfc_build_array_ref (tmp, index, to));
+	}
       vec_safe_push (args, to_ref);
 
       tmp = build_call_vec (fcn_type, fcn, args);
@@ -1183,7 +1212,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
     }
   else
     {
-      gcc_assert (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data)));
+      gcc_assert (!is_from_desc);
       vec_safe_push (args, from_data);
       vec_safe_push (args, to_data);
       stdcopy = build_call_vec (fcn_type, fcn, args);
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index a8536fd..1bd131e 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5186,9 +5186,16 @@ gfc_trans_allocate (gfc_code * code)
 	  /* In all other cases evaluate the expr3.  */
 	  symbol_attribute attr;
 	  /* Get the descriptor for all arrays, that are not allocatable or
-	     pointer, because the latter are descriptors already.  */
+	     pointer, because the latter are descriptors already.
+	     The exception are function calls returning a class object:
+	     The descriptor is stored in their results _data component, which
+	     is easier to access, when first a temporary variable for the
+	     result is created and the descriptor retrieved from there.  */
 	  attr = gfc_expr_attr (code->expr3);
-	  if (code->expr3->rank != 0 && !attr.allocatable && !attr.pointer)
+	  if (code->expr3->rank != 0
+	      && ((!attr.allocatable && !attr.pointer)
+		  || (code->expr3->expr_type == EXPR_FUNCTION
+		      && code->expr3->ts.type != BT_CLASS)))
 	    gfc_conv_expr_descriptor (&se, code->expr3);
 	  else
 	    gfc_conv_expr_reference (&se, code->expr3);
@@ -5205,17 +5212,40 @@ gfc_trans_allocate (gfc_code * code)
 	     variable declaration.  */
       if (se.expr != NULL_TREE && temp_var_needed)
 	{
-	  tree var;
+	  tree var, desc;
 	  tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) ?
 		se.expr
 	      : build_fold_indirect_ref_loc (input_location, se.expr);
+
+	  /* Get the array descriptor and prepare it to be assigned to the
+	     temporary variable var.  For classes the array descriptor is
+	     in the _data component and the object goes into the
+	     GFC_DECL_SAVED_DESCRIPTOR.  */
+	  if (code->expr3->ts.type == BT_CLASS
+	      && code->expr3->rank != 0)
+	    {
+	      /* When an array_ref was in expr3, then the descriptor is the
+		 first operand.  */
+	      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+		{
+		  desc = TREE_OPERAND (tmp, 0);
+		}
+	      else
+		{
+		  desc = tmp;
+		  tmp = gfc_class_data_get (tmp);
+		}
+	      e3_is = E3_DESC;
+	    }
+	  else
+	    desc = se.expr;
 	  /* We need a regular (non-UID) symbol here, therefore give a
 	     prefix.  */
 	  var = gfc_create_var (TREE_TYPE (tmp), "source");
-	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)))
+	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
 	    {
 	      gfc_allocate_lang_decl (var);
-	      GFC_DECL_SAVED_DESCRIPTOR (var) = se.expr;
+	      GFC_DECL_SAVED_DESCRIPTOR (var) = desc;
 	    }
 	  gfc_add_modify_loc (input_location, &block, var, tmp);
 
@@ -5241,11 +5271,12 @@ gfc_trans_allocate (gfc_code * code)
 	  expr3_len = se.string_length;
 	}
       /* Store what the expr3 is to be used for.  */
-      e3_is = expr3 != NULL_TREE ?
-	    (code->ext.alloc.arr_spec_from_expr3 ?
-	       E3_DESC
-	     : (code->expr3->mold ? E3_MOLD : E3_SOURCE))
-	  : E3_UNSET;
+      if (e3_is == E3_UNSET)
+	e3_is = expr3 != NULL_TREE ?
+	      (code->ext.alloc.arr_spec_from_expr3 ?
+		 E3_DESC
+	       : (code->expr3->mold ? E3_MOLD : E3_SOURCE))
+	    : E3_UNSET;
 
       /* Figure how to get the _vtab entry.  This also obtains the tree
 	 expression for accessing the _len component, because only
@@ -5254,11 +5285,17 @@ gfc_trans_allocate (gfc_code * code)
       if (code->expr3->ts.type == BT_CLASS)
 	{
 	  gfc_expr *rhs;
+	  tmp = expr3 != NULL_TREE && POINTER_TYPE_P (TREE_TYPE (expr3)) ?
+		build_fold_indirect_ref (expr3): expr3;
 	  /* Polymorphic SOURCE: VPTR must be determined at run time.
 	     expr3 may be a temporary array declaration, therefore check for
 	     GFC_CLASS_TYPE_P before trying to get the _vptr component.  */
-	  if (expr3 != NULL_TREE && GFC_CLASS_TYPE_P (TREE_TYPE (expr3))
-	      && (VAR_P (expr3) || !code->expr3->ref))
+	  if (tmp != NULL_TREE
+	      && TREE_CODE (tmp) != POINTER_PLUS_EXPR
+	      && (e3_is == E3_DESC
+		  || (GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
+		      && (VAR_P (tmp) || !code->expr3->ref))
+		  || (VAR_P (tmp) && DECL_LANG_SPECIFIC (tmp))))
 	    tmp = gfc_class_vptr_get (expr3);
 	  else
 	    {
@@ -5709,10 +5746,7 @@ gfc_trans_allocate (gfc_code * code)
 	  /* Initialization via SOURCE block (or static default initializer).
 	     Classes need some special handling, so catch them first.  */
 	  if (expr3 != NULL_TREE
-	      && ((POINTER_TYPE_P (TREE_TYPE (expr3))
-		   && TREE_CODE (expr3) != POINTER_PLUS_EXPR)
-		  || (VAR_P (expr3) && GFC_CLASS_TYPE_P (
-			TREE_TYPE (expr3))))
+	      && TREE_CODE (expr3) != POINTER_PLUS_EXPR
 	      && code->expr3->ts.type == BT_CLASS
 	      && (expr->ts.type == BT_CLASS
 		  || expr->ts.type == BT_DERIVED))
@@ -5731,7 +5765,7 @@ gfc_trans_allocate (gfc_code * code)
 	      gfc_expr *ppc;
 	      gfc_code *ppc_code;
 	      gfc_ref *ref, *dataref;
-	      gfc_expr *rhs = gfc_copy_expr (code->expr3);
+	      gfc_expr *rhs = e3rhs ? e3rhs : gfc_copy_expr (code->expr3);
 
 	      /* Do a polymorphic deep copy.  */
 	      actual = gfc_get_actual_arglist ();
@@ -5827,7 +5861,8 @@ gfc_trans_allocate (gfc_code * code)
 					 void_type_node, tmp, extcopy, stdcopy);
 		}
 	      gfc_free_statements (ppc_code);
-	      gfc_free_expr (rhs);
+	      if (rhs != e3rhs)
+		gfc_free_expr (rhs);
 	    }
 	  else
 	    {
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 2501403..3a23a3c 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -378,7 +378,7 @@ tree gfc_vptr_final_get (tree);
 void gfc_reset_vptr (stmtblock_t *, gfc_expr *);
 void gfc_reset_len (stmtblock_t *, gfc_expr *);
 tree gfc_get_vptr_from_expr (tree);
-tree gfc_get_class_array_ref (tree, tree);
+tree gfc_get_class_array_ref (tree, tree, tree);
 tree gfc_copy_class_to_class (tree, tree, tree, bool);
 bool gfc_add_finalizer_call (stmtblock_t *, gfc_expr *);
 bool gfc_add_comp_finalizer_call (stmtblock_t *, tree, gfc_component *, bool);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_10.f08 b/gcc/testsuite/gfortran.dg/allocate_with_source_10.f08
new file mode 100644
index 0000000..b9c68b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_10.f08
@@ -0,0 +1,51 @@
+!{ dg-do run }
+!
+! Testcase for pr66927
+! Contributed by Juergen Reuter <juergen.reuter@desy.de>
+
+module processes
+  implicit none
+  private
+
+  type :: t1_t
+     real :: p = 0.0
+  end type t1_t
+
+  type :: t2_t
+     private
+     type(t1_t), dimension(:), allocatable :: p
+   contains
+     procedure :: func => t2_func
+  end type t2_t
+
+  type, public :: t3_t
+    type(t2_t), public :: int_born
+  end type t3_t
+
+  public :: evaluate
+
+contains
+
+  function t2_func (int) result (p)
+    class(t2_t), intent(in) :: int
+    type(t1_t), dimension(:), allocatable :: p
+    allocate(p(5))
+  end function t2_func
+
+  subroutine evaluate (t3)
+    class(t3_t), intent(inout) :: t3
+    type(t1_t), dimension(:), allocatable :: p_born
+    allocate (p_born(1:size(t3%int_born%func ())), &
+         source = t3%int_born%func ())
+    if (.not. allocated(p_born)) call abort()
+    if (size(p_born) /= 5) call abort()
+  end subroutine evaluate
+
+end module processes
+
+program pr66927
+use processes
+type(t3_t) :: o
+call evaluate(o)
+end
+
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_11.f08 b/gcc/testsuite/gfortran.dg/allocate_with_source_11.f08
new file mode 100644
index 0000000..5491b49
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_11.f08
@@ -0,0 +1,51 @@
+!{ dg-do run }
+!
+! Testcase for pr66927, pr67123
+! Contributed by Juergen Reuter <juergen.reuter@desy.de>
+
+module processes
+  implicit none
+  private
+
+  type :: t1_t
+     real :: p = 0.0
+  end type t1_t
+
+  type :: t2_t
+     private
+     type(t1_t), dimension(:), allocatable :: p
+   contains
+     procedure :: func => t2_func
+  end type t2_t
+
+  type, public :: t3_t
+    type(t2_t), public :: int_born
+  end type t3_t
+
+  public :: evaluate
+
+contains
+
+  function t2_func (int) result (p)
+    class(t2_t), intent(in) :: int
+    class(t1_t), dimension(:), allocatable :: p
+    allocate(p(5))
+  end function t2_func
+
+  subroutine evaluate (t3)
+    class(t3_t), intent(inout) :: t3
+    type(t1_t), dimension(:), allocatable :: p_born
+    allocate (p_born(1:size(t3%int_born%func ())), &
+         source = t3%int_born%func ())
+    if (.not. allocated(p_born)) call abort()
+    if (size(p_born) /= 5) call abort()
+  end subroutine evaluate
+
+end module processes
+
+program pr66927
+use processes
+type(t3_t) :: o
+call evaluate(o)
+end
+
diff --git a/gcc/testsuite/gfortran.dg/class_array_15.f03 b/gcc/testsuite/gfortran.dg/class_array_15.f03
index fd9e04c..85716f9 100644
--- a/gcc/testsuite/gfortran.dg/class_array_15.f03
+++ b/gcc/testsuite/gfortran.dg/class_array_15.f03
@@ -115,4 +115,4 @@ subroutine pr54992  ! This test remains as the original.
   bh => bhGet(b,instance=2)
   if (loc (b) .ne. loc(bh%hostNode)) call abort
 end
-! { dg-final { scan-tree-dump-times "builtin_free" 12 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_free" 11 "original" } }

Re: [Patch, Fortran, 66927, v2] [6 Regression] ICE in gfc_conf_procedure_call

[Andre Vehreschild]

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

Hi Paul, hi all,

thanks for the review. Submitted as r229294.

Regards,
	Andre

On Sun, 25 Oct 2015 08:43:24 +0100
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:

> Dear Andre,
> 
> As far as I can see, the problems with PR57117 are specific to RESHAPE
> and need not affect committing your patch. To my surprise, the
> combination of your patch and mine for PR67171 fixes PR67044 in that
> the ICE no longer occurs. I have to get my head around how to write a
> testcase for it that tests the functionality though!
> 
> You can commit this patch to trunk. As I said elsewhere, I will rename
> the testcase for PR67171.
> 
> Many thanks for the patch.
> 
> Paul
> 
> On 23 October 2015 at 09:44, Paul Richard Thomas
> <paul.richard.thomas@gmail.com> wrote:
> > Dear Andre,
> >
> > I will wait until you fix the problems that Dominique has pointed out.
> > However, if by Sunday afternoon (rain forecast!) you haven't found the
> > time, I will see if I can locate the source of these new problems.
> >
> > With best regards
> >
> > Paul
> >
> > On 7 October 2015 at 19:51, Dominique d'Humières <dominiq@lps.ens.fr> wrote:
> >> This patch also fixes pr57117 comment 2, the original test and the test in comment 3 now give an ICE
> >>
> >> pr57117.f90:82:0:
> >>
> >>    allocate(z(9), source=reshape(x, (/ 9 /)))
> >> 1
> >> internal compiler error: Segmentation fault: 11
> >>
> >> and pr67044.
> >>
> >> Thanks,
> >>
> >> Dominique
> >>
> >
> >
> >
> > --
> > Outside of a dog, a book is a man's best friend. Inside of a dog it's
> > too dark to read.
> >
> > Groucho Marx
> 
> 
> 


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

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

Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h	(Revision 229293)
+++ gcc/fortran/trans.h	(Arbeitskopie)
@@ -378,7 +378,7 @@
 void gfc_reset_vptr (stmtblock_t *, gfc_expr *);
 void gfc_reset_len (stmtblock_t *, gfc_expr *);
 tree gfc_get_vptr_from_expr (tree);
-tree gfc_get_class_array_ref (tree, tree);
+tree gfc_get_class_array_ref (tree, tree, tree);
 tree gfc_copy_class_to_class (tree, tree, tree, bool);
 bool gfc_add_finalizer_call (stmtblock_t *, gfc_expr *);
 bool gfc_add_comp_finalizer_call (stmtblock_t *, tree, gfc_component *, bool);
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(Revision 229293)
+++ gcc/fortran/trans-array.c	(Arbeitskopie)
@@ -3250,7 +3250,7 @@
     {
       type = gfc_get_element_type (type);
       tmp = TREE_OPERAND (cdecl, 0);
-      tmp = gfc_get_class_array_ref (offset, tmp);
+      tmp = gfc_get_class_array_ref (offset, tmp, NULL_TREE);
       tmp = fold_convert (build_pointer_type (type), tmp);
       tmp = build_fold_indirect_ref_loc (input_location, tmp);
       return tmp;
@@ -7107,9 +7107,20 @@
 	    }
 	  else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)) || se->use_offset)
 	    {
+	      bool toonebased;
 	      tmp = gfc_conv_array_lbound (desc, n);
+	      toonebased = integer_onep (tmp);
+	      // lb(arr) - from (- start + 1)
 	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
 				     TREE_TYPE (base), tmp, from);
+	      if (onebased && toonebased)
+		{
+		  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+					 TREE_TYPE (base), tmp, start);
+		  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+					 TREE_TYPE (base), tmp,
+					 gfc_index_one_node);
+		}
 	      tmp = fold_build2_loc (input_location, MULT_EXPR,
 				     TREE_TYPE (base), tmp,
 				     gfc_conv_array_stride (desc, n));
@@ -7183,12 +7194,13 @@
   /* For class arrays add the class tree into the saved descriptor to
      enable getting of _vptr and the like.  */
   if (expr->expr_type == EXPR_VARIABLE && VAR_P (desc)
-      && IS_CLASS_ARRAY (expr->symtree->n.sym)
-      && DECL_LANG_SPECIFIC (expr->symtree->n.sym->backend_decl))
+      && IS_CLASS_ARRAY (expr->symtree->n.sym))
     {
       gfc_allocate_lang_decl (desc);
       GFC_DECL_SAVED_DESCRIPTOR (desc) =
-	  GFC_DECL_SAVED_DESCRIPTOR (expr->symtree->n.sym->backend_decl);
+	  DECL_LANG_SPECIFIC (expr->symtree->n.sym->backend_decl) ?
+	    GFC_DECL_SAVED_DESCRIPTOR (expr->symtree->n.sym->backend_decl)
+	  : expr->symtree->n.sym->backend_decl;
     }
   if (!se->direct_byref || se->byref_noassign)
     {
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(Revision 229293)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -1039,9 +1039,10 @@
    of the referenced element.  */
 
 tree
-gfc_get_class_array_ref (tree index, tree class_decl)
+gfc_get_class_array_ref (tree index, tree class_decl, tree data_comp)
 {
-  tree data = gfc_class_data_get (class_decl);
+  tree data = data_comp != NULL_TREE ? data_comp :
+				       gfc_class_data_get (class_decl);
   tree size = gfc_class_vtab_size_get (class_decl);
   tree offset = fold_build2_loc (input_location, MULT_EXPR,
 				 gfc_array_index_type,
@@ -1075,6 +1076,7 @@
   tree stdcopy;
   tree extcopy;
   tree index;
+  bool is_from_desc = false, is_to_class = false;
 
   args = NULL;
   /* To prevent warnings on uninitialized variables.  */
@@ -1088,7 +1090,19 @@
   fcn_type = TREE_TYPE (TREE_TYPE (fcn));
 
   if (from != NULL_TREE)
-    from_data = gfc_class_data_get (from);
+    {
+      is_from_desc = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from));
+      if (is_from_desc)
+	{
+	  from_data = from;
+	  from = GFC_DECL_SAVED_DESCRIPTOR (from);
+	}
+      else
+	{
+	  from_data = gfc_class_data_get (from);
+	  is_from_desc = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data));
+	}
+     }
   else
     from_data = gfc_class_vtab_def_init_get (to);
 
@@ -1100,9 +1114,16 @@
 	from_len = integer_zero_node;
     }
 
-  to_data = gfc_class_data_get (to);
-  if (unlimited)
-    to_len = gfc_class_len_get (to);
+  if (GFC_CLASS_TYPE_P (TREE_TYPE (to)))
+    {
+      is_to_class = true;
+      to_data = gfc_class_data_get (to);
+      if (unlimited)
+	to_len = gfc_class_len_get (to);
+    }
+  else
+    /* When to is a BT_DERIVED and not a BT_CLASS, then to_data == to.  */
+    to_data = to;
 
   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (to_data)))
     {
@@ -1118,15 +1139,23 @@
       nelems = gfc_evaluate_now (tmp, &body);
       index = gfc_create_var (gfc_array_index_type, "S");
 
-      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data)))
+      if (is_from_desc)
 	{
-	  from_ref = gfc_get_class_array_ref (index, from);
+	  from_ref = gfc_get_class_array_ref (index, from, from_data);
 	  vec_safe_push (args, from_ref);
 	}
       else
         vec_safe_push (args, from_data);
 
-      to_ref = gfc_get_class_array_ref (index, to);
+      if (is_to_class)
+	to_ref = gfc_get_class_array_ref (index, to, to_data);
+      else
+	{
+	  tmp = gfc_conv_array_data (to);
+	  tmp = build_fold_indirect_ref_loc (input_location, tmp);
+	  to_ref = gfc_build_addr_expr (NULL_TREE,
+					gfc_build_array_ref (tmp, index, to));
+	}
       vec_safe_push (args, to_ref);
 
       tmp = build_call_vec (fcn_type, fcn, args);
@@ -1183,7 +1212,7 @@
     }
   else
     {
-      gcc_assert (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data)));
+      gcc_assert (!is_from_desc);
       vec_safe_push (args, from_data);
       vec_safe_push (args, to_data);
       stdcopy = build_call_vec (fcn_type, fcn, args);
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 229293)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,20 @@
+2015-10-25  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	PR fortran/66927
+	PR fortran/67044	
+	* trans-array.c (build_array_ref): Modified call to 
+	gfc_get_class_array_ref to adhere to new interface.
+	(gfc_conv_expr_descriptor): For one-based arrays that
+	are filled by a loop starting at one the start index of the
+	source array has to be mangled into the offset.
+	* trans-expr.c (gfc_get_class_array_ref): When the tree to get
+	the _data component is present already, add a way to supply it.
+	(gfc_copy_class_to_class): Allow to copy to a derived type also.
+	* trans-stmt.c (gfc_trans_allocate): Do not conv_expr_descriptor
+	for functions returning	a class or derived object. Get the
+	reference instead.
+	* trans.h: Interface change of gfc_get_class_array_ref.
+
 2015-10-24  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/68055
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(Revision 229293)
+++ gcc/fortran/trans-stmt.c	(Arbeitskopie)
@@ -5186,9 +5186,16 @@
 	  /* In all other cases evaluate the expr3.  */
 	  symbol_attribute attr;
 	  /* Get the descriptor for all arrays, that are not allocatable or
-	     pointer, because the latter are descriptors already.  */
+	     pointer, because the latter are descriptors already.
+	     The exception are function calls returning a class object:
+	     The descriptor is stored in their results _data component, which
+	     is easier to access, when first a temporary variable for the
+	     result is created and the descriptor retrieved from there.  */
 	  attr = gfc_expr_attr (code->expr3);
-	  if (code->expr3->rank != 0 && !attr.allocatable && !attr.pointer)
+	  if (code->expr3->rank != 0
+	      && ((!attr.allocatable && !attr.pointer)
+		  || (code->expr3->expr_type == EXPR_FUNCTION
+		      && code->expr3->ts.type != BT_CLASS)))
 	    gfc_conv_expr_descriptor (&se, code->expr3);
 	  else
 	    gfc_conv_expr_reference (&se, code->expr3);
@@ -5205,17 +5212,40 @@
 	     variable declaration.  */
       if (se.expr != NULL_TREE && temp_var_needed)
 	{
-	  tree var;
+	  tree var, desc;
 	  tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) ?
 		se.expr
 	      : build_fold_indirect_ref_loc (input_location, se.expr);
+
+	  /* Get the array descriptor and prepare it to be assigned to the
+	     temporary variable var.  For classes the array descriptor is
+	     in the _data component and the object goes into the
+	     GFC_DECL_SAVED_DESCRIPTOR.  */
+	  if (code->expr3->ts.type == BT_CLASS
+	      && code->expr3->rank != 0)
+	    {
+	      /* When an array_ref was in expr3, then the descriptor is the
+		 first operand.  */
+	      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+		{
+		  desc = TREE_OPERAND (tmp, 0);
+		}
+	      else
+		{
+		  desc = tmp;
+		  tmp = gfc_class_data_get (tmp);
+		}
+	      e3_is = E3_DESC;
+	    }
+	  else
+	    desc = se.expr;
 	  /* We need a regular (non-UID) symbol here, therefore give a
 	     prefix.  */
 	  var = gfc_create_var (TREE_TYPE (tmp), "source");
-	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)))
+	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
 	    {
 	      gfc_allocate_lang_decl (var);
-	      GFC_DECL_SAVED_DESCRIPTOR (var) = se.expr;
+	      GFC_DECL_SAVED_DESCRIPTOR (var) = desc;
 	    }
 	  gfc_add_modify_loc (input_location, &block, var, tmp);
 
@@ -5241,11 +5271,12 @@
 	  expr3_len = se.string_length;
 	}
       /* Store what the expr3 is to be used for.  */
-      e3_is = expr3 != NULL_TREE ?
-	    (code->ext.alloc.arr_spec_from_expr3 ?
-	       E3_DESC
-	     : (code->expr3->mold ? E3_MOLD : E3_SOURCE))
-	  : E3_UNSET;
+      if (e3_is == E3_UNSET)
+	e3_is = expr3 != NULL_TREE ?
+	      (code->ext.alloc.arr_spec_from_expr3 ?
+		 E3_DESC
+	       : (code->expr3->mold ? E3_MOLD : E3_SOURCE))
+	    : E3_UNSET;
 
       /* Figure how to get the _vtab entry.  This also obtains the tree
 	 expression for accessing the _len component, because only
@@ -5254,11 +5285,17 @@
       if (code->expr3->ts.type == BT_CLASS)
 	{
 	  gfc_expr *rhs;
+	  tmp = expr3 != NULL_TREE && POINTER_TYPE_P (TREE_TYPE (expr3)) ?
+		build_fold_indirect_ref (expr3): expr3;
 	  /* Polymorphic SOURCE: VPTR must be determined at run time.
 	     expr3 may be a temporary array declaration, therefore check for
 	     GFC_CLASS_TYPE_P before trying to get the _vptr component.  */
-	  if (expr3 != NULL_TREE && GFC_CLASS_TYPE_P (TREE_TYPE (expr3))
-	      && (VAR_P (expr3) || !code->expr3->ref))
+	  if (tmp != NULL_TREE
+	      && TREE_CODE (tmp) != POINTER_PLUS_EXPR
+	      && (e3_is == E3_DESC
+		  || (GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
+		      && (VAR_P (tmp) || !code->expr3->ref))
+		  || (VAR_P (tmp) && DECL_LANG_SPECIFIC (tmp))))
 	    tmp = gfc_class_vptr_get (expr3);
 	  else
 	    {
@@ -5709,10 +5746,7 @@
 	  /* Initialization via SOURCE block (or static default initializer).
 	     Classes need some special handling, so catch them first.  */
 	  if (expr3 != NULL_TREE
-	      && ((POINTER_TYPE_P (TREE_TYPE (expr3))
-		   && TREE_CODE (expr3) != POINTER_PLUS_EXPR)
-		  || (VAR_P (expr3) && GFC_CLASS_TYPE_P (
-			TREE_TYPE (expr3))))
+	      && TREE_CODE (expr3) != POINTER_PLUS_EXPR
 	      && code->expr3->ts.type == BT_CLASS
 	      && (expr->ts.type == BT_CLASS
 		  || expr->ts.type == BT_DERIVED))
@@ -5731,7 +5765,7 @@
 	      gfc_expr *ppc;
 	      gfc_code *ppc_code;
 	      gfc_ref *ref, *dataref;
-	      gfc_expr *rhs = gfc_copy_expr (code->expr3);
+	      gfc_expr *rhs = e3rhs ? e3rhs : gfc_copy_expr (code->expr3);
 
 	      /* Do a polymorphic deep copy.  */
 	      actual = gfc_get_actual_arglist ();
@@ -5827,7 +5861,8 @@
 					 void_type_node, tmp, extcopy, stdcopy);
 		}
 	      gfc_free_statements (ppc_code);
-	      gfc_free_expr (rhs);
+	      if (rhs != e3rhs)
+		gfc_free_expr (rhs);
 	    }
 	  else
 	    {
Index: gcc/testsuite/gfortran.dg/class_array_15.f03
===================================================================
--- gcc/testsuite/gfortran.dg/class_array_15.f03	(Revision 229293)
+++ gcc/testsuite/gfortran.dg/class_array_15.f03	(Arbeitskopie)
@@ -115,4 +115,4 @@
   bh => bhGet(b,instance=2)
   if (loc (b) .ne. loc(bh%hostNode)) call abort
 end
-! { dg-final { scan-tree-dump-times "builtin_free" 12 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_free" 11 "original" } }
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 229293)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,13 @@
+2015-10-25  Andre Vehreschild  <vehre@gmx.de>
+
+        PR fortran/66927
+        PR fortran/67044
+	* gfortran.dg/allocate_with_source_10.f08: New test.
+	* gfortran.dg/allocate_with_source_11.f08: New test.
+	* gfortran.dg/class_array_15.f03: Changed count of expected
+	_builtin_frees to 11. One step of temporaries is spared, therefore
+	the allocatable component of that temporary is not to be freeed.
+
 2015-10-24  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/68055

Re: [Patch, Fortran, 66927, v2] [6 Regression] ICE in gfc_conf_procedure_call

[Paul Richard Thomas]

Dear Andre,

As far as I can see, the problems with PR57117 are specific to RESHAPE
and need not affect committing your patch. To my surprise, the
combination of your patch and mine for PR67171 fixes PR67044 in that
the ICE no longer occurs. I have to get my head around how to write a
testcase for it that tests the functionality though!

You can commit this patch to trunk. As I said elsewhere, I will rename
the testcase for PR67171.

Many thanks for the patch.

Paul

On 23 October 2015 at 09:44, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> Dear Andre,
>
> I will wait until you fix the problems that Dominique has pointed out.
> However, if by Sunday afternoon (rain forecast!) you haven't found the
> time, I will see if I can locate the source of these new problems.
>
> With best regards
>
> Paul
>
> On 7 October 2015 at 19:51, Dominique d'Humières <dominiq@lps.ens.fr> wrote:
>> This patch also fixes pr57117 comment 2, the original test and the test in comment 3 now give an ICE
>>
>> pr57117.f90:82:0:
>>
>>    allocate(z(9), source=reshape(x, (/ 9 /)))
>> 1
>> internal compiler error: Segmentation fault: 11
>>
>> and pr67044.
>>
>> Thanks,
>>
>> Dominique
>>
>
>
>
> --
> Outside of a dog, a book is a man's best friend. Inside of a dog it's
> too dark to read.
>
> Groucho Marx



-- 
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, 66927, v2] [6 Regression] ICE in gfc_conf_procedure_call

[Dominique d'Humières]

This patch also fixes pr57117 comment 2, the original test and the test in comment 3 now give an ICE

pr57117.f90:82:0:

   allocate(z(9), source=reshape(x, (/ 9 /)))
1
internal compiler error: Segmentation fault: 11

and pr67044.

Thanks,

Dominique