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:
parent
251daa19a4
commit
c7e4107b53
|
@ -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.
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
|
@ -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
|
Loading…
Reference in New Issue