Fortran: Fix class reallocate on assignment [PR99307].

2021-04-15  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/99307
	* symbol.c: Remove trailing white space.
	* trans-array.c (gfc_trans_create_temp_array): Create a class
	temporary for class expressions and assign the new descriptor
	to the data field.
	(build_class_array_ref): If the class expr can be extracted,
	then use that for 'decl'. Class function results are reliably
	handled this way. Call gfc_find_and_cut_at_last_class_ref to
	eliminate largely redundant code. Remove dead code and recast
	the rest of the code to extract 'decl' for remaining cases.
	Call gfc_build_spanned_array_ref.
	(gfc_alloc_allocatable_for_assignment): Use class descriptor
	element length for 'elemsize1'. Eliminate repeat set of dtype
	for class expressions.
	* trans-expr.c (gfc_find_and_cut_at_last_class_ref): Include
	additional code from build_class_array_ref, and use optional
	gfc_typespec pointer argument.
	(gfc_trans_scalar_assign): Make use of pre and post blocks for
	all class expressions.
	* trans.c (get_array_span): For unlimited polymorphic exprs
	multiply the span by the value of the _len field.
	(gfc_build_spanned_array_ref): New function.
	(gfc_build_array_ref): Call gfc_build_spanned_array_ref and
	eliminate repeated code.
	* trans.h: Add arg to gfc_find_and_cut_at_last_class_ref and
	add prototype for gfc_build_spanned_array_ref.

1 files changed, 23 insertions, 13 deletions

diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ab53fc5..9e8e861 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -422,6 +422,9 @@ get_array_span (tree type, tree decl)
 		return NULL_TREE;
 	    }
 	  span = gfc_class_vtab_size_get (decl);
+	  /* For unlimited polymorphic entities then _len component needs
+	     to be multiplied with the size.  */
+	  span = gfc_resize_class_size_with_len (NULL, decl, span);
 	}
       else if (GFC_DECL_PTR_ARRAY_P (decl))
 	{
@@ -439,13 +442,31 @@ get_array_span (tree type, tree decl)
 }
 
 
+tree
+gfc_build_spanned_array_ref (tree base, tree offset, tree span)
+{
+  tree type;
+  tree tmp;
+  type = TREE_TYPE (TREE_TYPE (base));
+  offset = fold_build2_loc (input_location, MULT_EXPR,
+			    gfc_array_index_type,
+			    offset, span);
+  tmp = gfc_build_addr_expr (pvoid_type_node, base);
+  tmp = fold_build_pointer_plus_loc (input_location, tmp, offset);
+  tmp = fold_convert (build_pointer_type (type), tmp);
+  if ((TREE_CODE (type) != INTEGER_TYPE && TREE_CODE (type) != ARRAY_TYPE)
+      || !TYPE_STRING_FLAG (type))
+    tmp = build_fold_indirect_ref_loc (input_location, tmp);
+  return tmp;
+}
+
+
 /* Build an ARRAY_REF with its natural type.  */
 
 tree
 gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
 {
   tree type = TREE_TYPE (base);
-  tree tmp;
   tree span = NULL_TREE;
 
   if (GFC_ARRAY_TYPE_P (type) && GFC_TYPE_ARRAY_RANK (type) == 0)
@@ -488,18 +509,7 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
   /* If a non-null span has been generated reference the element with
      pointer arithmetic.  */
   if (span != NULL_TREE)
-    {
-      offset = fold_build2_loc (input_location, MULT_EXPR,
-				gfc_array_index_type,
-				offset, span);
-      tmp = gfc_build_addr_expr (pvoid_type_node, base);
-      tmp = fold_build_pointer_plus_loc (input_location, tmp, offset);
-      tmp = fold_convert (build_pointer_type (type), tmp);
-      if ((TREE_CODE (type) != INTEGER_TYPE && TREE_CODE (type) != ARRAY_TYPE)
-	  || !TYPE_STRING_FLAG (type))
-	tmp = build_fold_indirect_ref_loc (input_location, tmp);
-      return tmp;
-    }
+    return gfc_build_spanned_array_ref (base, offset, span);
   /* Otherwise use a straightforward array reference.  */
   else
     return build4_loc (input_location, ARRAY_REF, type, base, offset,