[Patch, fortran] 99307 - FAIL: gfortran.dg/class_assign_4.f90 execution test

[Patch, fortran] 99307 - FAIL: gfortran.dg/class_assign_4.f90 execution test

[Paul Richard Thomas]

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

This patch comes in two versions: submit.diff with Change.Logs or
submit2.diff with Change2.Logs.

The first fixes the problem by changing array temporaries from class
expressions into class temporaries. This permits the use of
gfc_get_class_from_expr to obtain the vptr for these temporaries and all
the good things that come with that when handling dynamic types. The second
part of the fix is to use the array element length from the class
descriptor, when reallocating on assignment. This is needed because the
vptr is being set too early. I will set about trying to track down why this
is happening and fix it after release.

The second version does the same as the first but puts in place a load of
tidying up that is permitted by the fix to class array temporaries.

I couldn't readily see how to prepare a testcase - ideas?

Both regtest on FC33/x86_64. The first was tested by Dominique (see the
PR). OK for master?

Regards

Paul

[-- Attachment #2: Change.Logs --]
[-- Type: application/octet-stream, Size: 674 bytes --]

Fortran: Fix class reallocate on assignment [PR99307].

2021-03-26  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/99307
	* 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.
	(gfc_alloc_allocatable_for_assignment): Use class descriptor
	element length for 'elemsize1'. Eliminate repeat set of dtype
	for class expressions.
	* trans-expr_c (gfc_trans_scalar_assign): Make use of pre and
	post blocks for all class expressions.

[-- Attachment #3: Change2.Logs --]
[-- Type: application/octet-stream, Size: 1372 bytes --]

Fortran: Fix class reallocate on assignment [PR99307].

2021-03-26  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/99307
	* 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.

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

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c6725659093..8aa56d1ccb9 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1403,9 +1403,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
   desc = gfc_create_var (type, "atmp");
   GFC_DECL_PACKED_ARRAY (desc) = 1;
 
-  info->descriptor = desc;
-  size = gfc_index_one_node;
-
   /* Emit a DECL_EXPR for the variable sized array type in
      GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type
      sizes works correctly.  */
@@ -1416,9 +1413,40 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
   gfc_add_expr_to_block (pre, build1 (DECL_EXPR,
 				      arraytype, TYPE_NAME (arraytype)));
 
-  /* Fill in the array dtype.  */
-  tmp = gfc_conv_descriptor_dtype (desc);
-  gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+  if (class_expr != NULL_TREE)
+    {
+      tree class_data;
+      tree dtype;
+
+      /* Create a class temporary.  */
+      tmp = gfc_create_var (TREE_TYPE (class_expr), "ctmp");
+      gfc_add_modify (pre, tmp, class_expr);
+
+      /* Assign the new descriptor to the _data field. This allows the
+	 vptr _copy to be used for scalarized assignment since the class
+	 temporary can be found from the descriptor.  */
+      class_data = gfc_class_data_get (tmp);
+      tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+			     TREE_TYPE (desc), desc);
+      gfc_add_modify (pre, class_data, tmp);
+
+      /* Take the dtype from the class expression.  */
+      dtype = gfc_conv_descriptor_dtype (gfc_class_data_get (class_expr));
+      tmp = gfc_conv_descriptor_dtype (class_data);
+      gfc_add_modify (pre, tmp, dtype);
+
+      /* Point desc to the class _data field.  */
+      desc = class_data;
+    }
+  else
+    {
+      /* Fill in the array dtype.  */
+      tmp = gfc_conv_descriptor_dtype (desc);
+      gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+    }
+
+  info->descriptor = desc;
+  size = gfc_index_one_node;
 
   /*
      Fill in the bounds and stride.  This is a packed array, so:
@@ -3438,6 +3466,12 @@ build_class_array_ref (gfc_se *se, tree base, tree index)
       && GFC_DECL_SAVED_DESCRIPTOR (se->expr)
       && GFC_CLASS_TYPE_P (TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (se->expr))))
     decl = se->expr;
+  else if (!VAR_P (base) && gfc_get_class_from_expr (base))
+    {
+      decl = gfc_get_class_from_expr (base);
+      se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);
+      goto class_found;
+    }
   else
     {
       if (expr == NULL
@@ -3530,6 +3564,7 @@ build_class_array_ref (gfc_se *se, tree base, tree index)
   if (POINTER_TYPE_P (TREE_TYPE (decl)))
     decl = build_fold_indirect_ref_loc (input_location, decl);
 
+class_found:
   if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
     return false;
 
@@ -10274,23 +10309,10 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
     }
   else if (expr1->ts.type == BT_CLASS)
     {
-      tmp = expr1->rank ? gfc_get_class_from_expr (desc) : NULL_TREE;
-      if (tmp == NULL_TREE)
-	tmp = gfc_get_class_from_gfc_expr (expr1);
-
-      if (tmp != NULL_TREE)
-	{
-	  tmp2 = gfc_class_vptr_get (tmp);
-	  cond = fold_build2_loc (input_location, NE_EXPR,
-				  logical_type_node, tmp2,
-				  build_int_cst (TREE_TYPE (tmp2), 0));
-	  elemsize1 = gfc_class_vtab_size_get (tmp);
-	  elemsize1 = fold_build3_loc (input_location, COND_EXPR,
-				      gfc_array_index_type, cond,
-				      elemsize1, gfc_index_zero_node);
-	}
-      else
-	elemsize1 = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&CLASS_DATA (expr1)->ts));
+      /* Unfortunately, the lhs vptr is set too early in many cases.
+	 Play it safe by using the descriptor element length.  */
+      tmp = gfc_conv_descriptor_elem_len (desc);
+      elemsize1 = fold_convert (gfc_array_index_type, tmp);
     }
   else
     elemsize1 = NULL_TREE;
@@ -10764,11 +10786,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 
 
   /* We already set the dtype in the case of deferred character
-     length arrays and unlimited polymorphic arrays.  */
+     length arrays and class lvalues.  */
   if (!(GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))
 	&& ((expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
 	    || coarray))
-      && !UNLIMITED_POLY (expr1))
+      && expr1->ts.type != BT_CLASS)
     {
       tmp = gfc_conv_descriptor_dtype (desc);
       gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc)));
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 85c16d7f4c3..6468943b5c7 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -9983,17 +9983,20 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
       gfc_add_modify (&block, lse->expr, tmp);
     }
   /* If possible use the rhs vptr copy with trans_scalar_class_assign....  */
