https://gcc.gnu.org/g:3b4a129206d1150802a373d4a3955fe730fd4edb
commit 3b4a129206d1150802a373d4a3955fe730fd4edb
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Dec 18 19:04:41 2024 +0100
Utilisation de la méthode de nullification pour nullifier un pointeur
Diff:
---
gcc/fortran/trans-array.cc | 93 ++++++++++++++++++++++++++++++++++------------
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-expr.cc | 2 +-
3 files changed, 71 insertions(+), 25 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index cdbff27d82ca..c9417300d597 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -545,9 +545,9 @@ gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree
desc,
static int
-get_type_info (const gfc_typespec &ts)
+get_type_info (const bt &type)
{
- switch (ts.type)
+ switch (type)
{
case BT_INTEGER:
case BT_LOGICAL:
@@ -558,7 +558,7 @@ get_type_info (const gfc_typespec &ts)
case BT_CLASS:
case BT_VOID:
case BT_UNSIGNED:
- return ts.type;
+ return type;
case BT_PROCEDURE:
case BT_ASSUMED:
@@ -613,11 +613,34 @@ get_size_info (gfc_typespec &ts)
}
-class init_info
+class modify_info
{
public:
+ virtual bool is_initialization () const { return false; }
virtual bool initialize_data () const { return false; }
virtual tree get_data_value () const { return NULL_TREE; }
+};
+
+class nullification : public modify_info
+{
+ virtual bool initialize_data () const { return true; }
+ virtual tree get_data_value () const { return null_pointer_node; }
+ /*
+private:
+ gfc_typespec &ts;
+
+public:
+ null_init(gfc_typespec &arg_ts) : ts(arg_ts) { }
+ virtual bool initialize_data () const { return true; }
+ virtual tree get_data_value () const { return null_pointer_node; }
+ virtual gfc_typespec *get_type () const { return &ts; }
+ */
+};
+
+class init_info : public modify_info
+{
+public:
+ virtual bool is_initialization () const { return true; }
virtual gfc_typespec *get_type () const { return nullptr; }
};
@@ -638,13 +661,13 @@ public:
}
};
-class nullification : public init_info
+class null_init : public init_info
{
private:
gfc_typespec &ts;
public:
- nullification(gfc_typespec &arg_ts) : ts(arg_ts) { }
+ null_init(gfc_typespec &arg_ts) : ts(arg_ts) { }
virtual bool initialize_data () const { return true; }
virtual tree get_data_value () const { return null_pointer_node; }
virtual gfc_typespec *get_type () const { return &ts; }
@@ -700,13 +723,12 @@ build_dtype (gfc_typespec &ts, int rank, const
symbol_attribute &,
CONSTRUCTOR_APPEND_ELT (v, rank_field, rank_val);
}
- if (type_info->type != BT_CLASS)
- {
- tree type_info_field = gfc_advance_chain (fields, GFC_DTYPE_TYPE);
- tree type_info_val = build_int_cst (TREE_TYPE (type_info_field),
- get_type_info (*type_info));
- CONSTRUCTOR_APPEND_ELT (v, type_info_field, type_info_val);
- }
+ tree type_info_field = gfc_advance_chain (fields, GFC_DTYPE_TYPE);
+ tree type_info_val = build_int_cst (TREE_TYPE (type_info_field),
+ get_type_info (type_info->type == BT_CLASS
+ ? BT_DERIVED
+ : type_info->type));
+ CONSTRUCTOR_APPEND_ELT (v, type_info_field, type_info_val);
return build_constructor (type, v);
}
@@ -715,8 +737,8 @@ build_dtype (gfc_typespec &ts, int rank, const
symbol_attribute &,
/* Build a null array descriptor constructor. */
vec<constructor_elt, va_gc> *
-get_descriptor_init (tree type, gfc_typespec &ts, int rank,
- const symbol_attribute &attr, const init_info &init)
+get_descriptor_init (tree type, gfc_typespec *ts, int rank,
+ const symbol_attribute *attr, const modify_info &init)
{
vec<constructor_elt, va_gc> *v = nullptr;
@@ -732,11 +754,15 @@ get_descriptor_init (tree type, gfc_typespec &ts, int
rank,
CONSTRUCTOR_APPEND_ELT (v, data_field, data_value);
}
- tree dtype_field = gfc_advance_chain (fields, DTYPE_FIELD);
- tree dtype_value = build_dtype (ts, rank, attr, init);
- CONSTRUCTOR_APPEND_ELT (v, dtype_field, dtype_value);
+ if (init.is_initialization ())
+ {
+ tree dtype_field = gfc_advance_chain (fields, DTYPE_FIELD);
+ tree dtype_value = build_dtype (*ts, rank, *attr,
+ static_cast<const init_info &> (init));
+ CONSTRUCTOR_APPEND_ELT (v, dtype_field, dtype_value);
+ }
- if (flag_coarray == GFC_FCOARRAY_LIB && attr.codimension)
+ if (flag_coarray == GFC_FCOARRAY_LIB && attr->codimension)
{
/* Declare the variable static so its array descriptor stays present
after leaving the scope. It may still be accessed through another
@@ -759,7 +785,7 @@ get_default_array_descriptor_init (tree type, gfc_typespec
&ts, int rank,
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
gcc_assert (DATA_FIELD == 0);
- return get_descriptor_init (type, ts, rank, attr, default_init (attr));
+ return get_descriptor_init (type, &ts, rank, &attr, default_init (attr));
}
@@ -767,7 +793,14 @@ vec<constructor_elt, va_gc> *
get_null_array_descriptor_init (tree type, gfc_typespec &ts, int rank,
const symbol_attribute &attr)
{
- return get_descriptor_init (type, ts, rank, attr, nullification (ts));
+ return get_descriptor_init (type, &ts, rank, &attr, null_init (ts));
+}
+
+
+vec<constructor_elt, va_gc> *
+get_null_array_descriptor (tree type, const symbol_attribute &attr)
+{
+ return get_descriptor_init (type, nullptr, 0, &attr, nullification ());
}
@@ -778,7 +811,7 @@ gfc_build_default_array_descriptor (tree type, gfc_typespec
&ts, int rank,
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
return build_constructor (type,
- get_descriptor_init (type, ts, rank, attr,
+ get_descriptor_init (type, &ts, rank, &attr,
default_init (attr)));
}
@@ -1056,6 +1089,18 @@ gfc_clear_descriptor (stmtblock_t *block, gfc_symbol
*sym, tree descriptor)
}
+void
+gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *expr, tree descriptor)
+{
+ symbol_attribute attr;
+
+ attr = gfc_expr_attr (expr);
+
+ init_struct (block, descriptor,
+ get_null_array_descriptor (TREE_TYPE (descriptor), attr));
+}
+
+
void
gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *sym,
gfc_expr *expr, tree descriptor)
@@ -1088,8 +1133,8 @@ gfc_set_scalar_descriptor (stmtblock_t *block, tree
descriptor,
attr = gfc_symbol_attr (sym);
init_struct (block, descriptor,
- get_descriptor_init (TREE_TYPE (descriptor), sym->ts, 0,
- attr, scalar_value (expr->ts, value)));
+ get_descriptor_init (TREE_TYPE (descriptor), &sym->ts, 0,
+ &attr, scalar_value (expr->ts, value)));
}
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 3b05a2eb197a..8df55c2c00a5 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -142,6 +142,7 @@ void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss
*, gfc_ss *);
tree gfc_build_null_descriptor (tree);
tree gfc_build_default_class_descriptor (tree, gfc_typespec &);
void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *, tree);
+void gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *, tree);
void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *, gfc_expr *, tree);
void gfc_set_scalar_descriptor (stmtblock_t *block, tree, gfc_symbol *,
gfc_expr *, tree);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 1de4a73974d6..6659f917ac01 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10904,7 +10904,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1,
gfc_expr * expr2)
if (expr2->expr_type == EXPR_NULL)
{
/* Just set the data pointer to null. */
- gfc_conv_descriptor_data_set (&lse.pre, lse.expr, null_pointer_node);
+ gfc_nullify_descriptor (&lse.pre, expr1, lse.expr);
}
else if (rank_remap)
{
