From: Mikael Morin <[email protected]>
Fortran-tested on aarch64-unknown-linux-gnu.
OK for mainline?
-- >8 --
The function gfc_variable_attr retrieves both the type and the set of
attributes of a data reference in a single walk of the reference chain. But
there is no usage of the function that uses both, so separate it into two
distinct functions corresponding to the two usage kinds.
For the type, there is a single place where it is reclaimed to the function
through the second argument, and the function result isn't used there.
Create a static copy of the function to be used in that place, and remove
all attribute tracking and setting code from it.
All the other references to the function use the attribute set result
without reclaiming the type. Remove the latter from the argument list, and
all the code in the body to set it.
gcc/fortran/ChangeLog:
* resolve.cc (get_data_ref_type): New static function, using the
type initialization code from gfc_variable_attr.
(resolve_variable): Call the new function.
* gfortran.h (gfc_variable_attr): Remove type argument.
* primary.cc (gfc_variable_attr): Ditto. Remove type initialization
code.
(gfc_expr_attr): Update caller.
* check.cc (allocatable_check, gfc_check_null): Likewise.
* expr.cc (gfc_is_simply_contiguous): Likewise.
* trans-expr.cc (gfc_conv_procedure_call): Likewise.
---
gcc/fortran/check.cc | 4 +--
gcc/fortran/expr.cc | 4 +--
gcc/fortran/gfortran.h | 2 +-
gcc/fortran/primary.cc | 40 +++------------------
gcc/fortran/resolve.cc | 74 ++++++++++++++++++++++++++++++++++++++-
gcc/fortran/trans-expr.cc | 2 +-
6 files changed, 84 insertions(+), 42 deletions(-)
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 2064442d57c..7ef12d23331 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -1080,7 +1080,7 @@ allocatable_check (gfc_expr *e, int n)
{
symbol_attribute attr;
- attr = gfc_variable_attr (e, NULL);
+ attr = gfc_variable_attr (e);
if (!attr.allocatable
|| (attr.associate_var && !attr.select_rank_temporary))
{
@@ -4933,7 +4933,7 @@ gfc_check_null (gfc_expr *mold)
if (!variable_check (mold, 0, true))
return false;
- attr = gfc_variable_attr (mold, NULL);
+ attr = gfc_variable_attr (mold);
if (!attr.pointer && !attr.proc_pointer && !attr.allocatable)
{
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 52945a1db13..63ae0f86357 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -6418,8 +6418,8 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict,
bool permit_element)
if (expr->ts.type == BT_UNKNOWN)
return true;
else
- return (gfc_variable_attr (expr, NULL).contiguous
- || gfc_variable_attr (expr, NULL).allocatable);
+ return (gfc_variable_attr (expr).contiguous
+ || gfc_variable_attr (expr).allocatable);
}
if (expr->expr_type == EXPR_FUNCTION)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 2411869c150..a1badd0bde8 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -4331,7 +4331,7 @@ const char *gfc_dt_lower_string (const char *);
const char *gfc_dt_upper_string (const char *);
/* primary.cc */
-symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
+symbol_attribute gfc_variable_attr (gfc_expr *);
symbol_attribute gfc_expr_attr (gfc_expr *);
symbol_attribute gfc_caf_attr (gfc_expr *, bool i = false, bool *r = NULL);
bool is_inquiry_ref (const char *, gfc_ref **);
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index ebd72e2de1f..bb38461c81c 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -3006,7 +3006,7 @@ check_substring:
/* Given an expression that is a variable, figure out what the
- ultimate variable's type and attribute is, traversing the reference
+ ultimate variable's attribute is, traversing the reference
structures if necessary.
This subroutine is trickier than it looks. We start at the base
@@ -3023,15 +3023,13 @@ check_substring:
We can have at most one full array reference. */
symbol_attribute
-gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
+gfc_variable_attr (gfc_expr *expr)
{
int dimension, codimension, pointer, allocatable, target, optional;
symbol_attribute attr;
gfc_ref *ref;
gfc_symbol *sym;
gfc_component *comp;
- bool has_inquiry_part;
- bool has_substring_ref = false;
if (expr->expr_type != EXPR_VARIABLE
&& expr->expr_type != EXPR_FUNCTION
@@ -3077,31 +3075,11 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
target = 0;
}
- if (ts != NULL && expr->ts.type == BT_UNKNOWN)
- *ts = sym->ts;
-
- /* Catch left-overs from match_actual_arg, where an actual argument of a
- procedure is given a temporary ts.type == BT_PROCEDURE. The fixup is
- needed for structure constructors in DATA statements, where a pointer
- is associated with a data target, and the argument has not been fully
- resolved yet. Components references are dealt with further below. */
- if (ts != NULL
- && expr->ts.type == BT_PROCEDURE
- && expr->ref == NULL
- && attr.flavor != FL_PROCEDURE
- && attr.target)
- *ts = sym->ts;
-
- has_inquiry_part = false;
for (ref = expr->ref; ref; ref = ref->next)
if (ref->type == REF_SUBSTRING)
- {
- has_substring_ref = true;
- optional = false;
- }
+ optional = false;
else if (ref->type == REF_INQUIRY)
{
- has_inquiry_part = true;
optional = false;
break;
}
@@ -3142,14 +3120,6 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
optional = false;
comp = ref->u.c.component;
attr = comp->attr;
- if (ts != NULL && !has_inquiry_part)
- {
- *ts = comp->ts;
- /* Don't set the string length if a substring reference
- follows. */
- if (ts->type == BT_CHARACTER && has_substring_ref)
- ts->u.cl = NULL;
- }
if (comp->ts.type == BT_CLASS)
{
@@ -3201,7 +3171,7 @@ gfc_expr_attr (gfc_expr *e)
switch (e->expr_type)
{
case EXPR_VARIABLE:
- attr = gfc_variable_attr (e, NULL);
+ attr = gfc_variable_attr (e);
break;
case EXPR_FUNCTION:
@@ -3223,7 +3193,7 @@ gfc_expr_attr (gfc_expr *e)
&& e->ts.type == BT_CLASS)
attr = CLASS_DATA (e)->attr;
else if (e->symtree)
- attr = gfc_variable_attr (e, NULL);
+ attr = gfc_variable_attr (e);
/* TODO: NULL() returns pointers. May have to take care of this
here. */
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index a0c7d5c5e06..27a69b74f82 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -6478,6 +6478,78 @@ gfc_op_rank_conformable (gfc_expr *op1, gfc_expr *op2)
|| (!gfc_is_coindexed (op1) && !gfc_is_coindexed (op2)));
}
+
+/* Given an expression EXPR that is a variable, figure out what the ultimate
+ variable's type is and store it in TS, traversing the reference structures
+ if necessary.
+
+ We start at the base symbol and store the type. Component references
+ overwrite a completely new type. */
+
+static void
+get_data_ref_type (gfc_expr *expr, gfc_typespec *ts)
+{
+ gfc_ref *ref;
+ gfc_symbol *sym;
+ gfc_component *comp;
+ bool has_inquiry_part;
+ bool has_substring_ref = false;
+
+ if (expr->expr_type != EXPR_VARIABLE
+ && expr->expr_type != EXPR_FUNCTION
+ && !(expr->expr_type == EXPR_NULL && expr->ts.type != BT_UNKNOWN))
+ gfc_internal_error ("get_data_ref_type(): Expression isn't a variable");
+
+ sym = expr->symtree->n.sym;
+
+ if (ts != NULL && expr->ts.type == BT_UNKNOWN)
+ *ts = sym->ts;
+
+ /* Catch left-overs from match_actual_arg, where an actual argument of a
+ procedure is given a temporary ts.type == BT_PROCEDURE. The fixup is
+ needed for structure constructors in DATA statements, where a pointer
+ is associated with a data target, and the argument has not been fully
+ resolved yet. Components references are dealt with further below. */
+ if (ts != NULL
+ && expr->ts.type == BT_PROCEDURE
+ && expr->ref == NULL
+ && sym->attr.flavor != FL_PROCEDURE
+ && sym->attr.target)
+ *ts = sym->ts;
+
+ has_inquiry_part = false;
+ for (ref = expr->ref; ref; ref = ref->next)
+ if (ref->type == REF_SUBSTRING)
+ has_substring_ref = true;
+ else if (ref->type == REF_INQUIRY)
+ {
+ has_inquiry_part = true;
+ break;
+ }
+
+ for (ref = expr->ref; ref; ref = ref->next)
+ switch (ref->type)
+ {
+ case REF_COMPONENT:
+ comp = ref->u.c.component;
+ if (ts != NULL && !has_inquiry_part)
+ {
+ *ts = comp->ts;
+ /* Don't set the string length if a substring reference
+ follows. */
+ if (ts->type == BT_CHARACTER && has_substring_ref)
+ ts->u.cl = NULL;
+ }
+ break;
+
+ case REF_ARRAY:
+ case REF_INQUIRY:
+ case REF_SUBSTRING:
+ break;
+ }
+}
+
+
/* Resolve a variable expression. */
static bool
@@ -6759,7 +6831,7 @@ resolve_variable (gfc_expr *e)
}
if (sym->ts.type != BT_UNKNOWN)
- gfc_variable_attr (e, &e->ts);
+ get_data_ref_type (e, &e->ts);
else if (sym->attr.flavor == FL_PROCEDURE
&& sym->attr.function && sym->result
&& sym->result->ts.type != BT_UNKNOWN
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index dc2888b896c..265bc1c02dd 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7299,7 +7299,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
: fsym->attr.allocatable)
&& e->symtree
&& e->symtree->n.sym
- && gfc_variable_attr (e, NULL).allocatable)
+ && gfc_variable_attr (e).allocatable)
{
force_eval_args = true;
break;
--
2.53.0