-  else if (ts.type == BT_CLASS
-	   && !trans_scalar_class_assign (&block, lse, rse))
+  else if (ts.type == BT_CLASS)
     {
       gfc_add_block_to_block (&block, &lse->pre);
       gfc_add_block_to_block (&block, &rse->pre);
-      /* ...otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR
-	 for the lhs which ensures that class data rhs cast as a string assigns
-	 correctly.  */
-      tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
-			     TREE_TYPE (rse->expr), lse->expr);
-      gfc_add_modify (&block, tmp, rse->expr);
+
+      if (!trans_scalar_class_assign (&block, lse, rse))
+	{
+	  /* ...otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR
+	  for the lhs which ensures that class data rhs cast as a string assigns
+	  correctly.  */
+	  tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+				 TREE_TYPE (rse->expr), lse->expr);
+	  gfc_add_modify (&block, tmp, rse->expr);
+	}
     }
   else if (ts.type != BT_CLASS)
     {

[-- Attachment #5: submit2.diff --]
[-- Type: text/x-patch, Size: 16056 bytes --]

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index be5eb89350f..ca90142530c 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1403,9 +1403,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
   desc = gfc_create_var (type, "atmp");
   GFC_DECL_PACKED_ARRAY (desc) = 1;

-  info->descriptor = desc;
-  size = gfc_index_one_node;
-
   /* Emit a DECL_EXPR for the variable sized array type in
      GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type
      sizes works correctly.  */
@@ -1416,9 +1413,40 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
   gfc_add_expr_to_block (pre, build1 (DECL_EXPR,
 				      arraytype, TYPE_NAME (arraytype)));

-  /* Fill in the array dtype.  */
-  tmp = gfc_conv_descriptor_dtype (desc);
-  gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+  if (class_expr != NULL_TREE)
+    {
+      tree class_data;
+      tree dtype;
+
+      /* Create a class temporary.  */
+      tmp = gfc_create_var (TREE_TYPE (class_expr), "ctmp");
+      gfc_add_modify (pre, tmp, class_expr);
+
+      /* Assign the new descriptor to the _data field. This allows the
+	 vptr _copy to be used for scalarized assignment since the class
+	 temporary can be found from the descriptor.  */
+      class_data = gfc_class_data_get (tmp);
+      tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+			     TREE_TYPE (desc), desc);
+      gfc_add_modify (pre, class_data, tmp);
+
+      /* Take the dtype from the class expression.  */
+      dtype = gfc_conv_descriptor_dtype (gfc_class_data_get (class_expr));
+      tmp = gfc_conv_descriptor_dtype (class_data);
+      gfc_add_modify (pre, tmp, dtype);
+
+      /* Point desc to the class _data field.  */
+      desc = class_data;
+    }
+  else
+    {
+      /* Fill in the array dtype.  */
+      tmp = gfc_conv_descriptor_dtype (desc);
+      gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+    }
+
+  info->descriptor = desc;
+  size = gfc_index_one_node;

   /*
      Fill in the bounds and stride.  This is a packed array, so:
@@ -3424,134 +3452,73 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
 static bool
 build_class_array_ref (gfc_se *se, tree base, tree index)
 {
-  tree type;
   tree size;
-  tree offset;
   tree decl = NULL_TREE;
   tree tmp;
   gfc_expr *expr = se->ss->info->expr;
-  gfc_ref *ref;
-  gfc_ref *class_ref = NULL;
+  gfc_expr *class_expr;
   gfc_typespec *ts;
+  gfc_symbol *sym;

-  if (se->expr && DECL_P (se->expr) && DECL_LANG_SPECIFIC (se->expr)
-      && GFC_DECL_SAVED_DESCRIPTOR (se->expr)
-      && GFC_CLASS_TYPE_P (TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (se->expr))))
-    decl = se->expr;
+  tmp = !VAR_P (base) ? gfc_get_class_from_expr (base) : NULL_TREE;
+
+  if (tmp != NULL_TREE)
+    decl = tmp;
   else
     {
-      if (expr == NULL
+      /* The base expression does not contain a class component, either
+	 because it is a temporary array or array descriptor.  Class
+	 array functions are correctly resolved above.  */
+      if (!expr
 	  || (expr->ts.type != BT_CLASS
-	      && !gfc_is_class_array_function (expr)
 	      && !gfc_is_class_array_ref (expr, NULL)))
 	return false;

-      if (expr->symtree && expr->symtree->n.sym->ts.type == BT_CLASS)
-	ts = &expr->symtree->n.sym->ts;
-      else
-	ts = NULL;
-
-      for (ref = expr->ref; ref; ref = ref->next)
-	{
-	  if (ref->type == REF_COMPONENT
-	      && ref->u.c.component->ts.type == BT_CLASS
-	      && ref->next && ref->next->type == REF_COMPONENT
-	      && strcmp (ref->next->u.c.component->name, "_data") == 0
-	      && ref->next->next
-	      && ref->next->next->type == REF_ARRAY
-	      && ref->next->next->u.ar.type != AR_ELEMENT)
-	    {
-	      ts = &ref->u.c.component->ts;
-	      class_ref = ref;
-	      break;
-	    }
-	}
+      /* Obtain the expression for the class entity or component that is
+	 followed by an array reference, which is not an element, so that
+	 the span of the array can be obtained.  */
+      class_expr = gfc_find_and_cut_at_last_class_ref (expr, false, &ts);

-      if (ts == NULL)
+      if (!ts)
 	return false;
-    }

-  if (class_ref == NULL && expr && expr->symtree->n.sym->attr.function
-      && expr->symtree->n.sym == expr->symtree->n.sym->result
-      && expr->symtree->n.sym->backend_decl == current_function_decl)
-    {
-      decl = gfc_get_fake_result_decl (expr->symtree->n.sym, 0);
-    }
-  else if (expr && gfc_is_class_array_function (expr))
-    {
-      size = NULL_TREE;
-      decl = NULL_TREE;
-      for (tmp = base; tmp; tmp = TREE_OPERAND (tmp, 0))
-	{
-	  tree type;
-	  type = TREE_TYPE (tmp);
-	  while (type)
-	    {
-	      if (GFC_CLASS_TYPE_P (type))
-		decl = tmp;
-	      if (type != TYPE_CANONICAL (type))
-		type = TYPE_CANONICAL (type);
-	      else
-		type = NULL_TREE;
-	    }
-	  if (VAR_P (tmp))
-	    break;
+      sym = (!class_expr && expr) ? expr->symtree->n.sym : NULL;
+      if (sym && sym->attr.function
+	  && sym == sym->result
+	  && sym->backend_decl == current_function_decl)
+	/* The temporary is the data field of the class data component
+	   of the current function.  */
+	decl = gfc_get_fake_result_decl (sym, 0);
+      else if (sym)
+	{
+	  if (decl == NULL_TREE)
+	    decl = expr->symtree->n.sym->backend_decl;
+	  /* For class arrays the tree containing the class is stored in
+	     GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl.
+	     For all others it's sym's backend_decl directly.  */
+	  if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl))
+	    decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
 	}
+      else
+	decl = gfc_get_class_from_gfc_expr (class_expr);

-      if (decl == NULL_TREE)
-	return false;
+      if (POINTER_TYPE_P (TREE_TYPE (decl)))
+	decl = build_fold_indirect_ref_loc (input_location, decl);

-      se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);
-    }
-  else if (class_ref == NULL)
-    {
-      if (decl == NULL_TREE)
-	decl = expr->symtree->n.sym->backend_decl;
-      /* For class arrays the tree containing the class is stored in
-	 GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl.
-	 For all others it's sym's backend_decl directly.  */
-      if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl))
-	decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
-    }
-  else
-    {
-      /* Remove everything after the last class reference, convert the
-	 expression and then recover its tailend once more.  */
-      gfc_se tmpse;
-      ref = class_ref->next;
-      class_ref->next = NULL;
-      gfc_init_se (&tmpse, NULL);
-      gfc_conv_expr (&tmpse, expr);
-      gfc_add_block_to_block (&se->pre, &tmpse.pre);
-      decl = tmpse.expr;
-      class_ref->next = ref;
+      if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
+	return false;
     }

-  if (POINTER_TYPE_P (TREE_TYPE (decl)))
-    decl = build_fold_indirect_ref_loc (input_location, decl);
-
-  if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
-    return false;
+  se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);

   size = gfc_class_vtab_size_get (decl);
-
   /* For unlimited polymorphic entities then _len component needs to be
      multiplied with the size.  */
   size = gfc_resize_class_size_with_len (&se->pre, decl, size);
-
   size = fold_convert (TREE_TYPE (index), size);

-  /* Build the address of the element.  */
-  type = TREE_TYPE (TREE_TYPE (base));
-  offset = fold_build2_loc (input_location, MULT_EXPR,
-			    gfc_array_index_type,
-			    index, size);
-  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);
-
   /* Return the element in the se expression.  */
-  se->expr = build_fold_indirect_ref_loc (input_location, tmp);
+  se->expr = gfc_build_spanned_array_ref (base, index, size);
   return true;
 }

@@ -10280,23 +10247,10 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
     }
   else if (expr1->ts.type == BT_CLASS)
     {
-      tmp = expr1->rank ? gfc_get_class_from_expr (desc) : NULL_TREE;
-      if (tmp == NULL_TREE)
-	tmp = gfc_get_class_from_gfc_expr (expr1);
-
-      if (tmp != NULL_TREE)
-	{
-	  tmp2 = gfc_class_vptr_get (tmp);
-	  cond = fold_build2_loc (input_location, NE_EXPR,
-				  logical_type_node, tmp2,
-				  build_int_cst (TREE_TYPE (tmp2), 0));
-	  elemsize1 = gfc_class_vtab_size_get (tmp);
-	  elemsize1 = fold_build3_loc (input_location, COND_EXPR,
-				      gfc_array_index_type, cond,
-				      elemsize1, gfc_index_zero_node);
-	}
-      else
-	elemsize1 = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&CLASS_DATA (expr1)->ts));
+      /* Unfortunately, the lhs vptr is set too early in many cases.
+	 Play it safe by using the descriptor element length.  */
+      tmp = gfc_conv_descriptor_elem_len (desc);
+      elemsize1 = fold_convert (gfc_array_index_type, tmp);
     }
   else
     elemsize1 = NULL_TREE;
