https://gcc.gnu.org/g:4f145c0ee81b675c9ff428bea963da237234b31c
commit 4f145c0ee81b675c9ff428bea963da237234b31c
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Fri May 30 18:59:44 2025 +0200
Correction régression associate_47
Diff:
---
gcc/fortran/trans-descriptor.cc | 97 ++++-------------------------------
gcc/fortran/trans-expr.cc | 6 ++-
gcc/fortran/trans-types.cc | 109 ++++++++++++++++++++++++++++++++++++++++
gcc/fortran/trans-types.h | 3 ++
4 files changed, 127 insertions(+), 88 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index d2f882d7076c..9907aaa7e7a6 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -174,85 +174,6 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
#define UBOUND_SUBFIELD 2
-static tree
-substitute_placeholder_in_type (tree type, tree root_struct)
-{
- tree type_size = TYPE_SIZE (type);
- tree modified_type_size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (type_size,
- root_struct);
- tree type_size_unit = TYPE_SIZE_UNIT (type);
- tree modified_type_size_unit = SUBSTITUTE_PLACEHOLDER_IN_EXPR
(type_size_unit,
- root_struct);
-
- switch (TREE_CODE (type))
- {
- case POINTER_TYPE:
- {
- tree subtype = TREE_TYPE (type);
- tree modified_subtype = substitute_placeholder_in_type (subtype,
- root_struct);
- if (modified_subtype == subtype
- && modified_type_size == type_size
- && modified_type_size_unit == type_size_unit)
- return type;
- else
- return build_pointer_type (modified_subtype);
- }
- break;
-
- case ARRAY_TYPE:
- {
- tree elt_type = TREE_TYPE (type);
- tree modified_elt_type = substitute_placeholder_in_type (elt_type,
- root_struct);
- tree idx_type = TYPE_DOMAIN (type);
- tree modified_idx_type = substitute_placeholder_in_type (idx_type,
- root_struct);
- if (modified_elt_type == elt_type
- && modified_idx_type == idx_type
- && modified_type_size == type_size
- && modified_type_size_unit == type_size_unit)
- return type;
- else
- {
- tree new_type = build_array_type (modified_elt_type,
- modified_idx_type);
- TYPE_STRING_FLAG (new_type) = TYPE_STRING_FLAG (type);
- return new_type;
- }
- }
- break;
-
- case INTEGER_TYPE:
- {
- tree min_val = TYPE_MIN_VALUE (type);
- tree modified_min_val = SUBSTITUTE_PLACEHOLDER_IN_EXPR (min_val,
- root_struct);
- tree max_val = TYPE_MAX_VALUE (type);
- tree modified_max_val = SUBSTITUTE_PLACEHOLDER_IN_EXPR (max_val,
- root_struct);
- if (modified_min_val == min_val
- && modified_max_val == max_val
- && modified_type_size == type_size
- && modified_type_size_unit == type_size_unit)
- return type;
- else
- {
- tree new_type = build_range_type (type, modified_min_val,
- modified_max_val);
- TYPE_SIZE (new_type) = modified_type_size;
- TYPE_SIZE_UNIT (new_type) = modified_type_size_unit;
- return new_type;
- }
- }
- break;
-
- default:
- gcc_unreachable ();
- }
-}
-
-
namespace gfc_descriptor
{
@@ -303,9 +224,9 @@ conv_data_get (tree desc)
tree field = get_data (desc);
tree target_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
- gcc_assert (TREE_CODE (target_type) == POINTER_TYPE);
- if (type_contains_placeholder_p (TREE_TYPE (target_type)))
- target_type = substitute_placeholder_in_type (target_type, desc);
+ if (gfc_type_contains_placeholder_p (target_type))
+ target_type = gfc_substitute_placeholder_in_type (target_type, desc,
+ nullptr);
tree t = fold_convert (target_type, field);
return non_lvalue_loc (input_location, t);
}
@@ -314,7 +235,10 @@ void
conv_data_set (stmtblock_t *block, tree desc, tree value)
{
tree field = get_data (desc);
- gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value));
+ tree type = TREE_TYPE (field);
+ if (gfc_type_contains_placeholder_p (type))
+ type = gfc_substitute_placeholder_in_type (type, desc, block);
+ gfc_add_modify (block, field, fold_convert (type, value));
}
tree
@@ -3115,9 +3039,7 @@ placeholder_free_element_type (tree type)
return true;
tree data_ptr_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
- gcc_assert (TREE_CODE (data_ptr_type) == POINTER_TYPE);
-
- return !type_contains_placeholder_p (TREE_TYPE (data_ptr_type));
+ return !gfc_type_contains_placeholder_p (data_ptr_type);
}
@@ -3131,7 +3053,8 @@ get_descriptor_dtype (tree desc, int * prank)
else
{
tree data_ptr_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
- data_ptr_type = substitute_placeholder_in_type (data_ptr_type, desc);
+ data_ptr_type = gfc_substitute_placeholder_in_type (data_ptr_type, desc,
+ nullptr);
gcc_assert (TREE_CODE (data_ptr_type) == POINTER_TYPE);
tree etype = TREE_TYPE (data_ptr_type);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index c7c53649bcfd..fa54e2a5ae37 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2952,7 +2952,11 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
else
se->class_vptr = NULL_TREE;
- tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+ tree type = TREE_TYPE (field);
+ if (gfc_type_contains_placeholder_p (type))
+ type = gfc_substitute_placeholder_in_type (type, decl, &se->pre);
+
+ tmp = fold_build3_loc (input_location, COMPONENT_REF, type,
decl, field, NULL_TREE);
se->expr = tmp;
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index cec5869603f5..7fe372be4397 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -4466,4 +4466,113 @@ gfc_get_unbounded_array_type (tree type)
}
+bool
+gfc_type_contains_placeholder_p (tree type)
+{
+ /* The middle-end function doesn't look at
+ pointer target type, circumvent it here. */
+ if (TREE_CODE (type) == POINTER_TYPE)
+ return gfc_type_contains_placeholder_p (TREE_TYPE (type));
+ else
+ return type_contains_placeholder_p (type);
+}
+
+
+static tree
+substitute_in_expr (tree expr, tree repl_expr, stmtblock_t *block)
+{
+ tree new_expr = SUBSTITUTE_PLACEHOLDER_IN_EXPR (expr, repl_expr);
+ if (new_expr != expr
+ && !VAR_P (new_expr))
+ {
+ if (block == nullptr)
+ return save_expr (new_expr);
+ else
+ return gfc_evaluate_now (new_expr, block);
+ }
+ else
+ return new_expr;
+}
+
+
+tree
+gfc_substitute_placeholder_in_type (tree type, tree root_struct, stmtblock_t
*block)
+{
+ tree type_size = TYPE_SIZE (type);
+ tree new_type_size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (type_size, root_struct);
+
+ tree type_size_unit = TYPE_SIZE_UNIT (type);
+ tree new_type_size_unit = SUBSTITUTE_PLACEHOLDER_IN_EXPR (type_size_unit,
+ root_struct);
+
+ switch (TREE_CODE (type))
+ {
+ case POINTER_TYPE:
+ {
+ tree subtype = TREE_TYPE (type);
+ tree new_subtype = gfc_substitute_placeholder_in_type (subtype,
+ root_struct,
+ block);
+ if (new_subtype == subtype
+ && new_type_size == type_size
+ && new_type_size_unit == type_size_unit)
+ return type;
+ else
+ return build_pointer_type (new_subtype);
+ }
+ break;
+
+ case ARRAY_TYPE:
+ {
+ tree elt_type = TREE_TYPE (type);
+ tree new_elt_type = gfc_substitute_placeholder_in_type (elt_type,
+ root_struct,
+ block);
+ tree idx_type = TYPE_DOMAIN (type);
+ tree new_idx_type = gfc_substitute_placeholder_in_type (idx_type,
+ root_struct,
+ block);
+ if (new_elt_type == elt_type
+ && new_idx_type == idx_type
+ && new_type_size == type_size
+ && new_type_size_unit == type_size_unit)
+ return type;
+ else
+ {
+ tree new_type = build_array_type (new_elt_type, new_idx_type);
+ TYPE_STRING_FLAG (new_type) = TYPE_STRING_FLAG (type);
+ return new_type;
+ }
+ }
+ break;
+
+ case INTEGER_TYPE:
+ {
+ tree min_val = TYPE_MIN_VALUE (type);
+ tree new_min_val = substitute_in_expr (min_val, root_struct, block);
+
+ tree max_val = TYPE_MAX_VALUE (type);
+ tree new_max_val = substitute_in_expr (max_val, root_struct, block);
+
+ if (new_min_val == min_val
+ && new_max_val == max_val
+ && new_type_size == type_size
+ && new_type_size_unit == type_size_unit)
+ return type;
+ else
+ {
+ tree new_type = build_range_type (type, new_min_val, new_max_val);
+ TYPE_SIZE (new_type) = new_type_size;
+ TYPE_SIZE_UNIT (new_type) = new_type_size_unit;
+ return new_type;
+ }
+ }
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+}
+
+
#include "gt-fortran-trans-types.h"
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index 5ead5f7aadb9..6a5a7b6d8078 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -127,4 +127,7 @@ tree gfc_build_incomplete_array_type (tree, tree);
tree gfc_get_unbounded_array_type (tree);
+bool gfc_type_contains_placeholder_p (tree);
+tree gfc_substitute_placeholder_in_type (tree, tree, stmtblock_t *);
+
#endif
