Re: [Patch, fortran] PR84546 - [7/8 Regression] Bad sourced allocation of CLASS(*) with source with CLASS(*) component

[Jerry DeLisle]

On 03/11/2018 12:23 PM, Paul Richard Thomas wrote:

This regression came about because the vtable deep copy for derived
types with unlimited polymorphic components was not making use of the
_len parameter to compute the memory to be allocated and the offsets
to array elements.

The ChangeLogs are reasonably self explanatory.

Bootstraps and regtests on FC27/x86_64 - OK for trunk and 7-branch?


Yes, OK and thanks for the work.

Jerry


Paul

2018-03-11  Paul Thomas  

 PR fortran/84546
 * trans-array.c (structure_alloc_comps): Make sure that the
 vptr is copied and that the unlimited polymorphic _len is used
 to compute the size to be allocated.
 * trans-expr.c (gfc_get_class_array_ref): If unlimited, use the
 unlimited polymorphic _len for the offset to the element.
 (gfc_copy_class_to_class): Set the new 'unlimited' argument.
 * trans.h : Add the boolean 'unlimited' to the prototype.

2018-03-11  Paul Thomas  

 PR fortran/84546
 * gfortran.dg/unlimited_polymorphic_29.f90 : New test.

[Patch, fortran] PR84546 - [7/8 Regression] Bad sourced allocation of CLASS(*) with source with CLASS(*) component

[Paul Richard Thomas]

This regression came about because the vtable deep copy for derived
types with unlimited polymorphic components was not making use of the
_len parameter to compute the memory to be allocated and the offsets
to array elements.

The ChangeLogs are reasonably self explanatory.

Bootstraps and regtests on FC27/x86_64 - OK for trunk and 7-branch?

Paul

2018-03-11  Paul Thomas  

PR fortran/84546
* trans-array.c (structure_alloc_comps): Make sure that the
vptr is copied and that the unlimited polymorphic _len is used
to compute the size to be allocated.
* trans-expr.c (gfc_get_class_array_ref): If unlimited, use the
unlimited polymorphic _len for the offset to the element.
(gfc_copy_class_to_class): Set the new 'unlimited' argument.
* trans.h : Add the boolean 'unlimited' to the prototype.

2018-03-11  Paul Thomas  

PR fortran/84546
* gfortran.dg/unlimited_polymorphic_29.f90 : New test.
Index: gcc/fortran/trans-array.c
===
*** gcc/fortran/trans-array.c	(revision 258189)
--- gcc/fortran/trans-array.c	(working copy)
*** structure_alloc_comps (gfc_symbol * der_
*** 8883, 
--- 8883,8913 
  
  	  gfc_init_block ();
  
+ 	  gfc_add_modify (, gfc_class_vptr_get (dcmp),
+ 			  gfc_class_vptr_get (comp));
+ 
+ 	  /* Copy the unlimited '_len' field. If it is greater than zero
+ 		 (ie. a character(_len)), multiply it by size and use this
+ 		 for the malloc call.  */
+ 	  if (UNLIMITED_POLY (c))
+ 		{
+ 		  tree ctmp;
+ 		  gfc_add_modify (, gfc_class_len_get (dcmp),
+   gfc_class_len_get (comp));
+ 
+ 		  size = gfc_evaluate_now (size, );
+ 		  tmp = gfc_class_len_get (comp);
+ 		  ctmp = fold_build2_loc (input_location, MULT_EXPR,
+ 	  size_type_node, size,
+ 	  fold_convert (size_type_node, tmp));
+ 		  tmp = fold_build2_loc (input_location, GT_EXPR,
+ 	 logical_type_node, tmp,
+ 	 build_zero_cst (TREE_TYPE (tmp)));
+ 		  size = fold_build3_loc (input_location, COND_EXPR,
+ 	  size_type_node, tmp, ctmp, size);
+ 		  size = gfc_evaluate_now (size, );
+ 		}
+ 
  	  /* Coarray component have to have the same allocation status and
  		 shape/type-parameter/effective-type on the LHS and RHS of an
  		 intrinsic assignment. Hence, we did not deallocated them - and
Index: gcc/fortran/trans-expr.c
===
*** gcc/fortran/trans-expr.c	(revision 258189)
--- gcc/fortran/trans-expr.c	(working copy)
*** gfc_conv_class_to_class (gfc_se *parmse,
*** 1185,1199 
 of the referenced element.  */
  
  tree
! gfc_get_class_array_ref (tree index, tree class_decl, tree data_comp)
  {
!   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,
!  index, size);
!   tree ptr;
data = gfc_conv_descriptor_data_get (data);
ptr = fold_convert (pvoid_type_node, data);
ptr = fold_build_pointer_plus_loc (input_location, ptr, offset);
--- 1185,1216 
 of the referenced element.  */
  
  tree
! gfc_get_class_array_ref (tree index, tree class_decl, tree data_comp,
! 			 bool unlimited)
  {
!   tree data, size, tmp, ctmp, offset, ptr;
! 
!   data = data_comp != NULL_TREE ? data_comp :
!   gfc_class_data_get (class_decl);
!   size = gfc_class_vtab_size_get (class_decl);
! 
!   if (unlimited)
! {
!   tmp = fold_convert (gfc_array_index_type,
! 			  gfc_class_len_get (class_decl));
!   ctmp = fold_build2_loc (input_location, MULT_EXPR,
! 			  gfc_array_index_type, size, tmp);
!   tmp = fold_build2_loc (input_location, GT_EXPR,
! 			 logical_type_node, tmp,
! 			 build_zero_cst (TREE_TYPE (tmp)));
!   size = fold_build3_loc (input_location, COND_EXPR,
! 			  gfc_array_index_type, tmp, ctmp, size);
! }
! 
!   offset = fold_build2_loc (input_location, MULT_EXPR,
! 			gfc_array_index_type,
! 			index, size);
! 
data = gfc_conv_descriptor_data_get (data);
ptr = fold_convert (pvoid_type_node, data);
ptr = fold_build_pointer_plus_loc (input_location, ptr, offset);
*** gfc_copy_class_to_class (tree from, tree
*** 1295,1308 
  
if (is_from_desc)
  	{
! 	  from_ref = gfc_get_class_array_ref (index, from, from_data);
  	  vec_safe_push (args, from_ref);
  	}
else
  vec_safe_push (args, from_data);
  
if (is_to_class)
! 	to_ref = gfc_get_class_array_ref (index, to, to_data);
else
  	{
  	  tmp = gfc_conv_array_data (to);
--- 1312,1326 
  
if (is_from_desc)
  	{
! 	  from_ref = gfc_get_class_array_ref (index, from, from_data,
! 	  unlimited);
  	  vec_safe_push (args, from_ref);
  	}
else
  vec_safe_push (args, from_data);