OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fortran : ProcPtr function results: 'ppr@' in error message PR39695 

The value 'ppr@' is set in the name of result symbol, the actual
name of the symbol is in the procedure name symbol pointed
to by the result symbol's namespace (ns). When reporting errors for
symbols that have the proc_pointer attribute check whether the
result attribute is set and set the name accordingly.

2020-05-20  Mark Eggleston  <markeggleston@gcc.gnu.org>

gcc/fortran/

	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-20  Mark Eggleston  <markeggleston@gcc.gnu.org>

gcc/testsuite/

	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.
This commit is contained in:
Mark Eggleston 2020-05-07 08:02:02 +01:00
parent 4623a6f2d0
commit eb069ae881
8 changed files with 73 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -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

6
gcc/fortran/resolve.c
View File

@ -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

7
gcc/fortran/symbol.c
View File

@ -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;
}

8
gcc/testsuite/ChangeLog
View File

@ -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

8
gcc/testsuite/gfortran.dg/pr39695_1.f90 Normal file
View File

@ -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

12
gcc/testsuite/gfortran.dg/pr39695_2.f90 Normal file
View File

@ -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

11
gcc/testsuite/gfortran.dg/pr39695_3.f90 Normal file
View File

@ -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

14
gcc/testsuite/gfortran.dg/pr39695_4.f90 Normal file
View File

@ -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