procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fortran: Factor scalar descriptor generation

Browse source 
The same scalar descriptor generation code is present twice, in the
case of derived type entities, and in the case of polymorphic
non-coarray entities.  Factor it in preparation for a future third case
that will also need the same code for scalar descriptor generation.

gcc/fortran/ChangeLog:

	* trans.cc (get_var_descr): Factor scalar descriptor generation.
This commit is contained in:
Mikael Morin 2023-07-17 14:14:14 +02:00
parent 3693adaf08
commit f60231e35d
1 changed files with 16 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
gcc/fortran/trans.cc
View file

@ -1146,7 +1146,6 @@ static void
get_var_descr (gfc_se *se, gfc_expr *var)
{
gfc_se tmp_se;
symbol_attribute attr;
gcc_assert (var);
@ -1161,16 +1160,7 @@ get_var_descr (gfc_se *se, gfc_expr *var)
gfc_conv_expr_descriptor (&tmp_se, var);
}
else
{
gfc_conv_expr (&tmp_se, var);
/* No copy back needed, hence set attr's allocatable/pointer
to zero. */
gfc_clear_attr (&attr);
tmp_se.expr = gfc_conv_scalar_to_descriptor (&tmp_se, tmp_se.expr,
attr);
gcc_assert (tmp_se.post.head == NULL_TREE);
}
gfc_conv_expr (&tmp_se, var);
}
else
{
@ -1190,20 +1180,25 @@ get_var_descr (gfc_se *se, gfc_expr *var)
gfc_add_data_component (array_expr);
gfc_conv_expr (&tmp_se, array_expr);
gcc_assert (tmp_se.post.head == NULL_TREE);
if (!gfc_is_coarray (array_expr))
{
/* No copy back needed, hence set attr's allocatable/pointer
to zero. */
gfc_clear_attr (&attr);
tmp_se.expr = gfc_conv_scalar_to_descriptor (&tmp_se, tmp_se.expr,
attr);
}
gcc_assert (tmp_se.post.head == NULL_TREE);
}
gfc_free_expr (array_expr);
}
if (var->rank == 0)
{
if (var->ts.type == BT_DERIVED
|| !gfc_is_coarray (var))
{
/* No copy back needed, hence set attr's allocatable/pointer
to zero. */
symbol_attribute attr;
gfc_clear_attr (&attr);
tmp_se.expr = gfc_conv_scalar_to_descriptor (&tmp_se, tmp_se.expr,
attr);
}
gcc_assert (tmp_se.post.head == NULL_TREE);
}
if (!POINTER_TYPE_P (TREE_TYPE (tmp_se.expr)))
tmp_se.expr = gfc_build_addr_expr (NULL, tmp_se.expr);