@@ -10770,11 +10724,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,


   /* We already set the dtype in the case of deferred character
-     length arrays and unlimited polymorphic arrays.  */
+     length arrays and class lvalues.  */
   if (!(GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))
 	&& ((expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
 	    || coarray))
-      && !UNLIMITED_POLY (expr1))
+      && expr1->ts.type != BT_CLASS)
     {
       tmp = gfc_conv_descriptor_dtype (desc);
       gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc)));
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index f6ef5c023bf..2e4b4808e08 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -385,10 +385,13 @@ gfc_vptr_size_get (tree vptr)
    to class.c::gfc_add_component_ref (), is there a significant
    difference: gfc_add_component_ref () concentrates on an array ref to
    be the last ref in the chain.  This routine is oblivious to the kind
-   of refs following.  */
+   of refs following. If ts is non-null the cut is at the class entity
+   or component that is followed by an array reference, which is not
+   an element.  */

 gfc_expr *
-gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold)
+gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold,
+				    gfc_typespec **ts)
 {
   gfc_expr *base_expr;
   gfc_ref *ref, *class_ref, *tail = NULL, *array_ref;
@@ -396,8 +399,34 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold)
   /* Find the last class reference.  */
   class_ref = NULL;
   array_ref = NULL;
+
+  if (ts)
+    {
+      if (e->symtree
+	  && e->symtree->n.sym->ts.type == BT_CLASS)
+	*ts = &e->symtree->n.sym->ts;
+      else
+	*ts = NULL;
+    }
+
   for (ref = e->ref; ref; ref = ref->next)
     {
+      if (ts && ref->type == REF_COMPONENT
+	  && ref->u.c.component->ts.type == BT_CLASS
+	  && ref->next && ref->next->type == REF_COMPONENT
+	  && strcmp (ref->next->u.c.component->name, "_data") == 0
+	  && ref->next->next
+	  && ref->next->next->type == REF_ARRAY
+	  && ref->next->next->u.ar.type != AR_ELEMENT)
+	{
+	  *ts = &ref->u.c.component->ts;
+	  class_ref = ref;
+	  break;
+	}
+
+      if (ts && *ts == NULL)
+	return NULL;
+
       if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
 	array_ref = ref;

@@ -9983,17 +10012,20 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
       gfc_add_modify (&block, lse->expr, tmp);
     }
   /* If possible use the rhs vptr copy with trans_scalar_class_assign....  */
-  else if (ts.type == BT_CLASS
-	   && !trans_scalar_class_assign (&block, lse, rse))
+  else if (ts.type == BT_CLASS)
     {
       gfc_add_block_to_block (&block, &lse->pre);
       gfc_add_block_to_block (&block, &rse->pre);
-      /* ...otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR
-	 for the lhs which ensures that class data rhs cast as a string assigns
-	 correctly.  */
-      tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
-			     TREE_TYPE (rse->expr), lse->expr);
-      gfc_add_modify (&block, tmp, rse->expr);
+
+      if (!trans_scalar_class_assign (&block, lse, rse))
+	{
+	  /* ...otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR
+	  for the lhs which ensures that class data rhs cast as a string assigns
+	  correctly.  */
+	  tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+				 TREE_TYPE (rse->expr), lse->expr);
+	  gfc_add_modify (&block, tmp, rse->expr);
+	}
     }
   else if (ts.type != BT_CLASS)
     {
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ab53fc5f441..9e8e8619ff8 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,
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 44cbfb63f39..8c6f82ff1b1 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -424,7 +424,8 @@ tree gfc_class_vptr_get (tree);
 tree gfc_class_len_get (tree);
 tree gfc_class_len_or_zero_get (tree);
 tree gfc_resize_class_size_with_len (stmtblock_t *, tree, tree);
-gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *, bool is_mold = false);
+gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *, bool is_mold = false,
+					       gfc_typespec **ts = NULL);
 /* Get an accessor to the class' vtab's * field, when a class handle is
    available.  */
 tree gfc_class_vtab_hash_get (tree);
@@ -622,6 +623,9 @@ tree gfc_build_addr_expr (tree, tree);
 /* Build an ARRAY_REF.  */
 tree gfc_build_array_ref (tree, tree, tree, tree vptr = NULL_TREE);

+/* Build an array ref using pointer arithmetic.  */
+tree gfc_build_spanned_array_ref (tree base, tree offset, tree span);
+
 /* Creates a label.  Decl is artificial if label_id == NULL_TREE.  */
 tree gfc_build_label_decl (tree);

Re: [Patch, fortran] 99307 - FAIL: gfortran.dg/class_assign_4.f90 execution test

[Tobias Burnus]

Hi all,

as preremark I want to note that the testcase class_assign_4.f90
was added for PR83118/PR96012 (fixes problems in handling class objects, Dec 18, 2020)
and got revised for PR99124 (class defined operators, Feb 23, 2021).
Both patches were then also applied to GCC 9 and 10.

On 26.03.21 17:30, Paul Richard Thomas via Gcc-patches wrote:
> This patch comes in two versions: submit.diff with Change.Logs or
> submit2.diff with Change2.Logs.
> The first fixes the problem by changing array temporaries from class
> expressions into class temporaries. This permits the use of
> gfc_get_class_from_expr to obtain the vptr for these temporaries and all
> the good things that come with that when handling dynamic types. The second
> part of the fix is to use the array element length from the class
> descriptor, when reallocating on assignment. This is needed because the
> vptr is being set too early. I will set about trying to track down why this
> is happening and fix it after release.
>
> The second version does the same as the first but puts in place a load of
> tidying up that is permitted by the fix to class array temporaries.

> I couldn't readily see how to prepare a testcase - ideas?
> Both regtest on FC33/x86_64. The first was tested by Dominique (see the
> PR). OK for master?

Typo – underscore-'c' should be a dot-'c' – both changelog files

>       * trans-expr_c (gfc_trans_scalar_assign): Make use of pre and

I think the second longer version is nicer in general, but at least for
GCC 9/GCC10 the first version is simpler and, hence, less error prone.

As you only ask about mainline, I would prefer the second one.

However, I am not happy about gfc_find_and_cut_at_last_class_ref:

