https://gcc.gnu.org/g:573f89ded046c4d71626ad460d7fb3becb0cd16b
commit r17-4831-g573f89ded046c4d71626ad460d7fb3becb0cd16b Author: Mikael Morin <[email protected]> Date: Fri Oct 2 14:34:10 2026 +0200 fortran: Retrieve separately attributes and type 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 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. 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 f5aedd402a1b..67eaea64c9bc 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 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;
