https://gcc.gnu.org/g:15e4b0a8a9b6cd08fd0d0ea795378f1fb090282f
commit 15e4b0a8a9b6cd08fd0d0ea795378f1fb090282f
Author: Mikael Morin <mik...@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 | 40 ++++++++--------------------------------
2 files changed, 30 insertions(+), 47 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index a559562057d3..45aad986f8f9 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 8d8b81238ed5..f1f6fa37fdea 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7591,40 +7591,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& (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)))
- {
- if (fsym->ts.type == BT_CLASS
+ : (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))
- {
- /* Unallocated allocatable arrays and unassociated pointer
- arrays need their dtype setting if they are argument
- associated with assumed rank dummies to set the rank. */
- set_dtype_for_unallocated (&parmse, e);
- }
- else if (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);
- }
+ : (fsym->attr.pointer || fsym->attr.allocatable)))
+ {
+ /* Unallocated allocatable arrays and unassociated pointer
+ arrays need their dtype setting if they are argument
+ associated with assumed rank dummies to set the rank. */
+ set_dtype_for_unallocated (&parmse, e);
}
/* The case with fsym->attr.optional is that of a user subroutine
