https://gcc.gnu.org/g:0da7634f37b3cc21f882e84ac4ec0d650db5922f
commit 0da7634f37b3cc21f882e84ac4ec0d650db5922f Author: Mikael Morin <[email protected]> Date: Mon Sep 28 10:36:35 2026 +0200 fortran: Separate attribute and type retrieval of data references 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 the two usages of the function into two distinct functions. There is a single usage of the function that reclaims the type; create a static copy of gfc_variable_attr next to that usage, and remove all attribute setting code from it. For all the other usages of the function, it is the type that is not used. Remove it from the argument list, and all the code in the body setting 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. Diff: --- 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 2064442d57ce..7ef12d23331e 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 52945a1db136..63ae0f86357c 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 2411869c150f..a1badd0bde8a 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 ebd72e2de1fe..bb38461c81ce 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 a0c7d5c5e066..b80513346fee 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 ("data_ref_attr(): 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 dc2888b896ca..265bc1c02dd2 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;
