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

re PR fortran/77414 (ICE in create_function_arglist, at fortran/trans-decl.c:2410) 

2018-03-19  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/77414
	* decl.c (get_proc_name):  Check for a subroutine re-defined in
	the contain portion of a subroutine.  Change language of existing
	error message to better describe the issue. While here fix whitespace
	issues.

2018-03-19  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/77414
	* gfortran.dg/pr77414.f90: New test.
	* gfortran.dg/internal_references_1.f90: Adjust error message.

From-SVN: r258654
This commit is contained in:
Steven G. Kargl 2018-03-19 18:54:29 +00:00
parent 945ac36cf9
commit 18df884dbf
5 changed files with 43 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -1,3 +1,11 @@
2018-03-19 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/77414
* decl.c (get_proc_name): Check for a subroutine re-defined in
the contain portion of a subroutine. Change language of existing
error message to better describe the issue. While here fix whitespace
issues.
2018-03-19 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/65453

25
gcc/fortran/decl.c
View File

@ -1129,14 +1129,12 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
if (sym->attr.proc == PROC_ST_FUNCTION)
return rc;
if (sym->attr.module_procedure
&& sym->attr.if_source == IFSRC_IFBODY)
if (sym->attr.module_procedure && sym->attr.if_source == IFSRC_IFBODY)
{
/* Create a partially populated interface symbol to carry the
characteristics of the procedure and the result. */
sym->tlink = gfc_new_symbol (name, sym->ns);
gfc_add_type (sym->tlink, &(sym->ts),
&gfc_current_locus);
gfc_add_type (sym->tlink, &(sym->ts), &gfc_current_locus);
gfc_copy_attr (&sym->tlink->attr, &sym->attr, NULL);
if (sym->attr.dimension)
sym->tlink->as = gfc_copy_array_spec (sym->as);
@ -1201,7 +1199,16 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
&& sym->attr.access == 0
&& !module_fcn_entry)
gfc_error_now ("Procedure %qs at %C has an explicit interface "
"and must not have attributes declared at %L",
"from a previous declaration", name);
}
if (sym && !sym->gfc_new
&& sym->attr.flavor != FL_UNKNOWN
&& sym->attr.referenced == 0 && sym->attr.subroutine == 1
&& gfc_state_stack->state == COMP_CONTAINS
&& gfc_state_stack->previous->state == COMP_SUBROUTINE)
{
gfc_error_now ("Procedure %qs at %C is already defined at %L",
name, &sym->declared_at);
}
@ -1226,10 +1233,10 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
/* See if the procedure should be a module procedure. */
if (((sym->ns->proc_name != NULL
&& sym->ns->proc_name->attr.flavor == FL_MODULE
&& sym->attr.proc != PROC_MODULE)
|| (module_fcn_entry && sym->attr.proc != PROC_MODULE))
&& !gfc_add_procedure (&sym->attr, PROC_MODULE, sym->name, NULL))
&& sym->ns->proc_name->attr.flavor == FL_MODULE
&& sym->attr.proc != PROC_MODULE)
|| (module_fcn_entry && sym->attr.proc != PROC_MODULE))
&& !gfc_add_procedure (&sym->attr, PROC_MODULE, sym->name, NULL))
rc = 2;
return rc;

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2018-03-19 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/77414
* gfortran.dg/pr77414.f90: New test.
* gfortran.dg/internal_references_1.f90: Adjust error message.
2018-03-19 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/65453

7
gcc/testsuite/gfortran.dg/internal_references_1.f90
View File

@ -11,7 +11,7 @@ module m
implicit none
contains
subroutine p (i) ! { dg-error "is already defined" }
subroutine p (i) ! { dg-error "(1)" }
integer :: i
end subroutine
@ -22,14 +22,15 @@ end module
!
! PR25124 - would happily ignore the declaration of foo in the main program.
program test
real :: foo, x ! { dg-error "explicit interface and must not have attributes declared" }
real :: foo, x
x = bar () ! This is OK because it is a regular reference.
x = foo ()
contains
function foo () ! { dg-error "explicit interface and must not have attributes declared" }
function foo () ! { dg-error "explicit interface from a previous" }
foo = 1.0
end function foo
function bar ()
bar = 1.0
end function bar
end program test

9
gcc/testsuite/gfortran.dg/pr77414.f90 Normal file
View File

@ -0,0 +1,9 @@
! { dg-do compile }
! PR fortran/77414
subroutine a(x) ! { dg-error "(1)" }
character(*) :: x
contains
subroutine a(x) ! { dg-error " is already defined at" }
character(*) :: x
end subroutine a
end subroutine a