[08/14] fortran: use _P() defines from tree.h
Checks
Commit Message
From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
gcc/fortran/ChangeLog:
* trans-array.cc (is_pointer_array): Use _P() defines from tree.h.
(gfc_conv_scalarized_array_ref): Ditto.
(gfc_conv_array_ref): Ditto.
* trans-decl.cc (gfc_finish_decl): Ditto.
(gfc_get_symbol_decl): Ditto.
* trans-expr.cc (gfc_trans_pointer_assignment): Ditto.
(gfc_trans_arrayfunc_assign): Ditto.
(gfc_trans_assignment_1): Ditto.
* trans-intrinsic.cc (gfc_conv_intrinsic_minmax): Ditto.
(conv_intrinsic_ieee_value): Ditto.
* trans-io.cc (gfc_convert_array_to_string): Ditto.
* trans-openmp.cc (gfc_omp_is_optional_argument): Ditto.
(gfc_trans_omp_clauses): Ditto.
* trans-stmt.cc (gfc_conv_label_variable): Ditto.
* trans.cc (gfc_build_addr_expr): Ditto.
(get_array_span): Ditto.
---
gcc/fortran/trans-array.cc | 10 +++++-----
gcc/fortran/trans-decl.cc | 4 ++--
gcc/fortran/trans-expr.cc | 6 +++---
gcc/fortran/trans-intrinsic.cc | 4 ++--
gcc/fortran/trans-io.cc | 2 +-
gcc/fortran/trans-openmp.cc | 7 +++----
gcc/fortran/trans-stmt.cc | 2 +-
gcc/fortran/trans.cc | 4 ++--
8 files changed, 19 insertions(+), 20 deletions(-)
Comments
Le 14/05/2023 à 01:23, Bernhard Reutner-Fischer via Gcc-patches a écrit :
> From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
>
> gcc/fortran/ChangeLog:
>
> * trans-array.cc (is_pointer_array): Use _P() defines from tree.h.
> (gfc_conv_scalarized_array_ref): Ditto.
> (gfc_conv_array_ref): Ditto.
> * trans-decl.cc (gfc_finish_decl): Ditto.
> (gfc_get_symbol_decl): Ditto.
> * trans-expr.cc (gfc_trans_pointer_assignment): Ditto.
> (gfc_trans_arrayfunc_assign): Ditto.
> (gfc_trans_assignment_1): Ditto.
> * trans-intrinsic.cc (gfc_conv_intrinsic_minmax): Ditto.
> (conv_intrinsic_ieee_value): Ditto.
> * trans-io.cc (gfc_convert_array_to_string): Ditto.
> * trans-openmp.cc (gfc_omp_is_optional_argument): Ditto.
> (gfc_trans_omp_clauses): Ditto.
> * trans-stmt.cc (gfc_conv_label_variable): Ditto.
> * trans.cc (gfc_build_addr_expr): Ditto.
> (get_array_span): Ditto.
OK from the fortran side.
Thanks
On Sun, 14 May 2023 15:10:12 +0200
Mikael Morin <morin-mikael@orange.fr> wrote:
> Le 14/05/2023 à 01:23, Bernhard Reutner-Fischer via Gcc-patches a écrit :
> > From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
> >
> > gcc/fortran/ChangeLog:
> >
> > * trans-array.cc (is_pointer_array): Use _P() defines from tree.h.
> > (gfc_conv_scalarized_array_ref): Ditto.
> > (gfc_conv_array_ref): Ditto.
> > * trans-decl.cc (gfc_finish_decl): Ditto.
> > (gfc_get_symbol_decl): Ditto.
> > * trans-expr.cc (gfc_trans_pointer_assignment): Ditto.
> > (gfc_trans_arrayfunc_assign): Ditto.
> > (gfc_trans_assignment_1): Ditto.
> > * trans-intrinsic.cc (gfc_conv_intrinsic_minmax): Ditto.
> > (conv_intrinsic_ieee_value): Ditto.
> > * trans-io.cc (gfc_convert_array_to_string): Ditto.
> > * trans-openmp.cc (gfc_omp_is_optional_argument): Ditto.
> > (gfc_trans_omp_clauses): Ditto.
> > * trans-stmt.cc (gfc_conv_label_variable): Ditto.
> > * trans.cc (gfc_build_addr_expr): Ditto.
> > (get_array_span): Ditto.
>
> OK from the fortran side.
>
> Thanks
Thanks, i'll push it during the weekend.
I've fed gfortran.h into the script and found some CLASS_DATA spots,
see attached bootstrapped and tested patch.
Do we want to have that?
If so, i'd write a proper ChangeLog, of course.
Thanks!
Le 18/05/2023 à 17:18, Bernhard Reutner-Fischer a écrit :
> On Sun, 14 May 2023 15:10:12 +0200
> Mikael Morin <morin-mikael@orange.fr> wrote:
>
>> Le 14/05/2023 à 01:23, Bernhard Reutner-Fischer via Gcc-patches a écrit :
>>> From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
>>>
>>> gcc/fortran/ChangeLog:
>>>
>>> * trans-array.cc (is_pointer_array): Use _P() defines from tree.h.
>>> (gfc_conv_scalarized_array_ref): Ditto.
>>> (gfc_conv_array_ref): Ditto.
>>> * trans-decl.cc (gfc_finish_decl): Ditto.
>>> (gfc_get_symbol_decl): Ditto.
>>> * trans-expr.cc (gfc_trans_pointer_assignment): Ditto.
>>> (gfc_trans_arrayfunc_assign): Ditto.
>>> (gfc_trans_assignment_1): Ditto.
>>> * trans-intrinsic.cc (gfc_conv_intrinsic_minmax): Ditto.
>>> (conv_intrinsic_ieee_value): Ditto.
>>> * trans-io.cc (gfc_convert_array_to_string): Ditto.
>>> * trans-openmp.cc (gfc_omp_is_optional_argument): Ditto.
>>> (gfc_trans_omp_clauses): Ditto.
>>> * trans-stmt.cc (gfc_conv_label_variable): Ditto.
>>> * trans.cc (gfc_build_addr_expr): Ditto.
>>> (get_array_span): Ditto.
>>
>> OK from the fortran side.
>>
>> Thanks
>
> Thanks, i'll push it during the weekend.
>
> I've fed gfortran.h into the script and found some CLASS_DATA spots,
> see attached bootstrapped and tested patch.
> Do we want to have that?
Some of it makes sense, but not all of it.
It is a macro to access the _data component of a class container.
So for class-related stuff it makes sense to use CLASS_DATA, and
typically there will be a check that the type is BT_CLASS before.
But for cases where we loop over all of the components of a type that is
not necessarily a class container, it doesn't make sense to use CLASS_DATA.
So I suggest to only keep the following hunks.
> diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
> index aa01a4d3d22..a6b4ef0a0bf 100644
> --- a/gcc/fortran/expr.cc
> +++ b/gcc/fortran/expr.cc
> @@ -5847,9 +5847,9 @@ gfc_get_corank (gfc_expr *e)
> if (!gfc_is_coarray (e))
> return 0;
>
> - if (e->ts.type == BT_CLASS && e->ts.u.derived->components)
> - corank = e->ts.u.derived->components->as
> - ? e->ts.u.derived->components->as->corank : 0;
> + if (e->ts.type == BT_CLASS && CLASS_DATA (e))
> + corank = CLASS_DATA (e)->as
> + ? CLASS_DATA (e)->as->corank : 0;
> else
> corank = e->symtree->n.sym->as ? e->symtree->n.sym->as->corank : 0;
>
> diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
> index 9c92958a397..6e26fb07ddd 100644
> --- a/gcc/fortran/resolve.cc
> +++ b/gcc/fortran/resolve.cc
> @@ -15176,7 +15176,7 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
> /* Check type-spec if this is not the parent-type component. */
> if (((sym->attr.is_class
> && (!sym->components->ts.u.derived->attr.extension
> - || c != sym->components->ts.u.derived->components))
> + || c != CLASS_DATA (sym->components)))
> || (!sym->attr.is_class
> && (!sym->attr.extension || c != sym->components)))
> && !sym->attr.vtype
> @@ -15189,7 +15189,7 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
> component. */
> if (super_type
> && ((sym->attr.is_class
> - && c == sym->components->ts.u.derived->components)
> + && c == CLASS_DATA (sym->components))
> || (!sym->attr.is_class && c == sym->components))
> && strcmp (super_type->name, c->name) == 0)
> c->attr.access = super_type->attr.access;
> @@ -15435,7 +15435,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
> return false;
> }
>
> - c = (sym->attr.is_class) ? sym->components->ts.u.derived->components
> + c = (sym->attr.is_class) ? CLASS_DATA (sym->components)
> : sym->components;
>
> success = true;
> diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
> index a7b4784d73a..6ba2040e61c 100644
> --- a/gcc/fortran/simplify.cc
> +++ b/gcc/fortran/simplify.cc
> @@ -3116,28 +3116,28 @@ gfc_simplify_extends_type_of (gfc_expr *a, gfc_expr *mold)
> /* Return .false. if the dynamic type can never be an extension. */
> if ((a->ts.type == BT_CLASS && mold->ts.type == BT_CLASS
> && !gfc_type_is_extension_of
> - (mold->ts.u.derived->components->ts.u.derived,
> - a->ts.u.derived->components->ts.u.derived)
> + (CLASS_DATA (mold)->ts.u.derived,
> + CLASS_DATA (a)->ts.u.derived)
> && !gfc_type_is_extension_of
> - (a->ts.u.derived->components->ts.u.derived,
> - mold->ts.u.derived->components->ts.u.derived))
> + (CLASS_DATA (a)->ts.u.derived,
> + CLASS_DATA (mold)->ts.u.derived))
> || (a->ts.type == BT_DERIVED && mold->ts.type == BT_CLASS
> && !gfc_type_is_extension_of
> - (mold->ts.u.derived->components->ts.u.derived,
> + (CLASS_DATA (mold)->ts.u.derived,
> a->ts.u.derived))
> || (a->ts.type == BT_CLASS && mold->ts.type == BT_DERIVED
> && !gfc_type_is_extension_of
> (mold->ts.u.derived,
> - a->ts.u.derived->components->ts.u.derived)
> + CLASS_DATA (a)->ts.u.derived)
> && !gfc_type_is_extension_of
> - (a->ts.u.derived->components->ts.u.derived,
> + (CLASS_DATA (a)->ts.u.derived,
> mold->ts.u.derived)))
> return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, false);
>
> /* Return .true. if the dynamic type is guaranteed to be an extension. */
> if (a->ts.type == BT_CLASS && mold->ts.type == BT_DERIVED
> && gfc_type_is_extension_of (mold->ts.u.derived,
> - a->ts.u.derived->components->ts.u.derived))
> + CLASS_DATA (a)->ts.u.derived))
> return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, true);
>
> return NULL;
> @@ -4344,8 +4344,8 @@ simplify_cobound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
> return NULL;
>
> /* Follow any component references. */
> - as = (array->ts.type == BT_CLASS && array->ts.u.derived->components)
> - ? array->ts.u.derived->components->as
> + as = (array->ts.type == BT_CLASS && CLASS_DATA (array))
> + ? CLASS_DATA (array)->as
> : array->symtree->n.sym->as;
> for (ref = array->ref; ref; ref = ref->next)
> {
OK for those hunks.
Thanks
On Thu, 18 May 2023 21:20:41 +0200
Mikael Morin <morin-mikael@orange.fr> wrote:
> Le 18/05/2023 à 17:18, Bernhard Reutner-Fischer a écrit :
> > I've fed gfortran.h into the script and found some CLASS_DATA spots,
> > see attached bootstrapped and tested patch.
> > Do we want to have that?
> Some of it makes sense, but not all of it.
>
> It is a macro to access the _data component of a class container.
> So for class-related stuff it makes sense to use CLASS_DATA, and
> typically there will be a check that the type is BT_CLASS before.
> But for cases where we loop over all of the components of a type that is
> not necessarily a class container, it doesn't make sense to use CLASS_DATA.
>
> So I suggest to only keep the following hunks.
[]
> OK for those hunks.
Pushed those as r14-1001-g05b7cc7daac8b3
Many thanks!
PS: I'm attaching the fugly script i used to do these macro
replacements FYA.
@@ -880,7 +880,7 @@ is_pointer_array (tree expr)
|| GFC_CLASS_TYPE_P (TREE_TYPE (expr)))
return false;
- if (TREE_CODE (expr) == VAR_DECL
+ if (VAR_P (expr)
&& GFC_DECL_PTR_ARRAY_P (expr))
return true;
@@ -888,7 +888,7 @@ is_pointer_array (tree expr)
&& GFC_DECL_PTR_ARRAY_P (expr))
return true;
- if (TREE_CODE (expr) == INDIRECT_REF
+ if (INDIRECT_REF_P (expr)
&& GFC_DECL_PTR_ARRAY_P (TREE_OPERAND (expr, 0)))
return true;
@@ -3803,7 +3803,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar,
{
if (TREE_CODE (info->descriptor) == COMPONENT_REF)
decl = info->descriptor;
- else if (TREE_CODE (info->descriptor) == INDIRECT_REF)
+ else if (INDIRECT_REF_P (info->descriptor))
decl = TREE_OPERAND (info->descriptor, 0);
if (decl == NULL_TREE)
@@ -4057,7 +4057,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
{
if (TREE_CODE (se->expr) == COMPONENT_REF)
decl = se->expr;
- else if (TREE_CODE (se->expr) == INDIRECT_REF)
+ else if (INDIRECT_REF_P (se->expr))
decl = TREE_OPERAND (se->expr, 0);
else
decl = se->expr;
@@ -4069,7 +4069,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr)))
{
decl = se->expr;
- if (TREE_CODE (decl) == INDIRECT_REF)
+ if (INDIRECT_REF_P (decl))
decl = TREE_OPERAND (decl, 0);
}
else
@@ -558,7 +558,7 @@ gfc_finish_decl (tree decl)
return;
if (DECL_SIZE (decl) == NULL_TREE
- && TYPE_SIZE (TREE_TYPE (decl)) != NULL_TREE)
+ && COMPLETE_TYPE_P (TREE_TYPE (decl)))
layout_decl (decl, 0);
/* A few consistency checks. */
@@ -1889,7 +1889,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
length = fold_convert (gfc_charlen_type_node, length);
gfc_finish_var_decl (length, sym);
if (!sym->attr.associate_var
- && TREE_CODE (length) == VAR_DECL
+ && VAR_P (length)
&& sym->value && sym->value->expr_type != EXPR_NULL
&& sym->value->ts.u.cl->length)
{
@@ -10246,7 +10246,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
gfc_conv_descriptor_data_set (&block, desc, data);
/* Copy the span. */
- if (TREE_CODE (rse.expr) == VAR_DECL
+ if (VAR_P (rse.expr)
&& GFC_DECL_PTR_ARRAY_P (rse.expr))
span = gfc_conv_descriptor_span_get (rse.expr);
else
@@ -10933,7 +10933,7 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
{
tmp = sym->backend_decl;
lhs = sym->backend_decl;
- if (TREE_CODE (tmp) == INDIRECT_REF)
+ if (INDIRECT_REF_P (tmp))
tmp = TREE_OPERAND (tmp, 0);
sym->backend_decl = gfc_create_var (TREE_TYPE (tmp), "lhs");
gfc_add_modify (&se.pre, sym->backend_decl, tmp);
@@ -11883,7 +11883,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
if (expr2->ts.type == BT_CHARACTER && !expr1->ts.deferred
&& !(VAR_P (rse.string_length)
|| TREE_CODE (rse.string_length) == PARM_DECL
- || TREE_CODE (rse.string_length) == INDIRECT_REF))
+ || INDIRECT_REF_P (rse.string_length)))
string_length = gfc_evaluate_now (rse.string_length, &rse.pre);
else if (expr2->ts.type == BT_CHARACTER)
{
@@ -4112,7 +4112,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op)
/* Handle absent optional arguments by ignoring the comparison. */
if (argexpr->expr->expr_type == EXPR_VARIABLE
&& argexpr->expr->symtree->n.sym->attr.optional
- && TREE_CODE (val) == INDIRECT_REF)
+ && INDIRECT_REF_P (val))
{
cond = fold_build2_loc (input_location,
NE_EXPR, logical_type_node,
@@ -10155,7 +10155,7 @@ conv_intrinsic_ieee_value (gfc_se *se, gfc_expr *expr)
arg = gfc_evaluate_now (arg, &se->pre);
type = gfc_typenode_for_spec (&expr->ts);
- gcc_assert (TREE_CODE (type) == REAL_TYPE);
+ gcc_assert (SCALAR_FLOAT_TYPE_P (type));
ret = gfc_create_var (type, NULL);
gfc_init_block (&body);
@@ -791,7 +791,7 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
}
else
{
- gcc_assert (TREE_CODE (se->expr) == INDIRECT_REF);
+ gcc_assert (INDIRECT_REF_P (se->expr));
tree ptr = TREE_OPERAND (se->expr, 0);
gcc_assert (TREE_CODE (ptr) == POINTER_PLUS_EXPR);
@@ -73,7 +73,7 @@ static bool
gfc_omp_is_optional_argument (const_tree decl)
{
/* Note: VAR_DECL can occur with BIND(C) and array descriptors. */
- return ((TREE_CODE (decl) == PARM_DECL || TREE_CODE (decl) == VAR_DECL)
+ return ((TREE_CODE (decl) == PARM_DECL || VAR_P (decl))
&& DECL_LANG_SPECIFIC (decl)
&& TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
&& !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
@@ -3334,9 +3334,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
}
else if (present
- && TREE_CODE (decl) == INDIRECT_REF
- && (TREE_CODE (TREE_OPERAND (decl, 0))
- == INDIRECT_REF))
+ && INDIRECT_REF_P (decl)
+ && INDIRECT_REF_P (TREE_OPERAND (decl, 0)))
{
/* A single indirectref is handled by the middle end. */
gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
@@ -82,7 +82,7 @@ gfc_conv_label_variable (gfc_se * se, gfc_expr * expr)
if (TREE_CODE (se->expr) == COMPONENT_REF)
se->expr = TREE_OPERAND (se->expr, 1);
/* Deals with dummy argument. Get the parameter declaration. */
- else if (TREE_CODE (se->expr) == INDIRECT_REF)
+ else if (INDIRECT_REF_P (se->expr))
se->expr = TREE_OPERAND (se->expr, 0);
}
@@ -332,7 +332,7 @@ gfc_build_addr_expr (tree type, tree t)
else
natural_type = build_pointer_type (base_type);
- if (TREE_CODE (t) == INDIRECT_REF)
+ if (INDIRECT_REF_P (t))
{
if (!type)
type = natural_type;
@@ -365,7 +365,7 @@ get_array_span (tree type, tree decl)
if (TREE_CODE (decl) == COMPONENT_REF
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
return gfc_conv_descriptor_span_get (decl);
- else if (TREE_CODE (decl) == INDIRECT_REF
+ else if (INDIRECT_REF_P (decl)
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
return gfc_conv_descriptor_span_get (decl);