From: Paul Thomas <pault@gcc.gnu.org>
Date: Sun, 19 Feb 2017 18:27:14 +0000 (+0000)
Subject: re PR fortran/79402 (ICE with submodules: module procedure interface defined in paren... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=dea71ad06f751484f3eb5c52bf12622e4c06b33a;p=gcc.git

re PR fortran/79402 (ICE with submodules: module procedure interface defined in parent module)

2017-02-19  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/79402
	* resolve.c (fixup_unique_dummy): New function.
	(gfc_resolve_expr): Call it for dummy variables with a unique
	symtree name.

2017-02-19  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/79402
	* gfortran.dg/submodule_23.f90: New test.

From-SVN: r245580
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f7a89cca0ec..82733be6fa4 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+017-02-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/79402
+	* resolve.c (fixup_unique_dummy): New function.
+	(gfc_resolve_expr): Call it for dummy variables with a unique
+	symtree name.
+
 2017-02-19  Andre Vehreschild  <vehre@gcc.gnu.org>
 
 	PR fortran/79335
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index a5fe2314372..876f3cd5d8c 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6433,6 +6433,31 @@ gfc_is_expandable_expr (gfc_expr *e)
   return false;
 }
 
+
+/* Sometimes variables in specification expressions of the result
+   of module procedures in submodules wind up not being the 'real'
+   dummy.  Find this, if possible, in the namespace of the first
+   formal argument.  */
+
+static void
+fixup_unique_dummy (gfc_expr *e)
+{
+  gfc_symtree *st = NULL;
+  gfc_symbol *s = NULL;
+
+  if (e->symtree->n.sym->ns->proc_name
+      && e->symtree->n.sym->ns->proc_name->formal)
+    s = e->symtree->n.sym->ns->proc_name->formal->sym;
+
+  if (s != NULL)
+    st = gfc_find_symtree (s->ns->sym_root, e->symtree->n.sym->name);
+
+  if (st != NULL
+      && st->n.sym != NULL
+      && st->n.sym->attr.dummy)
+    e->symtree = st;
+}
+
 /* Resolve an expression.  That is, make sure that types of operands agree
    with their operators, intrinsic operators are converted to function calls
    for overloaded types and unresolved function references are resolved.  */
@@ -6457,6 +6482,14 @@ gfc_resolve_expr (gfc_expr *e)
       actual_arg = false;
       first_actual_arg = false;
     }
+  else if (e->symtree != NULL
+	   && *e->symtree->name == '@'
+	   && e->symtree->n.sym->attr.dummy)
+    {
+      /* Deal with submodule specification expressions that are not
+	 found to be referenced in module.c(read_cleanup).  */
+      fixup_unique_dummy (e);
+    }
 
   switch (e->expr_type)
     {
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 097cab4b5b8..ada192093af 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-02-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/79402
+	* gfortran.dg/submodule_23.f90: New test.
+
 2017-02-19  Paolo Carlini  <paolo.carlini@oracle.com>
 
 	PR c++/79380
@@ -142,7 +147,7 @@
 
 	PR target/79481
 	* gcc.target/i386/sse-14.c (test_2vx): Add void return type.
-	(test_3vx): Change return type from int to void. 
+	(test_3vx): Change return type from int to void.
 	(_mm512_prefetch_i32gather_ps, _mm512_prefetch_i32scatter_ps,
 	_mm512_prefetch_i64gather_ps, _mm512_prefetch_i64scatter_ps,
 	_mm512_prefetch_i32gather_pd, _mm512_prefetch_i32scatter_pd,
diff --git a/gcc/testsuite/gfortran.dg/submodule_23.f90 b/gcc/testsuite/gfortran.dg/submodule_23.f90
new file mode 100644
index 00000000000..63674fb4993
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/submodule_23.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! Test the fix for PR79402, in which the module procedure 'fun1' picked
+! up a spurious symbol for the dummy 'n' in the specification expression
+! for the result 'y'.
+!
+! Contributed by Chris Coutinho  <chrisbcoutinho@gmail.com>
+!
+module mod
+  interface myfun
+    module function fun1(n) result(y)
+      integer,  intent(in)    :: n
+      real, dimension(n)  :: y
+    end function fun1
+  end interface myfun
+
+end module mod
+
+submodule (mod) submod
+contains
+  module procedure fun1
+    integer :: i
+    y = [(float (i), i = 1, n)]
+  end procedure fun1
+end submodule
+
+  use mod
+  print *, fun1(10)
+end