> + of refs following. If ts is non-null the cut is at the class entity
> + or component that is followed by an array reference, which is not +
> an element. */ ... + + if (ts) + { + if (e->symtree + &&
> e->symtree->n.sym->ts.type == BT_CLASS) + *ts =
> &e->symtree->n.sym->ts; + else + *ts = NULL; + } + for (ref = e->ref;
> ref; ref = ref->next) { + if (ts && ref->type == REF_COMPONENT + &&
> ref->u.c.component->ts.type == BT_CLASS + && ref->next &&
> ref->next->type == REF_COMPONENT + && strcmp
> (ref->next->u.c.component->name, "_data") == 0 + && ref->next->next +
> && ref->next->next->type == REF_ARRAY + && ref->next->next->u.ar.type
> != AR_ELEMENT) + { + *ts = &ref->u.c.component->ts; + class_ref = ref;
> + break; + } + + if (ts && *ts == NULL) + return NULL; +
Namely, if there is:
   type1%array_class2 → array_class2 is used for 'ts' and later (ok)
   type1%type%array_class2 → NULL is returned  (why?)
   class1%type%array_class2 → ts = class1 but array2_class is used later on (ups!)
   class1%...%scalar_class2 → ts = class1 but scalar_class2 is used
etc.

Thus this either needs to be cleaned up (separate 'ref' loop for
ts != NULL) – including the wording in the description which tells what
happens if 'ts' is passed as arg but the expr has rank == 0 – and
what value is assigned to 'ts'. (You can then also fix 'class.c::' to
'class.c: ' in the description above the function.)

Alternatively, you can leave the current code ref handling code in place
at build_class_array_ref, which might be the simpler alternative.

Otherwise, it looks sensible to me.

Tobias

-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf

Re: [Patch, fortran] 99307 - FAIL: gfortran.dg/class_assign_4.f90 execution test

[Paul Richard Thomas]

Hi Tobias,

I believe that the attached fixes the problems that you found with
gfc_find_and_cut_at_last_class_ref.

I will test:
   type1%type%array_class2 → NULL is returned  (why?)
   class1%type%array_class2 → ts = class1 but array2_class is used later on
(ups!)
   class1%...%scalar_class2 → ts = class1 but scalar_class2 is used

The ChangeLogs remain the same, apart from the date.

Regtests OK on FC33/x86_64.

Paul


On Mon, 29 Mar 2021 at 14:58, Tobias Burnus <tobias@codesourcery.com> wrote:

> Hi all,
>
> as preremark I want to note that the testcase class_assign_4.f90
> was added for PR83118/PR96012 (fixes problems in handling class objects,
> Dec 18, 2020)
> and got revised for PR99124 (class defined operators, Feb 23, 2021).
> Both patches were then also applied to GCC 9 and 10.
>
> On 26.03.21 17:30, Paul Richard Thomas via Gcc-patches wrote:
> > This patch comes in two versions: submit.diff with Change.Logs or
> > submit2.diff with Change2.Logs.
> > The first fixes the problem by changing array temporaries from class
> > expressions into class temporaries. This permits the use of
> > gfc_get_class_from_expr to obtain the vptr for these temporaries and all
> > the good things that come with that when handling dynamic types. The
> second
> > part of the fix is to use the array element length from the class
> > descriptor, when reallocating on assignment. This is needed because the
> > vptr is being set too early. I will set about trying to track down why
> this
> > is happening and fix it after release.
> >
> > The second version does the same as the first but puts in place a load of
> > tidying up that is permitted by the fix to class array temporaries.
>
> > I couldn't readily see how to prepare a testcase - ideas?
> > Both regtest on FC33/x86_64. The first was tested by Dominique (see the
> > PR). OK for master?
>
> Typo – underscore-'c' should be a dot-'c' – both changelog files
>
> >       * trans-expr_c (gfc_trans_scalar_assign): Make use of pre and
>
> I think the second longer version is nicer in general, but at least for
> GCC 9/GCC10 the first version is simpler and, hence, less error prone.
>
> As you only ask about mainline, I would prefer the second one.
>
> However, I am not happy about gfc_find_and_cut_at_last_class_ref:
>
> > + of refs following. If ts is non-null the cut is at the class entity
> > + or component that is followed by an array reference, which is not +
> > an element. */ ... + + if (ts) + { + if (e->symtree + &&
> > e->symtree->n.sym->ts.type == BT_CLASS) + *ts =
> > &e->symtree->n.sym->ts; + else + *ts = NULL; + } + for (ref = e->ref;
> > ref; ref = ref->next) { + if (ts && ref->type == REF_COMPONENT + &&
> > ref->u.c.component->ts.type == BT_CLASS + && ref->next &&
> > ref->next->type == REF_COMPONENT + && strcmp
> > (ref->next->u.c.component->name, "_data") == 0 + && ref->next->next +
> > && ref->next->next->type == REF_ARRAY + && ref->next->next->u.ar.type
> > != AR_ELEMENT) + { + *ts = &ref->u.c.component->ts; + class_ref = ref;
> > + break; + } + + if (ts && *ts == NULL) + return NULL; +
> Namely, if there is:
>    type1%array_class2 → array_class2 is used for 'ts' and later (ok)
>    type1%type%array_class2 → NULL is returned  (why?)
>    class1%type%array_class2 → ts = class1 but array2_class is used later
> on (ups!)
>    class1%...%scalar_class2 → ts = class1 but scalar_class2 is used
> etc.
>
> Thus this either needs to be cleaned up (separate 'ref' loop for
> ts != NULL) – including the wording in the description which tells what
> happens if 'ts' is passed as arg but the expr has rank == 0 – and
> what value is assigned to 'ts'. (You can then also fix 'class.c::' to
> 'class.c: ' in the description above the function.)
>
> Alternatively, you can leave the current code ref handling code in place
> at build_class_array_ref, which might be the simpler alternative.
>
> Otherwise, it looks sensible to me.
>
> Tobias
>
> -----------------
> Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München
> Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank
> Thürauf
>


-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

Re: [Patch, fortran] 99307 - FAIL: gfortran.dg/class_assign_4.f90 execution test

[Tobias Burnus]

Dear Paul,

sorry for the belate reply. I think you forgot to attach the patch.

Tobias

On 06.04.21 19:08, Paul Richard Thomas via Fortran wrote:
> Hi Tobias,
>
> I believe that the attached fixes the problems that you found with
> gfc_find_and_cut_at_last_class_ref.
>
> I will test:
>     type1%type%array_class2 → NULL is returned  (why?)
>     class1%type%array_class2 → ts = class1 but array2_class is used later on
> (ups!)
>     class1%...%scalar_class2 → ts = class1 but scalar_class2 is used
>
> The ChangeLogs remain the same, apart from the date.
>
> Regtests OK on FC33/x86_64.
>
> Paul
>
>
> On Mon, 29 Mar 2021 at 14:58, Tobias Burnus <tobias@codesourcery.com> wrote:
>
>> Hi all,
>>
>> as preremark I want to note that the testcase class_assign_4.f90
>> was added for PR83118/PR96012 (fixes problems in handling class objects,
>> Dec 18, 2020)
>> and got revised for PR99124 (class defined operators, Feb 23, 2021).
>> Both patches were then also applied to GCC 9 and 10.
>>
>> On 26.03.21 17:30, Paul Richard Thomas via Gcc-patches wrote:
>>> This patch comes in two versions: submit.diff with Change.Logs or
>>> submit2.diff with Change2.Logs.
>>> The first fixes the problem by changing array temporaries from class
>>> expressions into class temporaries. This permits the use of
>>> gfc_get_class_from_expr to obtain the vptr for these temporaries and all
>>> the good things that come with that when handling dynamic types. The
>> second
>>> part of the fix is to use the array element length from the class
>>> descriptor, when reallocating on assignment. This is needed because the
>>> vptr is being set too early. I will set about trying to track down why
>> this
>>> is happening and fix it after release.
>>>
>>> The second version does the same as the first but puts in place a load of
>>> tidying up that is permitted by the fix to class array temporaries.
>>> I couldn't readily see how to prepare a testcase - ideas?
>>> Both regtest on FC33/x86_64. The first was tested by Dominique (see the
>>> PR). OK for master?
>> Typo – underscore-'c' should be a dot-'c' – both changelog files
>>
>>>        * trans-expr_c (gfc_trans_scalar_assign): Make use of pre and
>> I think the second longer version is nicer in general, but at least for
>> GCC 9/GCC10 the first version is simpler and, hence, less error prone.
>>
>> As you only ask about mainline, I would prefer the second one.
>>
>> However, I am not happy about gfc_find_and_cut_at_last_class_ref:
>>
>>> + of refs following. If ts is non-null the cut is at the class entity
>>> + or component that is followed by an array reference, which is not +
>>> an element. */ ... + + if (ts) + { + if (e->symtree + &&
>>> e->symtree->n.sym->ts.type == BT_CLASS) + *ts =
>>> &e->symtree->n.sym->ts; + else + *ts = NULL; + } + for (ref = e->ref;
>>> ref; ref = ref->next) { + if (ts && ref->type == REF_COMPONENT + &&
>>> ref->u.c.component->ts.type == BT_CLASS + && ref->next &&
>>> ref->next->type == REF_COMPONENT + && strcmp
>>> (ref->next->u.c.component->name, "_data") == 0 + && ref->next->next +
>>> && ref->next->next->type == REF_ARRAY + && ref->next->next->u.ar.type
>>> != AR_ELEMENT) + { + *ts = &ref->u.c.component->ts; + class_ref = ref;
>>> + break; + } + + if (ts && *ts == NULL) + return NULL; +
>> Namely, if there is:
>>     type1%array_class2 → array_class2 is used for 'ts' and later (ok)
>>     type1%type%array_class2 → NULL is returned  (why?)
>>     class1%type%array_class2 → ts = class1 but array2_class is used later
>> on (ups!)
>>     class1%...%scalar_class2 → ts = class1 but scalar_class2 is used
>> etc.
>>
>> Thus this either needs to be cleaned up (separate 'ref' loop for
>> ts != NULL) – including the wording in the description which tells what
>> happens if 'ts' is passed as arg but the expr has rank == 0 – and
>> what value is assigned to 'ts'. (You can then also fix 'class.c::' to
>> 'class.c: ' in the description above the function.)
>>
>> Alternatively, you can leave the current code ref handling code in place
>> at build_class_array_ref, which might be the simpler alternative.
>>
>> Otherwise, it looks sensible to me.
>>
>> Tobias
>>
>> -----------------
>> Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München
>> Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank
>> Thürauf
>>
>

Re: [Patch, fortran] 99307 - FAIL: gfortran.dg/class_assign_4.f90 execution test

[Paul Richard Thomas]

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

Tobias noticed a major technical fault with the resubmission below: I
forgot to attach the patch :-(

Please find it attached this time.

Paul

On Tue, 6 Apr 2021 at 18:08, Paul Richard Thomas <
paul.richard.thomas@gmail.com> wrote:

> Hi Tobias,
>
> I believe that the attached fixes the problems that you found with
> gfc_find_and_cut_at_last_class_ref.
>
> I will test:
>    type1%type%array_class2 → NULL is returned  (why?)
>    class1%type%array_class2 → ts = class1 but array2_class is used later
> on (ups!)
>    class1%...%scalar_class2 → ts = class1 but scalar_class2 is used
>
> The ChangeLogs remain the same, apart from the date.
>
> Regtests OK on FC33/x86_64.
>
> Paul
>
>
> On Mon, 29 Mar 2021 at 14:58, Tobias Burnus <tobias@codesourcery.com>
> wrote:
>
>> Hi all,
>>
>> as preremark I want to note that the testcase class_assign_4.f90
>> was added for PR83118/PR96012 (fixes problems in handling class objects,
>> Dec 18, 2020)
>> and got revised for PR99124 (class defined operators, Feb 23, 2021).
>> Both patches were then also applied to GCC 9 and 10.
>>
>> On 26.03.21 17:30, Paul Richard Thomas via Gcc-patches wrote:
>> > This patch comes in two versions: submit.diff with Change.Logs or
>> > submit2.diff with Change2.Logs.
>> > The first fixes the problem by changing array temporaries from class
>> > expressions into class temporaries. This permits the use of
>> > gfc_get_class_from_expr to obtain the vptr for these temporaries and all
>> > the good things that come with that when handling dynamic types. The
>> second
>> > part of the fix is to use the array element length from the class
>> > descriptor, when reallocating on assignment. This is needed because the
>> > vptr is being set too early. I will set about trying to track down why
>> this
>> > is happening and fix it after release.
>> >
>> > The second version does the same as the first but puts in place a load
>> of
>> > tidying up that is permitted by the fix to class array temporaries.
>>
>> > I couldn't readily see how to prepare a testcase - ideas?
>> > Both regtest on FC33/x86_64. The first was tested by Dominique (see the
>> > PR). OK for master?
>>
>> Typo – underscore-'c' should be a dot-'c' – both changelog files
>>
>> >       * trans-expr_c (gfc_trans_scalar_assign): Make use of pre and
>>
>> I think the second longer version is nicer in general, but at least for
>> GCC 9/GCC10 the first version is simpler and, hence, less error prone.
>>
>> As you only ask about mainline, I would prefer the second one.
>>
>> However, I am not happy about gfc_find_and_cut_at_last_class_ref:
>>
>> > + of refs following. If ts is non-null the cut is at the class entity
>> > + or component that is followed by an array reference, which is not +
>> > an element. */ ... + + if (ts) + { + if (e->symtree + &&
>> > e->symtree->n.sym->ts.type == BT_CLASS) + *ts =
>> > &e->symtree->n.sym->ts; + else + *ts = NULL; + } + for (ref = e->ref;
>> > ref; ref = ref->next) { + if (ts && ref->type == REF_COMPONENT + &&
>> > ref->u.c.component->ts.type == BT_CLASS + && ref->next &&
>> > ref->next->type == REF_COMPONENT + && strcmp
>> > (ref->next->u.c.component->name, "_data") == 0 + && ref->next->next +
>> > && ref->next->next->type == REF_ARRAY + && ref->next->next->u.ar.type
>> > != AR_ELEMENT) + { + *ts = &ref->u.c.component->ts; + class_ref = ref;
>> > + break; + } + + if (ts && *ts == NULL) + return NULL; +
>> Namely, if there is:
>>    type1%array_class2 → array_class2 is used for 'ts' and later (ok)
>>    type1%type%array_class2 → NULL is returned  (why?)
>>    class1%type%array_class2 → ts = class1 but array2_class is used later
>> on (ups!)
>>    class1%...%scalar_class2 → ts = class1 but scalar_class2 is used
>> etc.
>>
>> Thus this either needs to be cleaned up (separate 'ref' loop for
>> ts != NULL) – including the wording in the description which tells what
>> happens if 'ts' is passed as arg but the expr has rank == 0 – and
>> what value is assigned to 'ts'. (You can then also fix 'class.c::' to
>> 'class.c: ' in the description above the function.)
>>
>> Alternatively, you can leave the current code ref handling code in place
>> at build_class_array_ref, which might be the simpler alternative.
>>
>> Otherwise, it looks sensible to me.
>>
>> Tobias
>>
>> -----------------
>> Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München
>> Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank
>> Thürauf
>>
>
>
> --
> "If you can't explain it simply, you don't understand it well enough" -
> Albert Einstein
>


-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

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

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index be5eb89350f..ca90142530c 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1403,9 +1403,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
   desc = gfc_create_var (type, "atmp");
   GFC_DECL_PACKED_ARRAY (desc) = 1;
 
-  info->descriptor = desc;
-  size = gfc_index_one_node;
-
   /* Emit a DECL_EXPR for the variable sized array type in
      GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type
      sizes works correctly.  */
@@ -1416,9 +1413,40 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
   gfc_add_expr_to_block (pre, build1 (DECL_EXPR,
 				      arraytype, TYPE_NAME (arraytype)));
 
-  /* Fill in the array dtype.  */
-  tmp = gfc_conv_descriptor_dtype (desc);
-  gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+  if (class_expr != NULL_TREE)
+    {
+      tree class_data;
+      tree dtype;
+
+      /* Create a class temporary.  */
+      tmp = gfc_create_var (TREE_TYPE (class_expr), "ctmp");
+      gfc_add_modify (pre, tmp, class_expr);
+
+      /* Assign the new descriptor to the _data field. This allows the
+	 vptr _copy to be used for scalarized assignment since the class
+	 temporary can be found from the descriptor.  */
+      class_data = gfc_class_data_get (tmp);
+      tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+			     TREE_TYPE (desc), desc);
+      gfc_add_modify (pre, class_data, tmp);
+
+      /* Take the dtype from the class expression.  */
+      dtype = gfc_conv_descriptor_dtype (gfc_class_data_get (class_expr));
+      tmp = gfc_conv_descriptor_dtype (class_data);
+      gfc_add_modify (pre, tmp, dtype);
+
+      /* Point desc to the class _data field.  */
+      desc = class_data;
+    }
+  else
+    {
+      /* Fill in the array dtype.  */
+      tmp = gfc_conv_descriptor_dtype (desc);
+      gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+    }
+
+  info->descriptor = desc;
+  size = gfc_index_one_node;
 
   /*
      Fill in the bounds and stride.  This is a packed array, so:
@@ -3424,134 +3452,73 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
 static bool
 build_class_array_ref (gfc_se *se, tree base, tree index)
 {
-  tree type;
   tree size;
-  tree offset;
   tree decl = NULL_TREE;
   tree tmp;
   gfc_expr *expr = se->ss->info->expr;
-  gfc_ref *ref;
-  gfc_ref *class_ref = NULL;
+  gfc_expr *class_expr;
   gfc_typespec *ts;
+  gfc_symbol *sym;
 
-  if (se->expr && DECL_P (se->expr) && DECL_LANG_SPECIFIC (se->expr)
-      && GFC_DECL_SAVED_DESCRIPTOR (se->expr)
-      && GFC_CLASS_TYPE_P (TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (se->expr))))
-    decl = se->expr;
+  tmp = !VAR_P (base) ? gfc_get_class_from_expr (base) : NULL_TREE;
+
+  if (tmp != NULL_TREE)
+    decl = tmp;
   else
     {
-      if (expr == NULL
+      /* The base expression does not contain a class component, either
+	 because it is a temporary array or array descriptor.  Class
+	 array functions are correctly resolved above.  */
+      if (!expr
 	  || (expr->ts.type != BT_CLASS
-	      && !gfc_is_class_array_function (expr)
 	      && !gfc_is_class_array_ref (expr, NULL)))
 	return false;
 
-      if (expr->symtree && expr->symtree->n.sym->ts.type == BT_CLASS)
-	ts = &expr->symtree->n.sym->ts;
-      else
-	ts = NULL;
-
-      for (ref = expr->ref; ref; ref = ref->next)
-	{
-	  if (ref->type == REF_COMPONENT
-	      && ref->u.c.component->ts.type == BT_CLASS
-	      && ref->next && ref->next->type == REF_COMPONENT
-	      && strcmp (ref->next->u.c.component->name, "_data") == 0
-	      && ref->next->next
-	      && ref->next->next->type == REF_ARRAY
-	      && ref->next->next->u.ar.type != AR_ELEMENT)
-	    {
-	      ts = &ref->u.c.component->ts;
-	      class_ref = ref;
-	      break;
-	    }
-	}
+      /* Obtain the expression for the class entity or component that is
+	 followed by an array reference, which is not an element, so that
+	 the span of the array can be obtained.  */
+      class_expr = gfc_find_and_cut_at_last_class_ref (expr, false, &ts);
 
-      if (ts == NULL)
+      if (!ts)
 	return false;
-    }
 
-  if (class_ref == NULL && expr && expr->symtree->n.sym->attr.function
-      && expr->symtree->n.sym == expr->symtree->n.sym->result
-      && expr->symtree->n.sym->backend_decl == current_function_decl)
-    {
-      decl = gfc_get_fake_result_decl (expr->symtree->n.sym, 0);
-    }
-  else if (expr && gfc_is_class_array_function (expr))
-    {
-      size = NULL_TREE;
-      decl = NULL_TREE;
-      for (tmp = base; tmp; tmp = TREE_OPERAND (tmp, 0))
-	{
-	  tree type;
-	  type = TREE_TYPE (tmp);
-	  while (type)
-	    {
-	      if (GFC_CLASS_TYPE_P (type))
-		decl = tmp;
-	      if (type != TYPE_CANONICAL (type))
-		type = TYPE_CANONICAL (type);
-	      else
-		type = NULL_TREE;
-	    }
-	  if (VAR_P (tmp))
-	    break;
+      sym = (!class_expr && expr) ? expr->symtree->n.sym : NULL;
+      if (sym && sym->attr.function
+	  && sym == sym->result
+	  && sym->backend_decl == current_function_decl)
+	/* The temporary is the data field of the class data component
+	   of the current function.  */
+	decl = gfc_get_fake_result_decl (sym, 0);
+      else if (sym)
+	{
+	  if (decl == NULL_TREE)
+	    decl = expr->symtree->n.sym->backend_decl;
+	  /* For class arrays the tree containing the class is stored in
+	     GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl.
+	     For all others it's sym's backend_decl directly.  */
+	  if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl))
+	    decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
 	}
+      else
+	decl = gfc_get_class_from_gfc_expr (class_expr);
 
-      if (decl == NULL_TREE)
-	return false;
+      if (POINTER_TYPE_P (TREE_TYPE (decl)))
+	decl = build_fold_indirect_ref_loc (input_location, decl);
 
-      se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);
-    }
-  else if (class_ref == NULL)
-    {
-      if (decl == NULL_TREE)
-	decl = expr->symtree->n.sym->backend_decl;
-      /* For class arrays the tree containing the class is stored in
-	 GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl.
-	 For all others it's sym's backend_decl directly.  */
-      if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl))
-	decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
-    }
-  else
-    {
-      /* Remove everything after the last class reference, convert the
-	 expression and then recover its tailend once more.  */
-      gfc_se tmpse;
-      ref = class_ref->next;
-      class_ref->next = NULL;
-      gfc_init_se (&tmpse, NULL);
-      gfc_conv_expr (&tmpse, expr);
-      gfc_add_block_to_block (&se->pre, &tmpse.pre);
-      decl = tmpse.expr;
-      class_ref->next = ref;
+      if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
+	return false;
     }
 
