re PR fortran/71838 (ICE with OpenCoarrays on submodule)

2017-03-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/71838
	* symbol.c (check_conflict): A dummy procedure in a submodule,
	module procedure is not an error.
	(gfc_add_flavor): Ditto.

2017-03-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/71838
	* gfortran.dg/submodule_26.f08 : New test.
	* gfortran.dg/submodule_27.f08 : New test.

From-SVN: r246255
This commit is contained in:
Paul Thomas 2017-03-18 11:53:53 +00:00
parent 251daa19a4
commit c7e4107b53
5 changed files with 118 additions and 3 deletions

View File

@ -1,3 +1,10 @@
2017-03-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/71838
* symbol.c (check_conflict): A dummy procedure in a submodule,
module procedure is not an error.
(gfc_add_flavor): Ditto.
2017-03-17 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/79841
@ -46,7 +53,7 @@
* gfortran.texi: Added description for the new API functions. Updated
coverage of gfortran of TS18508.
* intrinsic.c (add_functions): Added symbols to resolve new intrinsic
functions.
functions.
* intrinsic.h: Added prototypes.
* iresolve.c (gfc_resolve_failed_images): Resolve the failed_images
intrinsic.

View File

@ -474,8 +474,13 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
}
}
if (attr->dummy && ((attr->function || attr->subroutine) &&
gfc_current_state () == COMP_CONTAINS))
/* The copying of procedure dummy arguments for module procedures in
a submodule occur whilst the current state is COMP_CONTAINS. It
is necessary, therefore, to let this through. */
if (attr->dummy
&& (attr->function || attr->subroutine)
&& gfc_current_state () == COMP_CONTAINS
&& !(gfc_new_block && gfc_new_block->abr_modproc_decl))
gfc_error_now ("internal procedure %qs at %L conflicts with "
"DUMMY argument", name, where);
@ -1646,6 +1651,13 @@ gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name,
if (attr->flavor == f && f == FL_VARIABLE)
return true;
/* Copying a procedure dummy argument for a module procedure in a
submodule results in the flavor being copied and would result in
an error without this. */
if (gfc_new_block && gfc_new_block->abr_modproc_decl
&& attr->flavor == f && f == FL_PROCEDURE)
return true;
if (attr->flavor != FL_UNKNOWN)
{
if (where == NULL)

View File

@ -1,3 +1,9 @@
2017-03-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/71838
* gfortran.dg/submodule_26.f08 : New test.
* gfortran.dg/submodule_27.f08 : New test.
2017-03-17 Pat Haugen <pthaugen@us.ibm.com>
PR target/79951

View File

@ -0,0 +1,46 @@
! { dg-do compile }
! { dg-options "-fcoarray=single" }
!
! Tests the fix for PR71838 in which the PROCEDURE dummy argument caused
! an ICE in the submodule. This is the reduced test in comment #9.
!
! Contributed by Anton Shterenlikht <mexas@bristol.ac.uk>
! Test reduced by Dominique d'Humieres <dominiq@lps.ens.fr>
!
module cgca_m3clvg
abstract interface
subroutine cgca_clvgs_abstract( farr, marr, n, cstate, debug, &
newstate )
integer, parameter :: iarr = 4, idef = 4, rdef = 4, ldef = 4
integer, parameter :: l=-1, centre=l+1, u=centre+1
integer( kind=iarr ), intent(in) :: farr(l:u,l:u,l:u), &
marr(l:u,l:u,l:u), cstate
real( kind=rdef ), intent(in) :: n(3)
logical( kind=ldef ), intent(in) :: debug
integer( kind=iarr ), intent(out) :: newstate
end subroutine cgca_clvgs_abstract
end interface
interface
module subroutine cgca_clvgp( coarray, rt, t, scrit, sub, gcus, &
periodicbc, iter, heartbeat, debug )
integer, parameter :: iarr = 4, idef = 4, rdef = 4, ldef = 4
integer( kind=iarr ), allocatable, intent(inout) :: &
coarray(:,:,:,:)[:,:,:]
real( kind=rdef ), allocatable, intent(inout) :: rt(:,:,:)[:,:,:]
real( kind=rdef ), intent(in) :: t(3,3), scrit(3)
procedure( cgca_clvgs_abstract ) :: sub
logical( kind=ldef ), intent(in) :: periodicbc
integer( kind=idef ), intent(in) :: iter, heartbeat
logical( kind=ldef ), intent(in) :: debug
end subroutine cgca_clvgp
end interface
end module cgca_m3clvg
submodule ( cgca_m3clvg ) m3clvg_sm3
implicit none
contains
module procedure cgca_clvgp
end procedure cgca_clvgp
end submodule m3clvg_sm3

View File

@ -0,0 +1,44 @@
! { dg-do run }
!
! Tests the fix for PR71838 in which the PROCEDURE dummy argument caused
! an ICE in the submodule. This an executable version of the reduced test
! in comment #11.
!
! Contributed by Anton Shterenlikht <mexas@bristol.ac.uk>
! Test reduced by Dominique d'Humieres <dominiq@lps.ens.fr>
!
subroutine hello (message)
character (7), intent(inout) :: message
message = "hello "
end
module cgca_m3clvg
interface
subroutine cgca_clvgs_abstract(message)
character (7), intent(inout) :: message
end subroutine cgca_clvgs_abstract
end interface
interface
module subroutine cgca_clvgp(sub)
procedure( cgca_clvgs_abstract ) :: sub
end subroutine cgca_clvgp
end interface
character (7) :: greeting
end module cgca_m3clvg
submodule ( cgca_m3clvg ) m3clvg_sm3
implicit none
contains
module procedure cgca_clvgp
call sub (greeting)
end procedure cgca_clvgp
end submodule m3clvg_sm3
use cgca_m3clvg
external hello
greeting = "goodbye"
call cgca_clvgp (hello)
if (trim (greeting) .ne. "hello") call abort
end