re PR fortran/78719 ([F03] ICE in gfc_get_symbol_decl, at fortran/trans-decl.c:1438)

2019-08-17  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/78719
	* decl.c (get_proc_name): Check for a CLASS entity when trying to
	add attributes to an entity that already has an explicit interface.

2019-08-17  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/78719
	* gfortran.dg/pr78719_1.f90: New test.
	* gfortran.dg/pr78719_2.f90: Ditto.
	* gfortran.dg/pr78719_3.f90: Ditto.

From-SVN: r274604

gcc/fortran/ChangeLog

 2019-08-17  Steven G. Kargl  <kargl@gcc.gnu.org>
 
+	PR fortran/78719
+	* decl.c (get_proc_name): Check for a CLASS entity when trying to
+	add attributes to an entity that already has an explicit interface.
+
+2019-08-17  Steven G. Kargl  <kargl@gcc.gnu.org>
+
 	PR fortran/91471
 	* primary.c (gfc_variable_attr): Remove a gfc_internal_error(),
 	which cannot be reached by conforming Fortran code, but seems to

gcc/fortran/decl.c

@@ -1363,9 +1363,9 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
 	}
 
       /* Trap declarations of attributes in encompassing scope.  The
-	 signature for this is that ts.kind is set.  Legitimate
-	 references only set ts.type.  */
-      if (sym->ts.kind != 0
+	 signature for this is that ts.kind is nonzero for no-CLASS
+	 entity.  For a CLASS entity, ts.kind is zero.  */
+      if ((sym->ts.kind != 0 || sym->ts.type == BT_CLASS)
 	  && !sym->attr.implicit_type
 	  && sym->attr.proc == 0
 	  && gfc_current_ns->parent != NULL

gcc/testsuite/ChangeLog

 2019-08-17  Steven G. Kargl  <kargl@gcc.gnu.org>
 
+	PR fortran/78719
+	* gfortran.dg/pr78719_1.f90: New test.
+	* gfortran.dg/pr78719_2.f90: Ditto.
+	* gfortran.dg/pr78719_3.f90: Ditto.
+
+2019-08-17  Steven G. Kargl  <kargl@gcc.gnu.org>
+
 	PR fortran/91471
 	* gfortran.dg/pr91471.f90: New test.
 

gcc/testsuite/gfortran.dg/pr78719_1.f90

+! { dg-do run }
+! PR fortran/78719
+! Code contributed by Gerhard Steinmetz 
+program p
+
+   type t
+      integer :: n
+   end type
+
+   abstract interface
+      subroutine h
+      end
+   end interface
+
+   procedure(h), pointer :: s
+
+   s => f
+   call s
+   s => g
+   call s
+
+   contains
+
+      subroutine f
+      end
+
+      subroutine g
+      end
+end program p

gcc/testsuite/gfortran.dg/pr78719_2.f90

+! { dg-do compile }
+! PR fortran/78719
+! Code contributed by Gerhard Steinmetz 
+program p
+
+   type t
+      integer :: n
+   end type
+
+   real :: g
+
+   abstract interface
+      subroutine h
+      end
+   end interface
+
+   procedure(h), pointer :: s
+
+   s => f
+   call s
+   s => g            ! { dg-error "Invalid procedure pointer" }
+   call s
+
+   contains
+
+      subroutine f
+      end
+
+      subroutine g   ! { dg-error "has an explicit interface" }
+      end
+
+end program p        ! { dg-error "Syntax error" }

gcc/testsuite/gfortran.dg/pr78719_3.f90

+! { dg-do compile }
+! PR fortran/78719
+! Code contributed by Gerhard Steinmetz 
+program p
+
+   type t
+      integer :: n
+   end type
+
+   class(t) :: g     ! { dg-error "must be dummy, allocatable or pointer" }
+
+   abstract interface
+      subroutine h
+      end
+   end interface
+
+   procedure(h), pointer :: s
+
+   s => f
+   call s
+   s => g            ! { dg-error "Invalid procedure pointer" }
+   call s
+
+   contains
+
+      subroutine f
+      end
+
+      subroutine g   ! { dg-error "has an explicit interface" }
+      end
+
+end program p        ! { dg-error "Syntax error" }