diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 6 | ||||
| -rw-r--r-- | gcc/fortran/symbol.c | 7 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr39695_1.f90 | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr39695_2.f90 | 12 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr39695_3.f90 | 11 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr39695_4.f90 | 14 |
8 files changed, 73 insertions, 4 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ab79158..fb0e47c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2020-05-20 Mark Eggleston <markeggleston@gcc.gnu.org> + + PR fortran/39695 + * resolve.c (resolve_fl_procedure): Set name depending on + whether the result attribute is set. For PROCEDURE/RESULT + conflict use the name in sym->ns->proc_name->name. + * symbol.c (gfc_add_type): Add check for function and result + attributes use sym->ns->proc_name->name if both are set. + Where the symbol cannot have a type use the name in + sym->ns->proc_name->name. + 2020-05-18 Harald Anlauf <anlauf@gmx.de> PR fortran/95053 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f6e10ea..aaee5eb 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13125,8 +13125,10 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { if (sym->attr.proc_pointer) { + const char* name = (sym->attr.result ? sym->ns->proc_name->name + : sym->name); gfc_error ("Procedure pointer %qs at %L shall not be elemental", - sym->name, &sym->declared_at); + name, &sym->declared_at); return false; } if (sym->attr.dummy) @@ -13213,7 +13215,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) if (sym->attr.subroutine && sym->attr.result) { gfc_error ("PROCEDURE attribute conflicts with RESULT attribute " - "in %qs at %L", sym->name, &sym->declared_at); + "in %qs at %L", sym->ns->proc_name->name, &sym->declared_at); return false; } if (sym->attr.external && sym->attr.function && !sym->attr.module_procedure diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 59f602d..b967061 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -2004,9 +2004,12 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where) gfc_error ("Symbol %qs at %L conflicts with symbol from module %qs, " "use-associated at %L", sym->name, where, sym->module, &sym->declared_at); + else if (sym->attr.function && sym->attr.result) + gfc_error ("Symbol %qs at %L already has basic type of %s", + sym->ns->proc_name->name, where, gfc_basic_typename (type)); else gfc_error ("Symbol %qs at %L already has basic type of %s", sym->name, - where, gfc_basic_typename (type)); + where, gfc_basic_typename (type)); return false; } @@ -2024,7 +2027,7 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where) || (flavor == FL_PROCEDURE && sym->attr.subroutine) || flavor == FL_DERIVED || flavor == FL_NAMELIST) { - gfc_error ("Symbol %qs at %L cannot have a type", sym->name, where); + gfc_error ("Symbol %qs at %L cannot have a type", sym->ns->proc_name->name, where); return false; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3594d01..d62db05 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2020-05-20 Mark Eggleston <markeggleston@gcc.gnu.org> + + PR fortran/39695 + * gfortran.dg/pr39695_1.f90: New test. + * gfortran.dg/pr39695_2.f90: New test. + * gfortran.dg/pr39695_3.f90: New test. + * gfortran.dg/pr39695_4.f90: New test. + 2020-05-20 Patrick Palka <ppalka@redhat.com> PR c++/95223 diff --git a/gcc/testsuite/gfortran.dg/pr39695_1.f90 b/gcc/testsuite/gfortran.dg/pr39695_1.f90 new file mode 100644 index 0000000..4c4b304 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr39695_1.f90 @@ -0,0 +1,8 @@ +! { dg-do compile } +! + +function f() + intrinsic :: sin + procedure(sin), pointer :: f ! { dg-error "Procedure pointer 'f'" } + f => sin +end function f diff --git a/gcc/testsuite/gfortran.dg/pr39695_2.f90 b/gcc/testsuite/gfortran.dg/pr39695_2.f90 new file mode 100644 index 0000000..8534724 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr39695_2.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +! + +function g() + interface + subroutine g() + end subroutine g + end interface + pointer g + real g ! { dg-error "Symbol 'g' at .1. cannot have a type" } +end function + diff --git a/gcc/testsuite/gfortran.dg/pr39695_3.f90 b/gcc/testsuite/gfortran.dg/pr39695_3.f90 new file mode 100644 index 0000000..661e254 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr39695_3.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! + +function g() + interface + subroutine g() ! { dg-error "RESULT attribute in 'g'" } + end subroutine g + end interface + real g ! { dg-error "Symbol 'g' at .1. cannot have a type" } +end function + diff --git a/gcc/testsuite/gfortran.dg/pr39695_4.f90 b/gcc/testsuite/gfortran.dg/pr39695_4.f90 new file mode 100644 index 0000000..ecb0a43 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr39695_4.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! + +function g() + implicit none + interface + function g() + integer g + end function g + end interface + pointer g + real g ! { dg-error "Symbol 'g' at .1. already has basic type of INTEGER" } +end function + |