https://gcc.gnu.org/g:8476914249d183df6439c7a0058fcca9957559b5
commit 8476914249d183df6439c7a0058fcca9957559b5
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Thu Jan 30 21:21:39 2025 +0100
Déplacement gfc_copy_sequence_descriptor
Correction erreur compil'
Diff:
---
gcc/fortran/trans-array.cc | 64 ++++++++++++++++++++++++++++++++++++++++++++++
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-expr.cc | 64 ----------------------------------------------
gcc/fortran/trans.h | 1 -
4 files changed, 65 insertions(+), 65 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 64d7b6c3f64e..d421c8c5c431 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1849,6 +1849,70 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
desc, tree scalar,
gfc_conv_descriptor_data_set (block, desc, tmp);
}
+int
+gfc_descriptor_rank (tree descriptor)
+{
+ if (TREE_TYPE (descriptor) != NULL_TREE)
+ return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
+
+ tree dim = gfc_get_descriptor_dimension (descriptor);
+ tree dim_type = TREE_TYPE (dim);
+ gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
+ tree idx_type = TYPE_DOMAIN (dim_type);
+ gcc_assert (TREE_CODE (idx_type) == INTEGER_TYPE);
+ gcc_assert (integer_zerop (TYPE_MIN_VALUE (idx_type)));
+ tree idx_max = TYPE_MAX_VALUE (idx_type);
+ if (idx_max == NULL_TREE)
+ return GFC_MAX_DIMENSIONS;
+ wide_int max = wi::to_wide (idx_max);
+ return max.to_shwi () + 1;
+}
+
+
+void
+gfc_copy_sequence_descriptor (stmtblock_t &block, tree lhs_desc, tree rhs_desc,
+ bool assumed_rank_lhs)
+{
+ int lhs_rank = gfc_descriptor_rank (lhs_desc);
+ int rhs_rank = gfc_descriptor_rank (rhs_desc);
+ tree desc;
+
+ if (assumed_rank_lhs || lhs_rank == rhs_rank)
+ desc = rhs_desc;
+ else
+ {
+ tree arr = gfc_create_var (TREE_TYPE (lhs_desc), "parm");
+ gfc_conv_descriptor_data_set (&block, arr,
+ gfc_conv_descriptor_data_get (rhs_desc));
+ gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
+ gfc_index_zero_node);
+ tree size = gfc_conv_descriptor_size (rhs_desc, rhs_rank);
+ gfc_conv_descriptor_ubound_set (&block, arr, gfc_index_zero_node, size);
+ gfc_conv_descriptor_stride_set (
+ &block, arr, gfc_index_zero_node,
+ gfc_conv_descriptor_stride_get (rhs_desc, gfc_index_zero_node));
+ for (int i = 1; i < lhs_rank; i++)
+ {
+ gfc_conv_descriptor_lbound_set (&block, arr, gfc_rank_cst[i],
+ gfc_index_zero_node);
+ gfc_conv_descriptor_ubound_set (&block, arr, gfc_rank_cst[i],
+ gfc_index_zero_node);
+ gfc_conv_descriptor_stride_set (&block, arr, gfc_rank_cst[i], size);
+ }
+ gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
+ gfc_conv_descriptor_dtype (rhs_desc));
+ gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
+ build_int_cst (signed_char_type_node, lhs_rank));
+ gfc_conv_descriptor_span_set (&block, arr,
+ gfc_conv_descriptor_span_get (arr));
+ gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
+ desc = arr;
+ }
+
+ gfc_class_array_data_assign (&block, lhs_desc, desc, true);
+}
+
+
/* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 691231f66903..124020a53858 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -150,6 +150,7 @@ void gfc_set_descriptor_with_shape (stmtblock_t *, tree,
tree,
tree gfc_get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree,
symbol_attribute, bool, tree);
+void gfc_copy_sequence_descriptor (stmtblock_t &, tree, tree, bool);
/* Get a single array element. */
void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ee344bfb5477..c694709e8438 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -800,70 +800,6 @@ gfc_get_vptr_from_expr (tree expr)
}
-int
-gfc_descriptor_rank (tree descriptor)
-{
- if (TREE_TYPE (descriptor) != NULL_TREE)
- return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
-
- tree dim = gfc_get_descriptor_dimension (descriptor);
- tree dim_type = TREE_TYPE (dim);
- gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
- tree idx_type = TYPE_DOMAIN (dim_type);
- gcc_assert (TREE_CODE (idx_type) == INTEGER_TYPE);
- gcc_assert (integer_zerop (TYPE_MIN_VALUE (idx_type)));
- tree idx_max = TYPE_MAX_VALUE (idx_type);
- if (idx_max == NULL_TREE)
- return GFC_MAX_DIMENSIONS;
- wide_int max = wi::to_wide (idx_max);
- return max.to_shwi () + 1;
-}
-
-
-void
-gfc_copy_sequence_descriptor (stmtblock_t &block, tree lhs_desc, tree rhs_desc,
- bool assumed_rank_lhs)
-{
- int lhs_rank = gfc_descriptor_rank (lhs_desc);
- int rhs_rank = gfc_descriptor_rank (rhs_desc);
- tree desc;
-
- if (assumed_rank_lhs || lhs_rank == rhs_rank)
- desc = rhs_desc;
- else
- {
- tree arr = gfc_create_var (TREE_TYPE (lhs_desc), "parm");
- gfc_conv_descriptor_data_set (&block, arr,
- gfc_conv_descriptor_data_get (rhs_desc));
- gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
- gfc_index_zero_node);
- tree size = gfc_conv_descriptor_size (rhs_desc, rhs_rank);
- gfc_conv_descriptor_ubound_set (&block, arr, gfc_index_zero_node, size);
- gfc_conv_descriptor_stride_set (
- &block, arr, gfc_index_zero_node,
- gfc_conv_descriptor_stride_get (rhs_desc, gfc_index_zero_node));
- for (int i = 1; i < lhs_rank; i++)
- {
- gfc_conv_descriptor_lbound_set (&block, arr, gfc_rank_cst[i],
- gfc_index_zero_node);
- gfc_conv_descriptor_ubound_set (&block, arr, gfc_rank_cst[i],
- gfc_index_zero_node);
- gfc_conv_descriptor_stride_set (&block, arr, gfc_rank_cst[i], size);
- }
- gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
- gfc_conv_descriptor_dtype (rhs_desc));
- gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
- build_int_cst (signed_char_type_node, lhs_rank));
- gfc_conv_descriptor_span_set (&block, arr,
- gfc_conv_descriptor_span_get (arr));
- gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
- desc = arr;
- }
-
- gfc_class_array_data_assign (&block, lhs_desc, desc, true);
-}
-
-
void
gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
bool)
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 82e4bf45547a..2dbc2dbfe0c6 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -462,7 +462,6 @@ void gfc_finalize_tree_expr (gfc_se *, gfc_symbol *,
symbol_attribute, int);
bool gfc_assignment_finalizer_call (gfc_se *, gfc_expr *, bool);
void gfc_class_array_data_assign (stmtblock_t *, tree, tree, bool);
-void gfc_copy_sequence_descriptor (stmtblock_t &, tree, tree, bool);
void gfc_conv_remap_descriptor (stmtblock_t *, tree, tree, int, const
gfc_array_ref &);
int gfc_descriptor_rank (tree);
void gfc_conv_derived_to_class (gfc_se *, gfc_expr *, gfc_symbol *fsym, tree,
