From c7e4107b537c31cbbd22720935073bb4787e9773 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 18 Mar 2017 11:53:53 +0000 Subject: [PATCH] re PR fortran/71838 (ICE with OpenCoarrays on submodule) 2017-03-18 Paul Thomas 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 PR fortran/71838 * gfortran.dg/submodule_26.f08 : New test. * gfortran.dg/submodule_27.f08 : New test. From-SVN: r246255 --- gcc/fortran/ChangeLog | 9 ++++- gcc/fortran/symbol.c | 16 +++++++- gcc/testsuite/ChangeLog | 6 +++ gcc/testsuite/gfortran.dg/submodule_26.f08 | 46 ++++++++++++++++++++++ gcc/testsuite/gfortran.dg/submodule_27.f08 | 44 +++++++++++++++++++++ 5 files changed, 118 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/submodule_26.f08 create mode 100644 gcc/testsuite/gfortran.dg/submodule_27.f08 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 55dc64981e4..e8d62961f89 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2017-03-18 Paul Thomas + + 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 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. diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 9afa6d029f3..fc79d9970cd 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7178b8e4f51..da22ac21e50 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2017-03-18 Paul Thomas + + PR fortran/71838 + * gfortran.dg/submodule_26.f08 : New test. + * gfortran.dg/submodule_27.f08 : New test. + 2017-03-17 Pat Haugen PR target/79951 diff --git a/gcc/testsuite/gfortran.dg/submodule_26.f08 b/gcc/testsuite/gfortran.dg/submodule_26.f08 new file mode 100644 index 00000000000..6e0ec9a8f39 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/submodule_26.f08 @@ -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 +! Test reduced by Dominique d'Humieres +! +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 diff --git a/gcc/testsuite/gfortran.dg/submodule_27.f08 b/gcc/testsuite/gfortran.dg/submodule_27.f08 new file mode 100644 index 00000000000..1439c38cb9a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/submodule_27.f08 @@ -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 +! Test reduced by Dominique d'Humieres +! +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 -- 2.30.2