[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Déplacement initialisation dernière borne sup assumed size

Mikael Morin mikael@gcc.gnu.org
Mon Sep 15 13:36:39 GMT 2025


https://gcc.gnu.org/g:7069cc75f0e5ecc9ff7213316377849b30877436

commit 7069cc75f0e5ecc9ff7213316377849b30877436
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Sun Aug 10 11:13:41 2025 +0200

    Déplacement initialisation dernière borne sup assumed size

Diff:
---
 gcc/fortran/trans-array.cc | 37 ++++++++++++++++++++++---------------
 gcc/fortran/trans-expr.cc  | 32 --------------------------------
 2 files changed, 22 insertions(+), 47 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c31a66d0e8d6..885f7440f3a2 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7826,21 +7826,28 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	    expr->ts.u.cl->backend_decl = tmp;
 	}
 
-      /* If we have an array section, are assigning  or passing an array
-	 section argument make sure that the lower bound is 1.  References
-	 to the full array should otherwise keep the original bounds.  */
-      if (!info->ref || info->ref->u.ar.type != AR_FULL)
-	for (dim = 0; dim < loop.dimen; dim++)
-	  if (!integer_onep (loop.from[dim]))
-	    {
-	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
-				     gfc_array_index_type, gfc_index_one_node,
-				     loop.from[dim]);
-	      loop.to[dim] = fold_build2_loc (input_location, PLUS_EXPR,
-					      gfc_array_index_type,
-					      loop.to[dim], tmp);
-	      loop.from[dim] = gfc_index_one_node;
-	    }
+      if (info->ref && info->ref->u.ar.type == AR_FULL)
+	{
+	  if (info->ref->u.ar.as->type == AS_ASSUMED_SIZE)
+	    loop.to[loop.dimen - 1] = build_int_cst (gfc_array_index_type, -1);
+	}
+      else
+	{
+	  /* If we have an array section, are assigning  or passing an array
+	     section argument make sure that the lower bound is 1.  References
+	     to the full array should otherwise keep the original bounds.  */
+	  for (dim = 0; dim < loop.dimen; dim++)
+	    if (!integer_onep (loop.from[dim]))
+	      {
+		tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				       gfc_array_index_type, gfc_index_one_node,
+				       loop.from[dim]);
+		loop.to[dim] = fold_build2_loc (input_location, PLUS_EXPR,
+						gfc_array_index_type,
+						loop.to[dim], tmp);
+		loop.from[dim] = gfc_index_one_node;
+	      }
+	}
 
       desc = info->descriptor;
       if (se->direct_byref && !se->byref_noassign)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 20387351485c..50d260cdd0ef 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7606,38 +7606,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		}
 	    }
 	}
-      /* Special case for an assumed-rank dummy argument. */
-      if (!sym->attr.is_bind_c && e && fsym && e->rank > 0
-	  && (fsym->ts.type == BT_CLASS
-	      ? (CLASS_DATA (fsym)->as
-		 && CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)
-	      : (fsym->as && fsym->as->type == AS_ASSUMED_RANK))
-	  && !(fsym->ts.type == BT_CLASS
-	       ? (CLASS_DATA (fsym)->attr.class_pointer
-		  || CLASS_DATA (fsym)->attr.allocatable)
-	       : (fsym->attr.pointer || fsym->attr.allocatable))
-	  && e->expr_type == EXPR_VARIABLE
-	  && e->symtree->n.sym->attr.dummy
-	  && (e->ts.type == BT_CLASS
-	      ? (e->ref && e->ref->next
-		 && e->ref->next->type == REF_ARRAY
-		 && e->ref->next->u.ar.type == AR_FULL
-		 && e->ref->next->u.ar.as->type == AS_ASSUMED_SIZE)
-	      : (e->ref && e->ref->type == REF_ARRAY
-		 && e->ref->u.ar.type == AR_FULL
-		 && e->ref->u.ar.as->type == AS_ASSUMED_SIZE)))
-	{
-	  /* Assumed-size actual to assumed-rank dummy requires
-	     dim[rank-1].ubound = -1. */
-	  tree minus_one;
-	  tmp = build_fold_indirect_ref_loc (input_location, parmse.expr);
-	  if (fsym->ts.type == BT_CLASS)
-	    tmp = gfc_class_data_get (tmp);
-	  minus_one = build_int_cst (gfc_array_index_type, -1);
-	  gfc_conv_descriptor_ubound_set (&parmse.pre, tmp,
-					  gfc_rank_cst[e->rank - 1],
-					  minus_one);
-	}
 
       /* The case with fsym->attr.optional is that of a user subroutine
 	 with an interface indicating an optional argument.  When we call


More information about the Gcc-cvs mailing list