diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 32 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/associate_51.f90 | 2 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/associate_53.f90 | 71 |
5 files changed, 109 insertions, 8 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0f6dab3..39aa22d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2020-03-27 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/93363 + * resolve.c (resolve_assoc_var): Reject association to DT and + function name. + 2020-03-25 Steven G. Kargl <kargl@gcc.gnu.org> PR fortran/93484 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_; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5f9b164..8107f00 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2020-03-27 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/93363 + * gfortran.dg/associate_51.f90: Fix test case. + * gfortran.dg/associate_53.f90: New. + 2020-03-27 Jakub Jelinek <jakub@redhat.com> PR c++/94326 diff --git a/gcc/testsuite/gfortran.dg/associate_51.f90 b/gcc/testsuite/gfortran.dg/associate_51.f90 index b6ab141..e6f2e4f 100644 --- a/gcc/testsuite/gfortran.dg/associate_51.f90 +++ b/gcc/testsuite/gfortran.dg/associate_51.f90 @@ -29,7 +29,7 @@ subroutine p2 type t end type type(t) :: z = t() - associate (y => t) + associate (y => t()) end associate end diff --git a/gcc/testsuite/gfortran.dg/associate_53.f90 b/gcc/testsuite/gfortran.dg/associate_53.f90 new file mode 100644 index 0000000..5b56af3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_53.f90 @@ -0,0 +1,71 @@ +! { dg-do compile } +! +! PR fortran/93363 +! +! Contributed by G. Steinmetz + +program p + type t + integer :: a + end type + type(t) :: z + z = t(1) + associate (var1 => t) ! { dg-error "Derived type 't' cannot be used as a variable" } + end associate +end + +subroutine sub + if (f() /= 1) stop + associate (var2 => f) ! { dg-error "Associating entity 'f' at .1. is a procedure name" } + end associate + block + block + associate (var2a => f) ! { dg-error "Associating entity 'f' at .1. is a procedure name" } + end associate + end block + end block +contains + integer function f() + f = 1 + associate (var3 => f) + end associate + block + block + associate (var4 => f) + end associate + end block + end block + end + integer recursive function f2() result(res) + res = 1 + associate (var5 => f2) ! { dg-error "Associating entity 'f2' at .1. is a procedure name" } + end associate + block + block + associate (var6 => f2) ! { dg-error "Associating entity 'f2' at .1. is a procedure name" } + end associate + end block + end block + end + subroutine subsub + associate (var7 => f) ! { dg-error "Associating entity 'f' at .1. is a procedure name" } + end associate + block + block + associate (var8 => f) ! { dg-error "Associating entity 'f' at .1. is a procedure name" } + end associate + end block + end block + end +end + +subroutine sub2 + interface g + procedure s + end interface + associate (var9 => g) ! { dg-error "Associating entity 'g' at .1. is a procedure name" } + end associate +contains + subroutine s + end +end |