https://gcc.gnu.org/g:c7dbe2c44c3013afade7dd6c12e2eccd4a19a4ab
commit c7dbe2c44c3013afade7dd6c12e2eccd4a19a4ab
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Jul 16 12:40:12 2025 +0200
Suppression set_dtype_for_unallocated
Diff:
---
gcc/fortran/trans-expr.cc | 78 +++++++++--------------------------------------
1 file changed, 14 insertions(+), 64 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 40cb01b3c8e4..c46f09632f7b 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6000,50 +6000,6 @@ expr_may_alias_variables (gfc_expr *e, bool
array_may_alias)
}
-/* A helper function to set the dtype for unallocated or unassociated
- entities. */
-
-static void
-set_dtype_for_unallocated (gfc_se *parmse, gfc_expr *e)
-{
- tree tmp;
- tree desc;
- tree cond;
- tree type;
- stmtblock_t block;
-
- /* TODO Figure out how to handle optional dummies. */
- if (e && e->expr_type == EXPR_VARIABLE
- && e->symtree->n.sym->attr.optional)
- return;
-
- desc = parmse->expr;
- if (desc == NULL_TREE)
- return;
-
- if (POINTER_TYPE_P (TREE_TYPE (desc)))
- desc = build_fold_indirect_ref_loc (input_location, desc);
- if (GFC_CLASS_TYPE_P (TREE_TYPE (desc)))
- desc = gfc_class_data_get (desc);
- if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
- return;
-
- gfc_init_block (&block);
- tmp = gfc_conv_descriptor_data_get (desc);
- cond = fold_build2_loc (input_location, EQ_EXPR,
- logical_type_node, tmp,
- build_int_cst (TREE_TYPE (tmp), 0));
- type = gfc_get_element_type (TREE_TYPE (desc));
- gfc_conv_descriptor_dtype_set (&block, desc,
- gfc_get_dtype_rank_type (e->rank, type));
- cond = build3_v (COND_EXPR, cond,
- gfc_finish_block (&block),
- build_empty_stmt (input_location));
- gfc_add_expr_to_block (&parmse->pre, cond);
-}
-
-
-
/* Provide an interface between gfortran array descriptors and the F2018:18.4
ISO_Fortran_binding array descriptors. */
@@ -7871,26 +7827,20 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)
: (fsym->as && fsym->as->type == AS_ASSUMED_RANK)))
{
- if (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)))
+ if (!(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. */
