Re: PING! [Fortran, Patch, PR72832, v1] [6/7 Regression] [OOP] ALLOCATE with SOURCE fails to allocate requested dimensions

[Andre Vehreschild]

Hi all,

due to no complains about the trunk version, backported to gcc-6 as r241448.

Regards,
Andre

On Thu, 13 Oct 2016 10:52:59 +0200
Andre Vehreschild  wrote:

> Hi Steve,
> 
> thanks for the review. Committed as r241088 on trunk.
> 
> Letting it mature for one week in trunk before backporting to gcc-6.
> 
> Regards,
>   Andre
> 
> On Wed, 12 Oct 2016 10:18:29 -0700
> Steve Kargl  wrote:
> 
> > On Wed, Oct 12, 2016 at 11:50:10AM +0200, Andre Vehreschild wrote:  
> > > Ping!
> > > 
> > > Updated patch with the comments gotten so far.
> > > 
> > > Ok for trunk?
> > > 
> > 
> > Looks good to me.
> >   
> 
> 


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 
Index: gcc/fortran/ChangeLog
===
--- gcc/fortran/ChangeLog	(Revision 241447)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,14 @@
+2016-10-23  Andre Vehreschild  
+
+	Backported from trunk
+	PR fortran/72832
+	* trans-expr.c (gfc_copy_class_to_class): Add generation of
+	runtime array bounds check.
+	* trans-intrinsic.c (gfc_conv_intrinsic_size): Add a crutch to
+	get the descriptor of a function returning a class object.
+	* trans-stmt.c (gfc_trans_allocate): Use the array spec on the
+	array to allocate instead of the array spec from source=.
+
 2016-10-17  Steven G. Kargl  
 
 	Backport from trunk
Index: gcc/fortran/trans-expr.c
===
--- gcc/fortran/trans-expr.c	(Revision 241447)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -1166,6 +1166,7 @@
   stmtblock_t body;
   stmtblock_t ifbody;
   gfc_loopinfo loop;
+  tree orig_nelems = nelems; /* Needed for bounds check.  */
 
   gfc_init_block ();
   tmp = fold_build2_loc (input_location, MINUS_EXPR,
@@ -1193,6 +1194,31 @@
 	}
   vec_safe_push (args, to_ref);
 
+  /* Add bounds check.  */
+  if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) > 0 && is_from_desc)
+	{
+	  char *msg;
+	  const char *name = "<>";
+	  tree from_len;
+
+	  if (DECL_P (to))
+	name = (const char *)(DECL_NAME (to)->identifier.id.str);
+
+	  from_len = gfc_conv_descriptor_size (from_data, 1);
+	  tmp = fold_build2_loc (input_location, NE_EXPR,
+  boolean_type_node, from_len, orig_nelems);
+	  msg = xasprintf ("Array bound mismatch for dimension %d "
+			   "of array '%s' (%%ld/%%ld)",
+			   1, name);
+
+	  gfc_trans_runtime_check (true, false, tmp, ,
+   _current_locus, msg,
+			 fold_convert (long_integer_type_node, orig_nelems),
+			   fold_convert (long_integer_type_node, from_len));
+
+	  free (msg);
+	}
+
   tmp = build_call_vec (fcn_type, fcn, args);
 
   /* Build the body of the loop.  */
Index: gcc/fortran/trans-intrinsic.c
===
--- gcc/fortran/trans-intrinsic.c	(Revision 241447)
+++ gcc/fortran/trans-intrinsic.c	(Arbeitskopie)
@@ -5815,9 +5815,20 @@
   if (actual->expr->ts.type == BT_CLASS)
 gfc_add_class_array_ref (actual->expr);
 
-  argse.want_pointer = 1;
   argse.data_not_needed = 1;
-  gfc_conv_expr_descriptor (, actual->expr);
+  if (gfc_is_alloc_class_array_function (actual->expr))
+{
+  /* For functions that return a class array conv_expr_descriptor is not
+	 able to get the descriptor right.  Therefore this special case.  */
+  gfc_conv_expr_reference (, actual->expr);
+  argse.expr = gfc_build_addr_expr (NULL_TREE,
+	gfc_class_data_get (argse.expr));
+}
+  else
+{
+  argse.want_pointer = 1;
+  gfc_conv_expr_descriptor (, actual->expr);
+}
   gfc_add_block_to_block (>pre, );
   gfc_add_block_to_block (>post, );
   arg1 = gfc_evaluate_now (argse.expr, >pre);