-  if (POINTER_TYPE_P (TREE_TYPE (decl)))
-    decl = build_fold_indirect_ref_loc (input_location, decl);
-
-  if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
-    return false;
+  se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);
 
   size = gfc_class_vtab_size_get (decl);
-
   /* For unlimited polymorphic entities then _len component needs to be
      multiplied with the size.  */
   size = gfc_resize_class_size_with_len (&se->pre, decl, size);
-
   size = fold_convert (TREE_TYPE (index), size);
 
-  /* Build the address of the element.  */
-  type = TREE_TYPE (TREE_TYPE (base));
-  offset = fold_build2_loc (input_location, MULT_EXPR,
-			    gfc_array_index_type,
-			    index, size);
-  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);
-
   /* Return the element in the se expression.  */
-  se->expr = build_fold_indirect_ref_loc (input_location, tmp);
+  se->expr = gfc_build_spanned_array_ref (base, index, size);
   return true;
 }
 
@@ -10280,23 +10247,10 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
     }
   else if (expr1->ts.type == BT_CLASS)
     {
-      tmp = expr1->rank ? gfc_get_class_from_expr (desc) : NULL_TREE;
-      if (tmp == NULL_TREE)
-	tmp = gfc_get_class_from_gfc_expr (expr1);
-
-      if (tmp != NULL_TREE)
-	{
-	  tmp2 = gfc_class_vptr_get (tmp);
-	  cond = fold_build2_loc (input_location, NE_EXPR,
-				  logical_type_node, tmp2,
-				  build_int_cst (TREE_TYPE (tmp2), 0));
-	  elemsize1 = gfc_class_vtab_size_get (tmp);
-	  elemsize1 = fold_build3_loc (input_location, COND_EXPR,
-				      gfc_array_index_type, cond,
-				      elemsize1, gfc_index_zero_node);
-	}
-      else
-	elemsize1 = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&CLASS_DATA (expr1)->ts));
+      /* Unfortunately, the lhs vptr is set too early in many cases.
+	 Play it safe by using the descriptor element length.  */
+      tmp = gfc_conv_descriptor_elem_len (desc);
+      elemsize1 = fold_convert (gfc_array_index_type, tmp);
     }
   else
     elemsize1 = NULL_TREE;
