re PR fortran/79434 ([submodules] separate module procedure breaks encapsulation)

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

	PR fortran/79434
	* parse.c (check_component, parse_union): Whitespace.
	(set_syms_host_assoc): For a derived type, check if the module
	in which it was declared is one of the submodule ancestors. If
	it is, make the components public. Otherwise, reset attribute
	'host_assoc' and set 'use-assoc' so that encapsulation is
	preserved.

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

	PR fortran/79434
	* gfortran.dg/submodule_25.f08 : New test.

From-SVN: r245595

4 files changed, 83 insertions, 6 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fb71234..78d40af 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2017-02-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/79434
+	* parse.c (check_component, parse_union): Whitespace.
+	(set_syms_host_assoc): For a derived type, check if the module
+	in which it was declared is one of the submodule ancestors. If
+	it is, make the components public. Otherwise, reset attribute
+	'host_assoc' and set 'use-assoc' so that encapsulation is
+	preserved.
+
 2017-02-19  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/79447
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index c9f8da4..3809ec1 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2917,7 +2917,7 @@ check_component (gfc_symbol *sym, gfc_component *c, gfc_component **lockp,
       coarray = true;
       sym->attr.coarray_comp = 1;
     }
- 
+
   if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp
       && !c->attr.pointer)
     {
@@ -3081,7 +3081,7 @@ parse_union (void)
           /* Add a component to the union for each map. */
           if (!gfc_add_component (un, gfc_new_block->name, &c))
             {
-              gfc_internal_error ("failed to create map component '%s'", 
+              gfc_internal_error ("failed to create map component '%s'",
                   gfc_new_block->name);
               reject_statement ();
               return;
@@ -5809,6 +5809,9 @@ static void
 set_syms_host_assoc (gfc_symbol *sym)
 {
   gfc_component *c;
+  const char dot[2] = ".";
+  char parent1[GFC_MAX_SYMBOL_LEN + 1];
+  char parent2[GFC_MAX_SYMBOL_LEN + 1];
 
   if (sym == NULL)
     return;
@@ -5816,16 +5819,32 @@ set_syms_host_assoc (gfc_symbol *sym)
   if (sym->attr.module_procedure)
     sym->attr.external = 0;
 
-/*  sym->attr.access = ACCESS_PUBLIC;  */
-
   sym->attr.use_assoc = 0;
   sym->attr.host_assoc = 1;
   sym->attr.used_in_submodule =1;
 
   if (sym->attr.flavor == FL_DERIVED)
     {
-      for (c = sym->components; c; c = c->next)
-	c->attr.access = ACCESS_PUBLIC;
+      /* Derived types with PRIVATE components that are declared in
+	 modules other than the parent module must not be changed to be
+	 PUBLIC. The 'use-assoc' attribute must be reset so that the
+	 test in symbol.c(gfc_find_component) works correctly. This is
+	 not necessary for PRIVATE symbols since they are not read from
+	 the module.  */
+      memset(parent1, '\0', sizeof(parent1));
+      memset(parent2, '\0', sizeof(parent2));
+      strcpy (parent1, gfc_new_block->name);
+      strcpy (parent2, sym->module);
+      if (strcmp (strtok (parent1, dot), strtok (parent2, dot)) == 0)
+	{
+	  for (c = sym->components; c; c = c->next)
+	    c->attr.access = ACCESS_PUBLIC;
+	}
+      else
+	{
+	  sym->attr.use_assoc = 1;
+	  sym->attr.host_assoc = 0;
+	}
     }
 }
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1f6f967..fab1612 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-02-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/79434
+	* gfortran.dg/submodule_25.f08 : New test.
+
 2017-02-19  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/79447
diff --git a/gcc/testsuite/gfortran.dg/submodule_25.f08 b/gcc/testsuite/gfortran.dg/submodule_25.f08
new file mode 100644
index 0000000..0581ce3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/submodule_25.f08
@@ -0,0 +1,43 @@
+! { dg-do compile }
+! Test the fix for PR79434 in which the PRIVATE attribute of the
+! component 'i' of the derived type 't' was not respected in the
+! submodule 's_u'.
+!
+! Contributed by Reinhold Bader  <Bader@lrz.de>
+!
+module mod_encap_t
+  implicit none
+  type, public :: t
+    private
+    integer :: i
+  end type
+end module
+module mod_encap_u
+  use mod_encap_t
+  type, public, extends(t) :: u
+    private
+    integer :: j
+  end type
+  interface
+    module subroutine fu(this)
+      type(u), intent(inout) :: this
+    end subroutine
+  end interface
+end module
+submodule (mod_encap_u) s_u
+contains
+  module procedure fu
+!   the following statement should cause the compiler to
+!   abort, pointing out a private component defined in
+!   a USED module is being accessed
+    this%i = 2 ! { dg-error "is a PRIVATE component" }
+    this%j = 1
+    write(*, *) 'FAIL'
+  end procedure
+end submodule
+program p
+  use mod_encap_u
+  implicit none
+  type(u) :: x
+  call fu(x)
+end program