Index: gcc/fortran/trans-stmt.c
===
--- gcc/fortran/trans-stmt.c	(Revision 241447)
+++ gcc/fortran/trans-stmt.c	(Arbeitskopie)
@@ -5476,7 +5476,8 @@
 		  desc = tmp;
 		  tmp = gfc_class_data_get (tmp);
 		}
-	  e3_is = E3_DESC;
+	  if (code->ext.alloc.arr_spec_from_expr3)
+		e3_is = E3_DESC;
 	}
 	  else
 	desc = !is_coarray ? se.expr
Index: gcc/testsuite/ChangeLog
===
--- gcc/testsuite/ChangeLog	(Revision 241447)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,11 @@
+2016-10-23  Andre Vehreschild  
+
+	Backported from trunk
+	PR fortran/72832
+	* gfortran.dg/allocate_with_source_22.f03: New test.
+	* gfortran.dg/allocate_with_source_23.f03: New test.  Expected to
+	fail.
+
 2016-10-19  Uros Bizjak  
 
 	PR target/77991
Index: gcc/testsuite/gfortran.dg/allocate_with_source_22.f03
===
--- gcc/testsuite/gfortran.dg/allocate_with_source_22.f03	(nicht existent)
+++ 

Re: PING! [Fortran, Patch, PR72832, v1] [6/7 Regression] [OOP] ALLOCATE with SOURCE fails to allocate requested dimensions

[Andre Vehreschild]

Hi Steve,

thanks for the review. Committed as r241088 on trunk.

Letting it mature for one week in trunk before backporting to gcc-6.

Regards,
Andre

On Wed, 12 Oct 2016 10:18:29 -0700
Steve Kargl  wrote:

> On Wed, Oct 12, 2016 at 11:50:10AM +0200, Andre Vehreschild wrote:
> > Ping!
> > 
> > Updated patch with the comments gotten so far.
> > 
> > Ok for trunk?
> >   
> 
> Looks good to me.
> 


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 
Index: gcc/fortran/ChangeLog
===
--- gcc/fortran/ChangeLog	(Revision 241086)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,13 @@
+2016-10-13  Andre Vehreschild  
+
+	PR fortran/72832
+	* trans-expr.c (gfc_copy_class_to_class): Add generation of
+	runtime array bounds check.
+	* trans-intrinsic.c (gfc_conv_intrinsic_size): Add a crutch to
+	get the descriptor of a function returning a class object.
+	* trans-stmt.c (gfc_trans_allocate): Use the array spec on the
+	array to allocate instead of the array spec from source=.
+
 2016-10-12  Andre Vehreschild  
 
 	* trans-expr.c (gfc_find_and_cut_at_last_class_ref): Fixed style.
Index: gcc/fortran/trans-expr.c
===
--- gcc/fortran/trans-expr.c	(Revision 241086)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -1235,6 +1235,7 @@
   stmtblock_t body;
   stmtblock_t ifbody;
   gfc_loopinfo loop;
+  tree orig_nelems = nelems; /* Needed for bounds check.  */
 
   gfc_init_block ();
   tmp = fold_build2_loc (input_location, MINUS_EXPR,
@@ -1262,6 +1263,31 @@
 	}
   vec_safe_push (args, to_ref);
 
+  /* Add bounds check.  */
+  if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) > 0 && is_from_desc)
+	{
+	  char *msg;
+	  const char *name = "<>";
+	  tree from_len;
+
+	  if (DECL_P (to))
+	name = (const char *)(DECL_NAME (to)->identifier.id.str);
+
+	  from_len = gfc_conv_descriptor_size (from_data, 1);
+	  tmp = fold_build2_loc (input_location, NE_EXPR,
+  boolean_type_node, from_len, orig_nelems);
+	  msg = xasprintf ("Array bound mismatch for dimension %d "
+			   "of array '%s' (%%ld/%%ld)",
+			   1, name);
+
+	  gfc_trans_runtime_check (true, false, tmp, ,
+   _current_locus, msg,
+			 fold_convert (long_integer_type_node, orig_nelems),
+			   fold_convert (long_integer_type_node, from_len));
+
+	  free (msg);
+	}
+
   tmp = build_call_vec (fcn_type, fcn, args);
 
   /* Build the body of the loop.  */