@@ -10770,11 +10724,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 
 
   /* We already set the dtype in the case of deferred character
-     length arrays and unlimited polymorphic arrays.  */
+     length arrays and class lvalues.  */
   if (!(GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))
 	&& ((expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
 	    || coarray))
-      && !UNLIMITED_POLY (expr1))
+      && expr1->ts.type != BT_CLASS)
     {
       tmp = gfc_conv_descriptor_dtype (desc);
       gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc)));
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 2fa17b36c03..213f32b0a67 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -380,15 +380,20 @@ gfc_vptr_size_get (tree vptr)
 #undef VTABLE_FINAL_FIELD
 
 
-/* Search for the last _class ref in the chain of references of this
-   expression and cut the chain there.  Albeit this routine is similiar
-   to class.c::gfc_add_component_ref (), is there a significant
-   difference: gfc_add_component_ref () concentrates on an array ref to
-   be the last ref in the chain.  This routine is oblivious to the kind
-   of refs following.  */
+/* IF ts is null (default), search for the last _class ref in the chain
+   of references of the expression and cut the chain there.  Although
+   this routine is similiar to class.c:gfc_add_component_ref (), there
+   is a significant difference: gfc_add_component_ref () concentrates
+   on an array ref that is the last ref in the chain and is oblivious
+   to the kind of refs following.
+   ELSE IF ts is non-null the cut is at the class entity or component
+   that is followed by an array reference, which is not an element.
+   These calls come from trans-array.c:build_class_array_ref, which
+   handles scalarized class array references.*/
 
 gfc_expr *
-gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold)
+gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold,
+				    gfc_typespec **ts)
 {
   gfc_expr *base_expr;
   gfc_ref *ref, *class_ref, *tail = NULL, *array_ref;
@@ -396,27 +401,59 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold)
   /* Find the last class reference.  */
   class_ref = NULL;
   array_ref = NULL;
-  for (ref = e->ref; ref; ref = ref->next)
+
+  if (ts)
     {
-      if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
-	array_ref = ref;
+      if (e->symtree
+	  && e->symtree->n.sym->ts.type == BT_CLASS)
+	*ts = &e->symtree->n.sym->ts;
+      else
+	*ts = NULL;
+    }
 
-      if (ref->type == REF_COMPONENT
-	  && ref->u.c.component->ts.type == BT_CLASS)
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      if (ts)
 	{
-	  /* Component to the right of a part reference with nonzero rank
-	     must not have the ALLOCATABLE attribute.  If attempts are
-	     made to reference such a component reference, an error results
-	     followed by an ICE.  */
-	  if (array_ref && CLASS_DATA (ref->u.c.component)->attr.allocatable)
-	    return NULL;
-	  class_ref = ref;
+	  if (ref->type == REF_COMPONENT
+	      && ref->u.c.component->ts.type == BT_CLASS
+	      && ref->next && ref->next->type == REF_COMPONENT
+	      && !strcmp (ref->next->u.c.component->name, "_data")
+	      && ref->next->next
+	      && ref->next->next->type == REF_ARRAY
+	      && ref->next->next->u.ar.type != AR_ELEMENT)
+	    {
+	      *ts = &ref->u.c.component->ts;
+	      class_ref = ref;
+	      break;
+	    }
+
+	  if (ref->next == NULL)
+	    break;
 	}
