I also forgot the attachment
. ***duuuh***
On 26 February 2017 at 16:01, Paul Richard Thomas
<paul.richard.tho...@gmail.com> wrote:
> I forgot to switch on 'plain text' mode - apologies
>
> Paul
>
> On 26 February 2017 at 15:58, Paul Richard Thomas
> <paul.richard.tho...@gmail.com> wrote:
>>
>> Dear All,
>>
>> The title in this PR turned out to be a red herring. The problem is with a
>> procedure being a dummy in a submodule module procedure declaration; most
>> particularly the abreviated form.
>>
>> The comments in the fix render the patch self-explanatory.
>>
>> Bootstrapped and regtested on FC23/x86_64 - OK for trunk and a few weeks
>> later 6-branch?
>>
>> Cheers
>>
>> Paul
>>
>> 2017-02-26 Paul Thomas <pa...@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-02-26 Paul Thomas <pa...@gcc.gnu.org>
>>
>> PR fortran/71838
>> * gfortran.dg/submodule_26.f08 : New test.
>> * gfortran.dg/submodule_27.f08 : New test.
>>
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Index: gcc/fortran/symbol.c
===================================================================
*** gcc/fortran/symbol.c (revision 245602)
--- gcc/fortran/symbol.c (working copy)
*************** check_conflict (symbol_attribute *attr,
*** 474,481 ****
}
}
! if (attr->dummy && ((attr->function || attr->subroutine) &&
! gfc_current_state () == COMP_CONTAINS))
gfc_error_now ("internal procedure %qs at %L conflicts with "
"DUMMY argument", name, where);
--- 474,486 ----
}
}
! /* 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);
*************** gfc_add_flavor (symbol_attribute *attr,
*** 1646,1651 ****
--- 1651,1663 ----
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)
Index: gcc/testsuite/gfortran.dg/submodule_26.f08
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_26.f08 (nonexistent)
--- gcc/testsuite/gfortran.dg/submodule_26.f08 (working copy)
***************
*** 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 <me...@bristol.ac.uk>
+ ! Test reduced by Dominique d'Humieres <domi...@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
Index: gcc/testsuite/gfortran.dg/submodule_27.f08
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_27.f08 (nonexistent)
--- gcc/testsuite/gfortran.dg/submodule_27.f08 (working copy)
***************
*** 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 <me...@bristol.ac.uk>
+ ! Test reduced by Dominique d'Humieres <domi...@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
