From 4d124378848e82e58f1349b44822cc7b1210de1e Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 3 Jan 2020 08:08:30 +0000 Subject: =?UTF-8?q?Fortran]=20PR=2092994=20=E2=80=93=20add=20more=20ASSOCI?= =?UTF-8?q?ATE=20checks?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit PR fortran/92994 * primary.c (gfc_match_rvalue): Add some flavor checks gfc_matching_procptr_assignment. * resolve.c (resolve_assoc_var): Add more checks for invalid targets. PR fortran/92994 * gfortran.dg/associate_50.f90: Update dg-error. * gfortran.dg/associate_51.f90: New. From-SVN: r279853 --- gcc/fortran/resolve.c | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 4aa5f1b..6f2a4c4 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8836,9 +8836,20 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) gcc_assert (target->symtree); tsym = target->symtree->n.sym; - if (tsym->attr.flavor == FL_PROGRAM) + + if (tsym->attr.subroutine + || tsym->attr.external + || (tsym->attr.function + && (tsym->result != tsym || tsym->attr.recursive))) { - gfc_error ("Associating entity %qs at %L is a PROGRAM", + gfc_error ("Associating entity %qs at %L is a procedure name", + tsym->name, &target->where); + return; + } + + if (gfc_expr_attr (target).proc_pointer) + { + gfc_error ("Associating entity %qs at %L is a procedure pointer", tsym->name, &target->where); return; } @@ -8851,6 +8862,12 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) if (is_subref_array (target)) sym->attr.subref_array_pointer = 1; } + else if (target->ts.type == BT_PROCEDURE) + { + gfc_error ("Associating selector-expression at %L yields a procedure", + &target->where); + return; + } if (target->expr_type == EXPR_NULL) { -- cgit v1.1