re PR fortran/80554 ([f08] variable redefinition in submodule)

2017-11-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/80554
	* decl.c (build_sym): In a submodule allow overriding of host
	associated symbols from the ancestor module with a new
	declaration.

2017-11-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/80554
	* gfortran.dg/submodule_29.f08: New test.

From-SVN: r254303

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e6ae62f0a59ba69ee111427f7ffa13b6d151d852..da441d906e0329b34e206c7125773107c80c067c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2017-11-01  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from trunk
+       PR fortran/80554
+       * decl.c (build_sym): In a submodule allow overriding of host
+       associated symbols from the ancestor module with a new
+       declaration.
+
+2017-11-01  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/80554
+       * gfortran.dg/submodule_29.f08: New test.
+
 2017-10-20  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        Backport from trunk

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 37ba82bdae9a49c846fcc25e57b0808ff863bc7c..080492b3f4f0fa9de6d98b8e7ace93f4a6ad59d9 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1383,8 +1383,28 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
   symbol_attribute attr;
   gfc_symbol *sym;
   int upper;
+  gfc_symtree *st;
 
-  if (gfc_get_symbol (name, NULL, &sym))
+  /* Symbols in a submodule are host associated from the parent module or
+     submodules. Therefore, they can be overridden by declarations in the
+     submodule scope. Deal with this by attaching the existing symbol to
+     a new symtree and recycling the old symtree with a new symbol...  */
+  st = gfc_find_symtree (gfc_current_ns->sym_root, name);
+  if (st != NULL && gfc_state_stack->state == COMP_SUBMODULE
+      && st->n.sym != NULL
+      && st->n.sym->attr.host_assoc && st->n.sym->attr.used_in_submodule)
+    {
+      gfc_symtree *s = gfc_get_unique_symtree (gfc_current_ns);
+      s->n.sym = st->n.sym;
+      sym = gfc_new_symbol (name, gfc_current_ns);
+
+
+      st->n.sym = sym;
+      sym->refs++;
+      gfc_set_sym_referenced (sym);
+    }
+  /* ...Otherwise generate a new symtree and new symbol.  */
+  else if (gfc_get_symbol (name, NULL, &sym))
     return false;
 
   /* Check if the name has already been defined as a type.  The

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ee8f8d97263a5a73e1036608ffe6847cfe6fda2a..22a47d9b7845b04ac9fbff67da85560b4d9c54b2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2017-11-01  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from trunk
+       PR fortran/80554
+       * gfortran.dg/submodule_29.f08: New test.
+
 2017-10-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        Backport from trunk

diff --git a/gcc/testsuite/gfortran.dg/submodule_29.f08 b/gcc/testsuite/gfortran.dg/submodule_29.f08
new file mode 100644 (file)
index 0000000..98141cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/submodule_29.f08
@@ -0,0 +1,56 @@
+! { dg-do run }
+!
+! Test the fix for PR80554 in which it was not recognised that the symbol 'i'
+! is host associated in the submodule 's' so that the new declaration in the
+! submodule was rejected.
+!
+! Contributed by Tamas Bela Feher  <tamas.bela.feher@ipp.mpg.de>
+!
+module M
+  implicit none
+  integer :: i = 0
+  character (100) :: buffer
+  interface
+    module subroutine write_i()
+    end subroutine
+  end interface
+  interface
+    module subroutine write_i_2()
+    end subroutine
+  end interface
+contains
+  subroutine foo
+    integer :: i
+  end
+end module
+
+submodule (M) S
+    integer :: i = 137
+  contains
+    module subroutine write_i()
+       write (buffer,*) i
+    end subroutine
+end submodule
+
+submodule (M:S) S2
+    integer :: i = 1037
+  contains
+    module subroutine write_i_2()
+       write (buffer,*) i
+    end subroutine
+end submodule
+
+program test_submod_variable
+  use M
+  implicit none
+  integer :: j
+  i = 42
+  call write_i
+  read (buffer, *) j
+  if (i .ne. 42) call abort
+  if (j .ne. 137) call abort
+  call write_i_2
+  read (buffer, *) j
+  if (i .ne. 42) call abort
+  if (j .ne. 1037) call abort
+end program