diff options
| author | Tobias Burnus <tobias@codesourcery.com> | 2020-01-03 08:08:30 +0000 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2020-01-03 09:08:30 +0100 |
| commit | 4d124378848e82e58f1349b44822cc7b1210de1e (patch) | |
| tree | a639757f5a1c9424f7007323e1bec9db3de8c610 /gcc/fortran/resolve.c | |
| parent | 208cb81f98da659cca6e9b8bfec524e3f5aaffcf (diff) | |
| download | gcc-4d124378848e82e58f1349b44822cc7b1210de1e.zip gcc-4d124378848e82e58f1349b44822cc7b1210de1e.tar.gz gcc-4d124378848e82e58f1349b44822cc7b1210de1e.tar.bz2 | |
Fortran] PR 92994 – add more ASSOCIATE checks
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
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 21 |
1 files changed, 19 insertions, 2 deletions
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) { |