+      else
+	{
+	  if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
+	    array_ref = ref;
 
-      if (ref->next == NULL)
-	break;
+	  if (ref->type == REF_COMPONENT
+	      && ref->u.c.component->ts.type == BT_CLASS)
+	    {
+	      /* Component to the right of a part reference with nonzero
+		 rank must not have the ALLOCATABLE attribute.  If attempts
+		 are made to reference such a component reference, an error
+		 results followed by an ICE.  */
+	      if (array_ref
+		  && CLASS_DATA (ref->u.c.component)->attr.allocatable)
+		return NULL;
+	      class_ref = ref;
+	    }
+	}
     }
 
+  if (ts && *ts == NULL)
+    return NULL;
+
   /* Remove and store all subsequent references after the
      CLASS reference.  */
   if (class_ref)
@@ -10005,17 +10042,20 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
       gfc_add_modify (&block, lse->expr, tmp);
     }
   /* If possible use the rhs vptr copy with trans_scalar_class_assign....  */
-  else if (ts.type == BT_CLASS
-	   && !trans_scalar_class_assign (&block, lse, rse))
+  else if (ts.type == BT_CLASS)
     {
       gfc_add_block_to_block (&block, &lse->pre);
       gfc_add_block_to_block (&block, &rse->pre);
-      /* ...otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR
-	 for the lhs which ensures that class data rhs cast as a string assigns
-	 correctly.  */
-      tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
-			     TREE_TYPE (rse->expr), lse->expr);
-      gfc_add_modify (&block, tmp, rse->expr);
+
+      if (!trans_scalar_class_assign (&block, lse, rse))
+	{
+	  /* ...otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR
+	  for the lhs which ensures that class data rhs cast as a string assigns
+	  correctly.  */
+	  tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+				 TREE_TYPE (rse->expr), lse->expr);
+	  gfc_add_modify (&block, tmp, rse->expr);
+	}
     }
   else if (ts.type != BT_CLASS)
     {
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ab53fc5f441..9e8e8619ff8 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,
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 44cbfb63f39..8c6f82ff1b1 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -424,7 +424,8 @@ tree gfc_class_vptr_get (tree);
 tree gfc_class_len_get (tree);
 tree gfc_class_len_or_zero_get (tree);
 tree gfc_resize_class_size_with_len (stmtblock_t *, tree, tree);
-gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *, bool is_mold = false);
+gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *, bool is_mold = false,
+					       gfc_typespec **ts = NULL);
 /* Get an accessor to the class' vtab's * field, when a class handle is
    available.  */
 tree gfc_class_vtab_hash_get (tree);
@@ -622,6 +623,9 @@ tree gfc_build_addr_expr (tree, tree);
 /* Build an ARRAY_REF.  */
 tree gfc_build_array_ref (tree, tree, tree, tree vptr = NULL_TREE);
 
+/* Build an array ref using pointer arithmetic.  */
+tree gfc_build_spanned_array_ref (tree base, tree offset, tree span);
+
 /* Creates a label.  Decl is artificial if label_id == NULL_TREE.  */
 tree gfc_build_label_decl (tree);
 

Re: [Patch, fortran] 99307 - FAIL: gfortran.dg/class_assign_4.f90 execution test

[Tobias Burnus]

