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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 55dc64981e4b6aed7cb42b5092332acf47fff4f1..e8d62961f8906d763258f28b4797c4fc1ec3cf07 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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.

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 9afa6d029f322729ea53e9b290a62dce6557359e..fc79d9970cdcaf0cebd81a5ea10aeafff685b5ff 100644 (file)
--- 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 7178b8e4f51ade4bac9416746ade461555e073cd..da22ac21e50e84c06255795212f8f18f275e15b0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/submodule_26.f08 b/gcc/testsuite/gfortran.dg/submodule_26.f08
new file mode 100644 (file)
index 0000000..6e0ec9a
--- /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  <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

diff --git a/gcc/testsuite/gfortran.dg/submodule_27.f08 b/gcc/testsuite/gfortran.dg/submodule_27.f08
new file mode 100644 (file)
index 0000000..1439c38
--- /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  <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