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

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
This commit is contained in:
Steven G. Kargl 2019-08-17 14:27:07 +00:00
parent 4f81c2a3c5
commit 1c3925e32a
6 changed files with 109 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
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

6
gcc/fortran/decl.c
View File

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

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
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

29
gcc/testsuite/gfortran.dg/pr78719_1.f90 Normal file
View File

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

32
gcc/testsuite/gfortran.dg/pr78719_2.f90 Normal file
View File

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

32
gcc/testsuite/gfortran.dg/pr78719_3.f90 Normal file
View File

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