Dear All,
These are two rather trivial modifications to permit, 'module' to
appear at any position in the list of prefixes in the procedure
declaration and to allow module procedures to appear within a module
contains section. I was rather astonished at this latter since it does
seem to be rather contrary to having an module interface declaration
for the same procedure. However, from the Fortran 2008 standard:
C1247 (R1225) MODULE shall appear only in the function-stmt or
subroutine-stmt of a module subprogram or of a nonabstract interface
body that is declared in the scoping unit of a module or submodule.
Whilst I was about it, I prevented an ICE from occurring following the
error generated by decl.c(copy_prefix), when prefixes in the interface
are repeated in the procedure declaration. I have not included a test
for this, since I am not convinced that repeating the prefixes is
strictly speaking an error. In fact, it would make a lot of sense to
repeat the interface declaration completely in the submodule
declaration. I will investigate further before committing. The fix is
even more trivial than preventing the ICE.
Since the patch is entirely permissive, it will not prevent correct
code from compiling. In this sense, it is safe for stage 4.
Bootstrapped and regtested on FC21/x86_64. OK for trunk?
Best regards
Paul
2016-03-06 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/70031
* decl.c (gfc_match_prefix): Treat the 'module' prefix in the
same way as the others, rather than fixing it to come last.
(gfc_match_function_decl, gfc_match_subroutine): After errors
in 'copy_prefix', emit them immediately in the case of module
procedures to prevent a later ICE.
PR fortran/69524
* decl.c (gfc_match_submod_proc): Permit 'module procedure'
declarations within the contains section of modules as well as
submodules.
* resolve.c (resolve_fl_procedure): Likewise.
*trans-decl.c (build_function_decl): Change the gcc_assert to
allow all forms of module procedure declarations within module
contains sections.
2016-03-06 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/70031
* gfortran.dg/submodule_14.f08: New test
PR fortran/69524
* gfortran.dg/submodule_15.f08: New test
Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c (revision 233937)
--- gcc/fortran/decl.c (working copy)
*************** gfc_match_prefix (gfc_typespec *ts)
*** 4606,4611 ****
--- 4606,4624 ----
{
found_prefix = false;
+ /* MODULE is a prefix like PURE, ELEMENTAL, etc., having a
+ corresponding attribute seems natural and distinguishes these
+ procedures from procedure types of PROC_MODULE, which these are
+ as well. */
+ if (gfc_match ("module% ") == MATCH_YES)
+ {
+ if (!gfc_notify_std (GFC_STD_F2008, "MODULE prefix at %C"))
+ goto error;
+
+ current_attr.module_procedure = 1;
+ found_prefix = true;
+ }
+
if (!seen_type && ts != NULL
&& gfc_match_decl_type_spec (ts, 0) == MATCH_YES
&& gfc_match_space () == MATCH_YES)
*************** gfc_match_prefix (gfc_typespec *ts)
*** 4670,4690 ****
/* At this point, the next item is not a prefix. */
gcc_assert (gfc_matching_prefix);
- /* MODULE should be the last prefix before FUNCTION or SUBROUTINE.
- Since this is a prefix like PURE, ELEMENTAL, etc., having a
- corresponding attribute seems natural and distinguishes these
- procedures from procedure types of PROC_MODULE, which these are
- as well. */
- if ((gfc_current_state () == COMP_INTERFACE
- || gfc_current_state () == COMP_CONTAINS)
- && gfc_match ("module% ") == MATCH_YES)
- {
- if (!gfc_notify_std (GFC_STD_F2008, "MODULE prefix at %C"))
- goto error;
- else
- current_attr.module_procedure = 1;
- }
-
gfc_matching_prefix = false;
return MATCH_YES;
--- 4683,4688 ----
*************** gfc_match_function_decl (void)
*** 5639,5647 ****
if (!gfc_add_function (&sym->attr, sym->name, NULL))
goto cleanup;
! if (!gfc_missing_attr (&sym->attr, NULL)
! || !copy_prefix (&sym->attr, &sym->declared_at))
goto cleanup;
/* Delay matching the function characteristics until after the
specification block by signalling kind=-1. */
--- 5637,5652 ----
if (!gfc_add_function (&sym->attr, sym->name, NULL))
goto cleanup;
! if (!gfc_missing_attr (&sym->attr, NULL))
! goto cleanup;
!
! if (!copy_prefix (&sym->attr, &sym->declared_at))
! {
! if(!sym->attr.module_procedure)
goto cleanup;
+ else
+ gfc_error_check ();
+ }
/* Delay matching the function characteristics until after the
specification block by signalling kind=-1. */
*************** gfc_match_function_decl (void)
*** 5666,5671 ****
--- 5671,5677 ----
sym->result = result;
}
+
/* Warn if this procedure has the same name as an intrinsic. */
do_warn_intrinsic_shadow (sym, true);
*************** gfc_match_subroutine (void)
*** 6108,6114 ****
--- 6114,6125 ----
}
if (!copy_prefix (&sym->attr, &sym->declared_at))
+ {
+ if(!sym->attr.module_procedure)
return MATCH_ERROR;
+ else
+ gfc_error_check ();
+ }
/* Warn if it has the same name as an intrinsic. */
do_warn_intrinsic_shadow (sym, false);
*************** gfc_match_submod_proc (void)
*** 7697,7703 ****
if (gfc_current_state () != COMP_CONTAINS
|| !(gfc_state_stack->previous
! && gfc_state_stack->previous->state == COMP_SUBMODULE))
return MATCH_NO;
m = gfc_match (" module% procedure% %n", name);
--- 7708,7715 ----
if (gfc_current_state () != COMP_CONTAINS
|| !(gfc_state_stack->previous
! && (gfc_state_stack->previous->state == COMP_SUBMODULE
! || gfc_state_stack->previous->state == COMP_MODULE)))
return MATCH_NO;
m = gfc_match (" module% procedure% %n", name);
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 233937)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_fl_procedure (gfc_symbol *sym, i
*** 11905,11911 ****
"in %qs at %L", sym->name, &sym->declared_at);
return false;
}
! if (sym->attr.external && sym->attr.function
&& ((sym->attr.if_source == IFSRC_DECL && !sym->attr.procedure)
|| sym->attr.contained))
{
--- 11905,11911 ----
"in %qs at %L", sym->name, &sym->declared_at);
return false;
}
! if (sym->attr.external && sym->attr.function &&
!sym->attr.module_procedure
&& ((sym->attr.if_source == IFSRC_DECL && !sym->attr.procedure)
|| sym->attr.contained))
{
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c (revision 233937)
--- gcc/fortran/trans-decl.c (working copy)
*************** build_function_decl (gfc_symbol * sym, b
*** 2062,2068 ****
tree result_decl;
gfc_formal_arglist *f;
! gcc_assert (!sym->attr.external);
if (sym->backend_decl)
return;
--- 2062,2073 ----
tree result_decl;
gfc_formal_arglist *f;
! bool module_procedure = sym->attr.module_procedure
! && sym->ns
! && sym->ns->proc_name
! && sym->ns->proc_name->attr.flavor == FL_MODULE;
!
! gcc_assert (!sym->attr.external || module_procedure);
if (sym->backend_decl)
return;
Index: gcc/testsuite/gfortran.dg/submodule_14.f08
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_14.f08 (revision 0)
--- gcc/testsuite/gfortran.dg/submodule_14.f08 (working copy)
***************
*** 0 ****
--- 1,49 ----
+ ! { dg-do compile }
+ !
+ ! Check the fix for PR70031, where the 'module' prefix had to preceed
+ ! 'function/subroutine' in the interface (or in the CONTAINS section.
+ !
+ ! As reported by "Bulova" on
+ ! https://groups.google.com/forum/#!topic/comp.lang.fortran/hE8LkVMhghQ
+ !
+ module test
+ Interface
+ Module Recursive Subroutine sub1 (x)
+ Integer, Intent (InOut) :: x
+ End Subroutine sub1
+ module recursive function fcn1 (x) result(res)
+ integer, intent (inout) :: x
+ integer :: res
+ end function
+ End Interface
+ end module test
+
+ submodule(test) testson
+ integer :: n = 10
+ contains
+ Module Procedure sub1
+ If (x < n) Then
+ x = x + 1
+ Call sub1 (x)
+ End If
+ End Procedure sub1
+ module function fcn1 (x) result(res)
+ integer, intent (inout) :: x
+ integer :: res
+ res = x - 1
+ if (x > 0) then
+ x = fcn1 (res)
+ else
+ res = x
+ end if
+ end function
+ end submodule testson
+
+ use test
+ integer :: x = 5
+ call sub1(x)
+ if (x .ne. 10) call abort
+ x = 10
+ if (fcn1 (x) .ne. 0) call abort
+ end
+
Index: gcc/testsuite/gfortran.dg/submodule_15.f08
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_15.f08 (revision 0)
--- gcc/testsuite/gfortran.dg/submodule_15.f08 (working copy)
***************
*** 0 ****
--- 1,58 ----
+ ! { dg-do run }
+ !
+ ! Check the fix for PR69524, where module procedures were not permitted
+ ! in a module CONTAINS section.
+ !
+ ! Reorted by Kirill Yukhin <kyuk...@gcc.gnu.org>
+ !
+ module A
+ implicit none
+ interface
+ module subroutine A1(i)
+ integer, intent(inout) :: i
+ end subroutine A1
+ module subroutine A2(i)
+ integer, intent(inout) :: i
+ end subroutine A2
+ integer module function A3(i)
+ integer, intent(inout) :: i
+ end function A3
+ module subroutine B1(i)
+ integer, intent(inout) :: i
+ end subroutine B1
+ end interface
+ integer :: incr ! Make sure that everybody can access a module
variable
+ contains
+ module subroutine A1(i) ! Full declaration
+ integer, intent(inout) :: i
+ call b1 (i) ! Call the submodule procedure
+ incr = incr + 1
+ end subroutine A1
+
+ module PROCEDURE A2 ! Abreviated declaration
+ call b1 (i) ! Call the submodule procedure
+ incr = incr + 1
+ end procedure A2
+
+ module PROCEDURE A3 ! Abreviated declaration
+ call a1 (i) ! Call the module procedure in the module
+ call a2 (i) ! ditto
+ call b1 (i) ! Call the submodule procedure
+ incr = incr + 1
+ a3 = i + incr
+ end procedure A3
+ end module A
+
+ submodule (A) a_son
+ implicit none
+ contains
+ module procedure b1
+ i = i + incr
+ end procedure
+ end submodule
+
+ use A
+ integer :: i = 1
+ incr = 1
+ if (a3(i) .ne. 11) call abort
+ end