On 11.04.21 09:05, Paul Richard Thomas wrote:
> Tobias noticed a major technical fault with the resubmission below: I
> forgot to attach the patch :-(

LGTM. Plus as remarked in the first review: 'trans-expr_c' typo needs to
be fixed (ChangeLog).

Tobias

>
> Please find it attached this time.
>
> Paul
>
> On Tue, 6 Apr 2021 at 18:08, Paul Richard Thomas
> <paul.richard.thomas@gmail.com <mailto:paul.richard.thomas@gmail.com>>
> wrote:
>
>     Hi Tobias,
>
>     I believe that the attached fixes the problems that you found with
>     gfc_find_and_cut_at_last_class_ref.
>
>     I will test:
>        type1%type%array_class2 → NULL is returned  (why?)
>        class1%type%array_class2 → ts = class1 but array2_class is used
>     later on (ups!)
>        class1%...%scalar_class2 → ts = class1 but scalar_class2 is used
>
>     The ChangeLogs remain the same, apart from the date.
>
>     Regtests OK on FC33/x86_64.
>
>     Paul
>
>
>     On Mon, 29 Mar 2021 at 14:58, Tobias Burnus
>     <tobias@codesourcery.com <mailto:tobias@codesourcery.com>> wrote:
>
>         Hi all,
>
>         as preremark I want to note that the testcase class_assign_4.f90
>         was added for PR83118/PR96012 (fixes problems in handling
>         class objects, Dec 18, 2020)
>         and got revised for PR99124 (class defined operators, Feb 23,
>         2021).
>         Both patches were then also applied to GCC 9 and 10.
>
>         On 26.03.21 17:30, Paul Richard Thomas via Gcc-patches wrote:
>         > This patch comes in two versions: submit.diff with
>         Change.Logs or
>         > submit2.diff with Change2.Logs.
>         > The first fixes the problem by changing array temporaries
>         from class
>         > expressions into class temporaries. This permits the use of
>         > gfc_get_class_from_expr to obtain the vptr for these
>         temporaries and all
>         > the good things that come with that when handling dynamic
>         types. The second
>         > part of the fix is to use the array element length from the
>         class
>         > descriptor, when reallocating on assignment. This is needed
>         because the
>         > vptr is being set too early. I will set about trying to
>         track down why this
>         > is happening and fix it after release.
>         >
>         > The second version does the same as the first but puts in
>         place a load of
>         > tidying up that is permitted by the fix to class array
>         temporaries.
>
>         > I couldn't readily see how to prepare a testcase - ideas?
>         > Both regtest on FC33/x86_64. The first was tested by
>         Dominique (see the
>         > PR). OK for master?
>
>         Typo – underscore-'c' should be a dot-'c' – both changelog files
>
>         >       * trans-expr_c (gfc_trans_scalar_assign): Make use of
>         pre and
>
>         I think the second longer version is nicer in general, but at
>         least for
>         GCC 9/GCC10 the first version is simpler and, hence, less
>         error prone.
>
>         As you only ask about mainline, I would prefer the second one.
>
>         However, I am not happy about gfc_find_and_cut_at_last_class_ref:
>
>         > + of refs following. If ts is non-null the cut is at the
>         class entity
>         > + or component that is followed by an array reference, which
>         is not +
>         > an element. */ ... + + if (ts) + { + if (e->symtree + &&
>         > e->symtree->n.sym->ts.type == BT_CLASS) + *ts =
>         > &e->symtree->n.sym->ts; + else + *ts = NULL; + } + for (ref
>         = e->ref;
>         > ref; ref = ref->next) { + if (ts && ref->type ==
>         REF_COMPONENT + &&
>         > ref->u.c.component->ts.type == BT_CLASS + && ref->next &&
>         > ref->next->type == REF_COMPONENT + && strcmp
>         > (ref->next->u.c.component->name, "_data") == 0 + &&
>         ref->next->next +
>         > && ref->next->next->type == REF_ARRAY + &&
>         ref->next->next->u.ar.type
>         > != AR_ELEMENT) + { + *ts = &ref->u.c.component->ts; +
>         class_ref = ref;
>         > + break; + } + + if (ts && *ts == NULL) + return NULL; +
>         Namely, if there is:
>            type1%array_class2 → array_class2 is used for 'ts' and
>         later (ok)
>            type1%type%array_class2 → NULL is returned  (why?)
>            class1%type%array_class2 → ts = class1 but array2_class is
>         used later on (ups!)
>            class1%...%scalar_class2 → ts = class1 but scalar_class2 is
>         used
>         etc.
>
>         Thus this either needs to be cleaned up (separate 'ref' loop for
>         ts != NULL) – including the wording in the description which
>         tells what
>         happens if 'ts' is passed as arg but the expr has rank == 0 – and
>         what value is assigned to 'ts'. (You can then also fix
>         'class.c::' to
>         'class.c: ' in the description above the function.)
>
>         Alternatively, you can leave the current code ref handling
>         code in place
>         at build_class_array_ref, which might be the simpler alternative.
>
>         Otherwise, it looks sensible to me.
>
>         Tobias
>
>         -----------------
>         Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634
>         München Registergericht München HRB 106955, Geschäftsführer:
>         Thomas Heurung, Frank Thürauf
>
>
>
>     --
>     "If you can't explain it simply, you don't understand it well
>     enough" - Albert Einstein
>
>
>
> --
> "If you can't explain it simply, you don't understand it well enough"
> - Albert Einstein
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf

Re: [Patch, fortran] 99307 - FAIL: gfortran.dg/class_assign_4.f90 execution test

[Paul Richard Thomas]

Pushed to master in commit 9a0e09f3dd5339bb18cc47317f2298d9157ced29

Thanks

Paul


On Wed, 14 Apr 2021 at 14:51, Tobias Burnus <tobias@codesourcery.com> wrote:

> On 11.04.21 09:05, Paul Richard Thomas wrote:
> > Tobias noticed a major technical fault with the resubmission below: I
> > forgot to attach the patch :-(
>
> LGTM. Plus as remarked in the first review: 'trans-expr_c' typo needs to
> be fixed (ChangeLog).
>
> Tobias
>
> >
> > Please find it attached this time.
> >
> > Paul
> >
> > On Tue, 6 Apr 2021 at 18:08, Paul Richard Thomas
> > <paul.richard.thomas@gmail.com <mailto:paul.richard.thomas@gmail.com>>
> > wrote:
> >
> >     Hi Tobias,
> >
> >     I believe that the attached fixes the problems that you found with
> >     gfc_find_and_cut_at_last_class_ref.
> >
> >     I will test:
> >        type1%type%array_class2 → NULL is returned  (why?)
> >        class1%type%array_class2 → ts = class1 but array2_class is used
> >     later on (ups!)
> >        class1%...%scalar_class2 → ts = class1 but scalar_class2 is used
> >
> >     The ChangeLogs remain the same, apart from the date.
> >
> >     Regtests OK on FC33/x86_64.
> >
> >     Paul
> >
> >
> >     On Mon, 29 Mar 2021 at 14:58, Tobias Burnus
> >     <tobias@codesourcery.com <mailto:tobias@codesourcery.com>> wrote:
> >
> >         Hi all,
> >
> >         as preremark I want to note that the testcase class_assign_4.f90
> >         was added for PR83118/PR96012 (fixes problems in handling
> >         class objects, Dec 18, 2020)
> >         and got revised for PR99124 (class defined operators, Feb 23,
> >         2021).
> >         Both patches were then also applied to GCC 9 and 10.
> >
> >         On 26.03.21 17:30, Paul Richard Thomas via Gcc-patches wrote:
> >         > This patch comes in two versions: submit.diff with
> >         Change.Logs or
> >         > submit2.diff with Change2.Logs.
> >         > The first fixes the problem by changing array temporaries
> >         from class
> >         > expressions into class temporaries. This permits the use of
> >         > gfc_get_class_from_expr to obtain the vptr for these
> >         temporaries and all
> >         > the good things that come with that when handling dynamic
> >         types. The second
> >         > part of the fix is to use the array element length from the
> >         class
> >         > descriptor, when reallocating on assignment. This is needed
> >         because the
> >         > vptr is being set too early. I will set about trying to
> >         track down why this
> >         > is happening and fix it after release.
> >         >
> >         > The second version does the same as the first but puts in
> >         place a load of
> >         > tidying up that is permitted by the fix to class array
> >         temporaries.
> >
> >         > I couldn't readily see how to prepare a testcase - ideas?
> >         > Both regtest on FC33/x86_64. The first was tested by
> >         Dominique (see the
> >         > PR). OK for master?
> >
> >         Typo – underscore-'c' should be a dot-'c' – both changelog files
> >
> >         >       * trans-expr_c (gfc_trans_scalar_assign): Make use of
> >         pre and
> >
> >         I think the second longer version is nicer in general, but at
> >         least for
> >         GCC 9/GCC10 the first version is simpler and, hence, less
> >         error prone.
> >
> >         As you only ask about mainline, I would prefer the second one.
> >
> >         However, I am not happy about gfc_find_and_cut_at_last_class_ref:
> >
> >         > + of refs following. If ts is non-null the cut is at the
> >         class entity
> >         > + or component that is followed by an array reference, which
> >         is not +
> >         > an element. */ ... + + if (ts) + { + if (e->symtree + &&
> >         > e->symtree->n.sym->ts.type == BT_CLASS) + *ts =
> >         > &e->symtree->n.sym->ts; + else + *ts = NULL; + } + for (ref
> >         = e->ref;
> >         > ref; ref = ref->next) { + if (ts && ref->type ==
> >         REF_COMPONENT + &&
> >         > ref->u.c.component->ts.type == BT_CLASS + && ref->next &&
> >         > ref->next->type == REF_COMPONENT + && strcmp
> >         > (ref->next->u.c.component->name, "_data") == 0 + &&
> >         ref->next->next +
> >         > && ref->next->next->type == REF_ARRAY + &&
> >         ref->next->next->u.ar.type
> >         > != AR_ELEMENT) + { + *ts = &ref->u.c.component->ts; +
> >         class_ref = ref;
> >         > + break; + } + + if (ts && *ts == NULL) + return NULL; +
> >         Namely, if there is:
> >            type1%array_class2 → array_class2 is used for 'ts' and
> >         later (ok)
> >            type1%type%array_class2 → NULL is returned  (why?)
> >            class1%type%array_class2 → ts = class1 but array2_class is
> >         used later on (ups!)
> >            class1%...%scalar_class2 → ts = class1 but scalar_class2 is
> >         used
> >         etc.
> >
> >         Thus this either needs to be cleaned up (separate 'ref' loop for
> >         ts != NULL) – including the wording in the description which
> >         tells what
> >         happens if 'ts' is passed as arg but the expr has rank == 0 – and
> >         what value is assigned to 'ts'. (You can then also fix
> >         'class.c::' to
> >         'class.c: ' in the description above the function.)
> >
> >         Alternatively, you can leave the current code ref handling
> >         code in place
> >         at build_class_array_ref, which might be the simpler alternative.
> >
> >         Otherwise, it looks sensible to me.
> >
> >         Tobias
> >
> >         -----------------
> >         Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634
> >         München Registergericht München HRB 106955, Geschäftsführer:
> >         Thomas Heurung, Frank Thürauf
> >
> >
> >
> >     --
> >     "If you can't explain it simply, you don't understand it well
> >     enough" - Albert Einstein
> >
> >
> >
> > --
> > "If you can't explain it simply, you don't understand it well enough"
> > - Albert Einstein
> -----------------
> Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München
> Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank
> Thürauf
>


-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

Re: [Patch, fortran] 99307 - FAIL: gfortran.dg/class_assign_4.f90 execution test

[dhumieres.dominique]

Le 2021-03-26 19:20, Paul Richard Thomas a écrit :
> Hi Dominique,
> 
> What I meant was a test that would confirm the fix on all targets.
> 
> BTW thanks for testing the patch!
> 
> A
> 
> Paul
> 

The second patch works as the first one.
IMO a test case for all targets should not delay the fix.

Dominique

Re: [Patch, fortran] 99307 - FAIL: gfortran.dg/class_assign_4.f90 execution test

[Paul Richard Thomas]

Hi Dominique,

What I meant was a test that would confirm the fix on all targets.

BTW thanks for testing the patch!

A

Paul


On Fri, 26 Mar 2021 at 17:29, <dhumieres.dominique@free.fr> wrote:

> Hi Paul,
>
> I have your first patch in my working tree for some time. It works as
> expected without breaking anything in my own tests.
>
> > I couldn't readily see how to prepare a testcase - ideas?
>
> I think the testcase is already in the test suite.
>
> Note the problem also affects GCC10 with a new release around the
> corner.
>
> Thanks for your work.
>
> Dominique
>


-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

Re: [Patch, fortran] 99307 - FAIL: gfortran.dg/class_assign_4.f90 execution test

[dhumieres.dominique]

Hi Paul,

I have your first patch in my working tree for some time. It works as 
expected without breaking anything in my own tests.

> I couldn't readily see how to prepare a testcase - ideas?

I think the testcase is already in the test suite.

Note the problem also affects GCC10 with a new release around the 
corner.

Thanks for your work.

Dominique