From a76ff304f905db9fd9b049c2ca4ec84f0420da53 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 27 Mar 2020 10:56:25 +0100 Subject: Fortran] Reject invalid association target (PR93363) PR fortran/93363 * resolve.c (resolve_assoc_var): Reject association to DT and function name. PR fortran/93363 * gfortran.dg/associate_51.f90: Fix test case. * gfortran.dg/associate_53.f90: New. --- gcc/fortran/resolve.c | 32 +++++++++++++++++++++++++------- 1 file changed, 25 insertions(+), 7 deletions(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 2dcb261..b6277d2 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8868,27 +8868,45 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) /* For variable targets, we get some attributes from the target. */ if (target->expr_type == EXPR_VARIABLE) { - gfc_symbol* tsym; + gfc_symbol *tsym, *dsym; gcc_assert (target->symtree); tsym = target->symtree->n.sym; - if (tsym->attr.subroutine - || tsym->attr.external - || (tsym->attr.function && tsym->result != tsym)) + if (gfc_expr_attr (target).proc_pointer) { - gfc_error ("Associating entity %qs at %L is a procedure name", + gfc_error ("Associating entity %qs at %L is a procedure pointer", tsym->name, &target->where); return; } - if (gfc_expr_attr (target).proc_pointer) + if (tsym->attr.flavor == FL_PROCEDURE && tsym->generic + && (dsym = gfc_find_dt_in_generic (tsym)) != NULL + && dsym->attr.flavor == FL_DERIVED) { - gfc_error ("Associating entity %qs at %L is a procedure pointer", + gfc_error ("Derived type %qs cannot be used as a variable at %L", tsym->name, &target->where); return; } + if (tsym->attr.flavor == FL_PROCEDURE) + { + bool is_error = true; + if (tsym->attr.function && tsym->result == tsym) + for (gfc_namespace *ns = sym->ns; ns; ns = ns->parent) + if (tsym == ns->proc_name) + { + is_error = false; + break; + } + if (is_error) + { + gfc_error ("Associating entity %qs at %L is a procedure name", + tsym->name, &target->where); + return; + } + } + sym->attr.asynchronous = tsym->attr.asynchronous; sym->attr.volatile_ = tsym->attr.volatile_; -- cgit v1.1