diff mbox series

PR fortran/78719 -- Check for a CLASS

Message ID 20190817005954.GA54929@troutmask.apl.washington.edu
State New
Headers show
Series PR fortran/78719 -- Check for a CLASS | expand

Commit Message

Steve Kargl Aug. 17, 2019, 12:59 a.m. UTC 
Regression tested on x86_64-*-freebsd.  OK to commit?

When checking to see in attrbutes are being added to
an entity that alrady has an explcit interface, gfortran
failed to consider the case of CLASS.  The attach patch
corrects this omission.  See the 3 testcases for clarity.

2019-08-16  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-16  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.

Comments

Janne Blomqvist Aug. 17, 2019, 5:51 a.m. UTC | #1 
On Sat, Aug 17, 2019 at 4:00 AM Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
>
> Regression tested on x86_64-*-freebsd.  OK to commit?
>
> When checking to see in attrbutes are being added to
> an entity that alrady has an explcit interface, gfortran
> failed to consider the case of CLASS.  The attach patch
> corrects this omission.  See the 3 testcases for clarity.
>
> 2019-08-16  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-16  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.

Ok, thanks.
diff mbox series

Patch

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 274578)
+++ gcc/fortran/decl.c	(working copy)
@@ -1363,9 +1363,9 @@  get_proc_name (const char *name, gfc_symbol **result, 
 	}
 
       /* 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
Index: gcc/testsuite/gfortran.dg/pr78719_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr78719_1.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr78719_1.f90	(working copy)
@@ -0,0 +1,29 @@ 
+! { 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
Index: gcc/testsuite/gfortran.dg/pr78719_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr78719_2.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr78719_2.f90	(working copy)
@@ -0,0 +1,32 @@ 
+! { 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" }
Index: gcc/testsuite/gfortran.dg/pr78719_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr78719_3.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr78719_3.f90	(working copy)
@@ -0,0 +1,32 @@ 
+! { 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" }