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.

Backported from master.

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.

	(cherry picked from commit eb069ae8819c3a84d7f78becc5501e21ee3a9554)

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fdee74988e03f4ae7ac0974056e9549428b61012..3e7f3c7636036235bd24e19a512d6a90a92e5fb8 100644 (file)
--- 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-13  Mark Eggleston  <markeggleston@gcc.gnu.org>
 
        Backported from master

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index a48499dbf7fc331161c74fa2bf023d191dbd742d..19f05ab884f7a9ff84f5276e2849d14944204d21 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12786,8 +12786,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)
@@ -12874,7 +12876,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 faaeebf2c0989542ed0886f075395465c131c668..801a7733fef8152ee9a7780e53f2ba49c50465ec 100644 (file)
--- 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 4a31aea619fcee3c5075d4623956a2bebe0d24a3..667a1edefeab5945fd79427c25a7a732fe74eb32 100644 (file)
--- 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-18  Doug Rupp  <rupp@adacore.com>
 
        * gcc.target/powerpc/pr71763.c: Require powerpc_vsx_ok.

diff --git a/gcc/testsuite/gfortran.dg/pr39695_1.f90 b/gcc/testsuite/gfortran.dg/pr39695_1.f90
new file mode 100644 (file)
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 (file)
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 (file)
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 (file)
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
+