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
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
PR fortran/78719
* gfortran.dg/pr78719_1.f90: New test.
* gfortran.dg/pr78719_2.f90: Ditto.
* gfortran.dg/pr78719_3.f90: Ditto.
--
Steve
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" }