Index: gcc/fortran/trans-intrinsic.c
===
--- gcc/fortran/trans-intrinsic.c	(Revision 241086)
+++ gcc/fortran/trans-intrinsic.c	(Arbeitskopie)
@@ -6544,9 +6544,20 @@
   if (actual->expr->ts.type == BT_CLASS)
 gfc_add_class_array_ref (actual->expr);
 
-  argse.want_pointer = 1;
   argse.data_not_needed = 1;
-  gfc_conv_expr_descriptor (, actual->expr);
+  if (gfc_is_alloc_class_array_function (actual->expr))
+{
+  /* For functions that return a class array conv_expr_descriptor is not
+	 able to get the descriptor right.  Therefore this special case.  */
+  gfc_conv_expr_reference (, actual->expr);
+  argse.expr = gfc_build_addr_expr (NULL_TREE,
+	gfc_class_data_get (argse.expr));
+}
+  else
+{
+  argse.want_pointer = 1;
+  gfc_conv_expr_descriptor (, actual->expr);
+}
   gfc_add_block_to_block (>pre, );
   gfc_add_block_to_block (>post, );
   arg1 = gfc_evaluate_now (argse.expr, >pre);
Index: gcc/fortran/trans-stmt.c
===
--- gcc/fortran/trans-stmt.c	(Revision 241086)
+++ gcc/fortran/trans-stmt.c	(Arbeitskopie)
@@ -5489,7 +5489,8 @@
 		  desc = tmp;
 		  tmp = gfc_class_data_get (tmp);
 		}
-	  e3_is = E3_DESC;
+	  if (code->ext.alloc.arr_spec_from_expr3)
+		e3_is = E3_DESC;
 	}
 	  else
 	desc = !is_coarray ? se.expr
Index: gcc/testsuite/ChangeLog
===
--- gcc/testsuite/ChangeLog	(Revision 241086)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,10 @@
+2016-10-13  Andre Vehreschild  
+
+	PR fortran/72832
+	* gfortran.dg/allocate_with_source_22.f03: New test.
+	* gfortran.dg/allocate_with_source_23.f03: New test.  Expected to
+	fail.
+
 2016-10-13  Thomas Preud'homme  
 
 	* gcc.target/arm/movhi_movw.c: Enable test for ARM mode.
Index: gcc/testsuite/gfortran.dg/allocate_with_source_22.f03
===
--- gcc/testsuite/gfortran.dg/allocate_with_source_22.f03	(nicht existent)
+++ gcc/testsuite/gfortran.dg/allocate_with_source_22.f03	(Arbeitskopie)
@@ -0,0 +1,48 @@
+! { dg-do run }
+!
+! Test that pr72832 is fixed now.
+! Contributed by Daan van Vugt
+
+program allocate_source
+  type :: t
+integer :: i
+  

Re: PING! [Fortran, Patch, PR72832, v1] [6/7 Regression] [OOP] ALLOCATE with SOURCE fails to allocate requested dimensions

[Steve Kargl]

On Wed, Oct 12, 2016 at 11:50:10AM +0200, Andre Vehreschild wrote:
> Ping!
> 
> Updated patch with the comments gotten so far.
> 
> Ok for trunk?
> 

Looks good to me.

-- 
Steve

PING! [Fortran, Patch, PR72832, v1] [6/7 Regression] [OOP] ALLOCATE with SOURCE fails to allocate requested dimensions

[Andre Vehreschild]

Ping!

Updated patch with the comments gotten so far.

Ok for trunk?

- Andre

On Fri, 2 Sep 2016 09:59:19 +0200
Andre Vehreschild  wrote:

> Hi all,
> 
> attached patch fixes the issue raised by PR72832. The issue was that
> the array descriptor of the SOURCE= in an ALLOCATE () was used to
> allocate an array object although an explicit array spec had been
> given.
> 
> The initial test showed a second issue when a class array was copied.
> Compiling the code with -fcheck=bounds showed that no boundary check
> was generated for class array copying using gfc_copy_class_to_class().
> I have added the generation of a runtime boundary check when the
> -fcheck=bounds flag is set to locate the current issue. The test
> allocate_with_source_23 is compiled with fcheck=bounds and fails as
> expected ({ xfail *-*-* } set).
> 
> Fixing the both issues unfortunately raised the next one, when trying
> to get the size of a class array returned from a function (testcase:
> allocate_with_source_11.f08). Here the issue was that for functions
> returning class arrays gfc_conv_expr_descriptor () relied on the
> descriptor being magicked into the scalarizer, which did not work in
> this use case. Due to the first issue this bug did not raise beforehand.
> Because I could not figure how to do it right in
> gfc_conv_expr_descriptor (), I found a way to circumvent the issue by
> getting the reference of the result of the function returning a class
> array and massaging it to be ok for size (). This works quite neatly,
> but may be someone with better knowledge of conv_expr_descriptor and
> the scalarizer might want to fix it there. I suppose there are more
> locations in the code, that work around this issue.
> 
> Bootstrapped and regtests ok on x86_64-linux-gnu/F23 for trunk and
> gcc-6. Ok for both?
> 
> - Andre


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 
gcc/fortran/ChangeLog:

2016-09-01  Andre Vehreschild  

PR fortran/72832
* trans-expr.c (gfc_copy_class_to_class): Add generation of
runtime array bounds check.
* trans-intrinsic.c (gfc_conv_intrinsic_size): Add a crutch to
get the descriptor of a function returning a class object.
* trans-stmt.c (gfc_trans_allocate): Use the array spec on the
array to allocate instead of the array spec from source=.

gcc/testsuite/ChangeLog:

2016-09-01  Andre Vehreschild  

PR fortran/72832
* gfortran.dg/allocate_with_source_22.f03: New test.
* gfortran.dg/allocate_with_source_23.f03: New test.  Expected to
fail.


diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 1de2818..5486ec6 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1237,6 +1237,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
   stmtblock_t body;
   stmtblock_t ifbody;
   gfc_loopinfo loop;
+  tree orig_nelems = nelems; /* Needed for bounds check.  */
 
   gfc_init_block ();
   tmp = fold_build2_loc (input_location, MINUS_EXPR,
@@ -1264,6 +1265,31 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
 	}
   vec_safe_push (args, to_ref);
 
+  /* Add bounds check.  */
+  if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) > 0 && is_from_desc)
+	{
+	  char *msg;
+	  const char *name = "<>";
+	  tree from_len;
+
+	  if (DECL_P (to))
+	name = (const char *)(DECL_NAME (to)->identifier.id.str);
+
+	  from_len = gfc_conv_descriptor_size (from_data, 1);
+	  tmp = fold_build2_loc (input_location, NE_EXPR,
+  boolean_type_node, from_len, orig_nelems);
+	  msg = xasprintf ("Array bound mismatch for dimension %d "
+			   "of array '%s' (%%ld/%%ld)",
+			   1, name);
+
+	  gfc_trans_runtime_check (true, false, tmp, ,
+   _current_locus, msg,
+			 fold_convert (long_integer_type_node, orig_nelems),
+			   fold_convert (long_integer_type_node, from_len));
+
+	  free (msg);
+	}
+
   tmp = build_call_vec (fcn_type, fcn, args);
 
   /* Build the body of the loop.  */
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index a499c32..9d5e33c 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -6544,9 +6544,20 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
   if (actual->expr->ts.type == BT_CLASS)
 gfc_add_class_array_ref (actual->expr);
 
-  argse.want_pointer = 1;
   argse.data_not_needed = 1;
-  gfc_conv_expr_descriptor (, actual->expr);
+  if (gfc_is_alloc_class_array_function (actual->expr))
+{
+  /* For functions that return a class array conv_expr_descriptor is not
+	 able to get the descriptor right.  Therefore this special case.  */
+  gfc_conv_expr_reference (, actual->expr);
+  argse.expr = gfc_build_addr_expr (NULL_TREE,
+	gfc_class_data_get (argse.expr));
+}
+  else
+{
+  argse.want_pointer = 1;
+  gfc_conv_expr_descriptor (,